ui.gadgets.slate: add some gesture handling for processing demos

extra/ui/gadgets/slate/slate.factor

@@ -3,7 +3,11 @@ USING: kernel namespaces opengl ui.render ui.gadgets ;
 
 IN: ui.gadgets.slate
 
-TUPLE: slate action dim graft ungraft ;
+TUPLE: slate action dim graft ungraft
+       button-down
+       button-up
+       key-down
+       key-up ;
 
 : <slate> ( action -- slate )
   slate construct-gadget
@@ -19,4 +23,100 @@ M: slate draw-gadget* ( slate -- )
 
 M: slate graft* ( slate -- ) slate-graft call ;
 
-M: slate ungraft* ( slate -- ) slate-ungraft call ;
+M: slate ungraft* ( slate -- ) slate-ungraft call ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: key-pressed-value
+
+: key-pressed? ( -- ? ) key-pressed-value get ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: mouse-pressed-value
+
+: mouse-pressed? ( -- ? ) mouse-pressed-value get ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: key-value
+
+: key ( -- key ) key-value get ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: button-value
+
+: button ( -- val ) button-value get ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USING: combinators ui.gestures accessors ;
+
+! M: slate handle-gesture* ( gadget gesture delegate -- ? )
+!    drop nip
+!    {
+!      {
+!        [ dup key-down? ]
+!        [
+       
+!          key-down-sym key-value set
+!          key-pressed-value on
+!          t
+!        ]
+!      }
+!      { [ dup key-up?   ] [ drop key-pressed-value off t ] }
+!      {
+!        [ dup button-down? ]
+!        [
+!          button-down-# mouse-button-value set
+!          mouse-pressed-value on
+!          t
+!        ]
+!      }
+!      { [ dup button-up? ] [ drop mouse-pressed-value off t ] }
+!      { [ t             ] [ drop                       t ] }
+!    }
+!    cond ;
+
+M: slate handle-gesture* ( gadget gesture delegate -- ? )
+   rot drop swap         ! delegate gesture
+   {
+     {
+       [ dup key-down? ]
+       [
+         key-down-sym key-value set
+         key-pressed-value on
+         key-down>> dup [ call ] [ drop ] if
+         t
+       ]
+     }
+     {
+       [ dup key-up?   ]
+       [
+         key-pressed-value off
+         drop
+         key-up>> dup [ call ] [ drop ] if
+         t
+       ] }
+     {
+       [ dup button-down? ]
+       [
+         button-down-# button-value set
+         mouse-pressed-value on
+         button-down>> dup [ call ] [ drop ] if
+         t
+       ]
+     }
+     {
+       [ dup button-up? ]
+       [
+         mouse-pressed-value off
+         drop
+         button-up>> dup [ call ] [ drop ] if
+         t
+       ]
+     }
+     { [ t ] [ 2drop t ] }
+   }
+   cond ;