extra/processing/gadget/gadget.factor

   1
   2 USING: kernel namespaces combinators
   3        ui.gestures accessors ui.gadgets.frame-buffer ;
   4
   5 IN: processing.gadget
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8
   9 TUPLE: processing-gadget < frame-buffer button-down button-up key-down key-up ;
  10
  11 : <processing-gadget> ( -- gadget ) processing-gadget new-frame-buffer ;
  12
  13 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  14
  15 SYMBOL: mouse-pressed-value
  16 SYMBOL: key-pressed-value
  17
  18 SYMBOL: button-value
  19 SYMBOL: key-value
  20
  21 : key-pressed?   ( -- ? ) key-pressed-value   get ;
  22 : mouse-pressed? ( -- ? ) mouse-pressed-value get ;
  23
  24 : key    ( -- key ) key-value    get ;
  25 : button ( -- val ) button-value get ;
  26
  27 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  28
  29 M: processing-gadget handle-gesture ( gesture gadget -- ? )
  30    swap
  31    {
  32      {
  33        [ dup key-down? ]
  34        [
  35          sym>> key-value set
  36          key-pressed-value on
  37          key-down>> dup [ call ] [ drop ] if
  38          t
  39        ]
  40      }
  41      {
  42        [ dup key-up?   ]
  43        [
  44          key-pressed-value off
  45          drop
  46          key-up>> dup [ call ] [ drop ] if
  47          t
  48        ] }
  49      {
  50        [ dup button-down? ]
  51        [
  52          #>> button-value set
  53          mouse-pressed-value on
  54          button-down>> dup [ call ] [ drop ] if
  55          t
  56        ]
  57      }
  58      {
  59        [ dup button-up? ]
  60        [
  61          mouse-pressed-value off
  62          drop
  63          button-up>> dup [ call ] [ drop ] if
  64          t
  65        ]
  66      }
  67      { [ t ] [ 2drop t ] }
  68    }
  69    cond ;