\ VP-uilib.forth
\ General user interface definitions
\ 
\ $Id: VP-uilib.txt,v 1.4 2000/10/25 00:30:53 kris_johnson Exp $

\ Copyright 2000
\ Kristopher D. Johnson
\ 
\ See LICENSE-JacksOrBetter for the
\ conditions under which you may
\ use, redistribute, or modify this 
\ code, or create derived works.

needs Events
needs Forms
docneeds VP-lib

.( VP-uilib... )

: id>index ( ctlID -- n )
  GetObjectIndex ;

: >ControlPtr ( ctlID -- &ControlPtr. )
  GetObjectPtr ;

: active-form ( -- &FormPtr. )
  FrmGetActiveForm ;

\ Make given control visible & usable
: show-ctl ( controlID -- )
  id>index
  active-form FrmShowObject
;

\ Make given control invisible
: hide-ctl ( controlID -- )
  dup
  id>index
  active-form  FrmHideObject

  \ Workaround for bug in OS 3.2
  \ and earlier
  >ControlPtr CtlHideControl
;

\ Show or hide control based
\ upon flag
: show-if ( f controlID -- )
  swap if show-ctl exit then
  hide-ctl
;

\ Set text of specified label object.
\ Will append zero byte to given
\ string. 
\ Length of string must not exceed
\ size of label in resource.
: set-label ( cadr u controlID -- )
  dup >r  ( R: controlID )
  hide-ctl
  2dup zterm drop >abs ( zadr )
  r@
  active-form FrmCopyLabel
  r> show-ctl
;

\ Set label text to numeric value
: set-label# ( u controlID -- )
  >r u>zstring r> set-label ;

\ Return checkbox state
: get-check ( controlID -- f )
  id>index
  active-form FrmGetControlValue
;

\ Set checkbox state
: set-check ( f controlID -- )
  id>index
  active-form FrmSetControlValue
;

\ Palm OS Rectangle
struct
  1 cells field >left
  1 cells field >top
  1 cells field >w
  1 cells field >h
end-struct Rect

sizeof Rect constant /Rect

: .Rect ( &Rect -- )
  >r  r@ >left @ .   r@ >top @ .
  r@ >h @ .   r> >w @ .
;

: inset-rect ( n &rect -- )
  >abs RctInsetRectangle ;

: fill-rect ( diam &rect -- )
  >abs WinFillRectangle ;

: invert-rect ( diam &rect -- )
  >abs WinInvertRectangle ;

\ Given pointer to ControlType,
\ return address of its bounds elem
: ControlPtr>bounds ( &ControlType. -- &Rect. )
  1 cells m+ ;

\ Copy control's rectangle to
\ given address
: ctl-bounds ( controlID &rect -- )
  >abs 2>r
  GetObjectPtr
  ControlPtr>bounds
  2r> /Rect movea
;

\ Invert state of checkbox
: toggle-check ( controlID -- )
  dup get-check not swap set-check ;

