\ mombutton


needs core-ext
needs struct
needs case
needs events
needs forms
needs drawbitmapresource
needs click
needs gadgetutil

decimal

\ don't change these, they're used
\ in a select/xt below
0 constant momstdown
1 constant momstup

struct
    1 cells field mom.state
    1 cells field mom.xtsetreset
    1 cells field mom.gadget-id
    1 cells field mom.upbmp-id
    1 cells field mom.downbmp-id
end-struct Momentary:

0 value mom

: mom-gadget-index@  
    ( -- gadgetindex )
    mom mom.gadget-id @ 
    GetObjectIndex  ;

: in-momgadget?  ( -- flag )
    mom-gadget-index@
    in-gadget? ;

: draw-momstate  ( bitmpID -- )
    mom-gadget-index@
    draw-gadget ;

: draw-upstate  ( -- ) 
    mom mom.upbmp-id @
    draw-momstate ;

: draw-downstate  ( -- ) 
    mom mom.downbmp-id @
    draw-momstate ;

: do-momstate-down
    ( event -- )
    penUpEvent = 
    if
        momstup mom mom.state !
        0 mom mom.xtsetreset @
        execute  
        draw-upstate
        click
    then ;

: do-momstate-up
    ( event -- )
    penDownEvent =
    in-momgadget?  and 
    if
        momstdown mom mom.state !
        -1 mom mom.xtsetreset @
        execute
        draw-downstate
    then ;

: do-momentary-event
    ( event momobj -- )
    to mom        ( event )
    mom mom.state @  
    if        do-momstate-up
    else   do-momstate-down
    then ;

: init-momentary
    ( xtsetreset momobj -- )
    to mom
    mom mom.xtsetreset !
    momstup mom mom.state !
    draw-upstate ;

