( gui )

CREATE event 24 ALLOT
CREATE menuErr 2 ALLOT

api: frmGetFormPtr
api: frmDrawForm
api: frmDispatchEvent

:noname
>rel dup w@ 24 = if
8 + w@ frmGetFormPtr
frmDrawForm true
else drop false then ; callback: DefHandler

:noname drop 0 ;
value GetFormHandler-XT

api: frmInitForm
api: frmSetEventHandler
api: frmSetActiveForm
api: evtGetEvent
api: sysHandleEvent
api: menuHandleEvent

vect InitForm ( id -- )
:noname dup frmInitForm
dup FrmSetActiveForm
swap GetFormHandler-XT execute
?dup 0= if DefHandler then
frmSetEventHandler ; to InitForm

vect AppHandleEvent
:noname
event w@ 23 = if
event 8 + w@ InitForm true
else false then
; to AppHandleEvent

s" ekey" included
needs keyDownEvent events
needs EventFields event_fields

: HitchFH ( id xt0 xt1 -- h | 0 )
  2>r
  dup r> execute
  ?dup if
    nip rdrop
  else
    r> execute
  then
;

: MakeHitchFH ( xt0 xt1 -- xt2 )
  :noname
  rot postpone literal
  swap postpone literal
  postpone HitchFH
  postpone ;
;

: IsFormHandler? ( id0 id h -- h | 0 )
  rot rot = and
;

: SetFormHandler ( xt id -- )
  swap callback swap
  :noname >r
  postpone literal
  postpone literal postpone execute
  postpone IsFormHandler?
  postpone ;
  GetFormHandler-XT
  r> MakeHitchFH
  to GetFormHandler-XT
;

0 value &ev

: ev.
        state @ if
                postpone &ev
        else
                &ev
        then
        also EventFields
                NextWord evaluate
        previous
; immediate

: pre-ev ( ev>abs -- ev evNo )
>rel to &ev ;

variable ?handled
: handled ?handled on ;
: unhandled ?handled off ;

: HitchEH ( xt0 xt1 -- )
        execute
        ?handled @ if
                drop
        else
                execute
        then
;

: MakeHitchEH ( xt0 xt1 -- xt2 )
:noname >r
swap
postpone literal postpone literal
postpone HitchEH
postpone ;
r> ;

: e:
        :noname
        postpone handled
;

: ;e
        postpone ;
        MakeHitchEH
; immediate

: IsEvent ev. eType = ;

: e> ( f -- )
0= if rdrop unhandled exit then ;

api: FrmGetActiveForm
api: FrmGetFocus
api: FrmGetObjectId

: IsFocus
        FrmGetActiveForm
        dup FrmGetFocus
        65535 over <> if
                FrmGetObjectId =
        else
                2drop drop false
        then
;

: OnOpenForm
        frmOpenEvent IsEvent e>
        ev. formID FrmGetFormPtr
        FrmDrawForm
        handled
;

variable _FormID

: FormID _FormID @ postpone literal
; immediate
: FormPtr
postpone FormID
postpone FrmGetFormPtr
; immediate

api: FrmGetObjectIndex
api: FrmGetObjectPtr

: _ObjIndex ( objID frmID -- objInd )
FrmGetFormPtr swap
FrmGetObjectIndex ;
: ObjIndex
postpone FormID postpone _ObjIndex
; immediate
: _ObjPtr ( objID frmID -- objPtr )
FrmGetFormPtr dup rot
FrmGetObjectIndex
FrmGetObjectPtr ;
: ObjPtr
postpone FormID postpone _ObjPtr
; immediate

: Form: ( formID -- cur-wid xt )
_FormID !
get-current
wordlist also-wl definitions
['] OnOpenForm ;

: ;FormHandler ( cur-wid xt -- xt1 )
:noname postpone pre-ev swap
postpone literal postpone execute
postpone ?handled postpone @
postpone ;
swap previous set-current
;

: ;Form ( cur-wid xt -- )
;FormHandler
_FormID @ SetFormHandler
;

: ObjPtr:
        create w, immediate
does>
        w@ postpone literal
        postpone postpone
        postpone ObjPtr
;

: IsMenu ( menu_event -- f )
        ev. itemID =
        menuEvent IsEvent       and ;

api: EvtAddUniqueEventToQueue

create NotifyEventAddr 24 allot

: AddNotifyEvent ( evt -- )
        NotifyEventAddr
        dup 24 erase
        swap over w!
        >abs 0 0 EvtAddUniqueEventToQueue ;

: IsCtlEnter ( controlID -- f )
  ev. controlID =
  ctlEnterEvent IsEvent and ;

api: FrmGotoForm