basic notion of keyboard focus

examples/gadget-test.factor

@@ -36,10 +36,20 @@ USE: stdio
 USE: prettyprint
 USE: words
 
+: grab ( gadget hand -- )
+    [ swap screen-pos swap screen-pos - >rect ] 2keep
+    >r [ move-gadget ] keep r> add-gadget ;
+
+: release ( gadget world -- )
+    >r dup screen-pos >r
+    dup unparent
+    r> >rect pick move-gadget
+    r> add-gadget ;
+
 : moving-actions
     {{
-        [[ [ button-down 1 ] [ 0 0 pick move-gadget my-hand add-gadget ] ]]
+            [[ [ button-down 1 ] [ my-hand grab ] ]]
-        [[ [ button-up 1 ] [ my-hand shape-x my-hand shape-y pick move-gadget world get add-gadget ] ]]
+        [[ [ button-up 1 ] [ world get release ] ]]
     }} swap set-gadget-gestures ;
 
 : filled? "filled" get checkbox-selected? ;
@@ -65,12 +75,11 @@ USE: words
     "Filled?" <checkbox> dup "filled" set "shelf" get add-gadget
     "shelf" get "pile" get add-gadget
     "Welcome to Factor " version cat2 <label> "pile" get add-gadget
+    "Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
+    "Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
 
     "pile" get bevel-border dup "dialog" set dup  
- {{
+ moving-actions
-         [[ [ button-down 1 ] [ dup unparent 0 0 pick move-gadget my-hand add-gadget ] ]]
-         [[ [ button-up 1 ] [ my-hand shape-x my-hand shape-y pick move-gadget world get add-gadget ] ]]
-     }} swap set-gadget-gestures
   world get add-gadget ;
 
 : gadget-demo ( -- )

library/bootstrap/boot-stage2.factor

@@ -162,6 +162,7 @@ cpu "x86" = [
         "/library/ui/world.factor"
         "/library/ui/labels.factor"
         "/library/ui/buttons.factor"
+        "/library/ui/fields.factor"
         "/library/ui/events.factor"
     ] [
         dup print

library/sdl/sdl-utils.factor

@@ -129,6 +129,8 @@ SYMBOL: logical-fonts
 global [
     {{
         [[ "Monospaced" "/fonts/VeraMono.ttf" ]]
+        [[ "Serif" "/fonts/VeraSe.ttf" ]]
+        [[ "Sans Serif" "/fonts/Vera.ttf" ]]
     }} logical-fonts set
 ] bind
 

library/ui/gadgets.factor

@@ -59,11 +59,11 @@ C: gadget ( shape -- gadget )
 : each-parent ( gadget quot -- )
     #! Apply quotation to each parent of the gadget in turn,
     #! stopping when the quotation returns f.
+    over [
         [ call ] 2keep rot [
-        >r gadget-parent dup [
+            >r gadget-parent r> each-parent
-            r> each-parent
         ] [
-            r> 2drop
+            2drop
         ] ifte
     ] [ 
         2drop

library/ui/gestures.factor

@@ -52,7 +52,7 @@ SYMBOL: button-down
         2dup inside? [ mouse-leave ] hierarchy-gesture
     ] each-parent drop ;
 
-: lose-focus ( old new -- )
+: lose-focus ( new old -- )
     #! If the old focus owner is a child of the new owner, do
     #! not fire a focus lost gesture, since the focus was not
     #! lost. Otherwise, fire a focus lost gesture and go to the

library/ui/hand.factor

@@ -86,7 +86,7 @@ C: hand ( world -- hand )
     r> swap fire-enter ;
 
 : request-focus ( gadget -- )
-    my-hand hand-focus swap
+    my-hand hand-focus
     2dup lose-focus
-    2dup my-hand set-hand-focus
+    swap dup my-hand set-hand-focus
     gain-focus ;

library/ui/world.factor

@@ -68,13 +68,13 @@ DEFER: handle-event
 
 global [
     <world> world set
-    640 480 world get resize-gadget
+    1024 768 world get resize-gadget
     {{
-        [[ background [ 216 216 216 ] ]]
+        [[ background [ 255 255 255 ] ]]
-        [[ foreground [ 0 0 0 ] ]]
+        [[ foreground [ 0 0 102 ] ]]
-        [[ bevel-1    [ 240 240 240 ] ]]
+        [[ bevel-1    [ 224 224 255 ] ]]
-        [[ bevel-2    [ 192 192 192 ] ]]
+        [[ bevel-2    [ 192 192 216 ] ]]
         [[ bevel-up?  t ]]
-        [[ font       [[ "Monospaced" 12 ]] ]]
+        [[ font       [[ "Sans Serif" 14 ]] ]]
     }} world get set-gadget-paint
 ] bind