Fix world focus bug, new [-] word, caret no longer blinks

TODO.FACTOR.txt

@@ -1,4 +1,3 @@
-- in the ui, run a bunch of files, unfocus; when its done caret appears
 - unix i/o: problems with passing f to syscalls
 - if a primitive throws an error, :c doesn't show the call frame there
 - "benchmark/help": without a yield UI runs out of memory

library/collections/sequences-epilogue.facts

@@ -188,7 +188,7 @@ HELP: depth "( -- n )"
 HELP: cond "( assoc -- )"
 { $values { "assoc" "a sequence of quotation pairs" } }
 { $description
-    "Calls the first quotation in each pair in turn, until a quotation outputs a true value, in which case the second quotation in the corresponding pair is called."
+    "Calls the second quotation in the first pair whose first quotation yields a true value."
     $terpri
     "The following two phrases are equivalent:"
     { $code "{ { [ X ] [ Y ] } { [ Z ] [ T ] } } cond" }

library/collections/strings.factor

@@ -50,7 +50,7 @@ PREDICATE: integer control   "\0\e\r\n\t\u0008\u007f" member? ;
     dup printable? swap "\"\\" member? not and ; foldable
 
 : padding ( string count char -- string )
-    >r swap length - 0 max r> <string> ;
+    >r swap length [-] r> <string> ;
 
 : pad-left ( string count char -- string )
     pick >r padding r> append ;

library/compiler/inference/inference.factor

@@ -53,7 +53,7 @@ SYMBOL: d-in
     [ value-vector swap append ] [ drop ] if ;
 
 : ensure-values ( n -- )
-    dup meta-d get length - 0 max d-in [ + ] change
+    dup meta-d get length [-] d-in [ + ] change
     meta-d [ add-inputs ] change ;
 
 : effect ( -- { in# out# } )

library/math/math.factor

@@ -53,6 +53,8 @@ M: object zero? drop f ;
 
 : ceiling ( x -- y ) neg floor neg ; foldable
 
+: [-] - 0 max ; inline
+
 : (repeat) ( i n quot -- )
     pick pick >= [
         3drop

library/threads.factor

@@ -17,7 +17,7 @@ namespaces queues sequences vectors ;
     sleep-queue dup [ [ first ] 2apply swap - ] nsort ;
 
 : sleep-time ( sorted-queue -- ms )
-    dup empty? [ drop 1000 ] [ peek first millis - 0 max ] if ;
+    dup empty? [ drop 1000 ] [ peek first millis [-] ] if ;
 
 DEFER: next-thread
 

library/ui/gadgets/editors.factor

@@ -5,24 +5,10 @@ USING: arrays freetype gadgets gadgets-labels gadgets-scrolling
 gadgets-theme generic kernel math namespaces sequences strings
 styles threads ;
 
-! A blinking caret
+! A caret
 TUPLE: caret ;
 
-C: caret ( -- caret )
+C: caret ( -- caret ) dup delegate>gadget dup caret-theme ;
-    dup delegate>gadget dup caret-theme ;
-
-M: caret tick ( ms caret -- ) nip toggle-visible ;
-
-: caret-blink 500 ;
-
-: show-caret ( caret -- )
-    dup show-gadget dup relayout-1 caret-blink add-timer ;
-
-: hide-caret ( caret -- )
-    dup remove-timer dup hide-gadget relayout-1 ;
-
-: reset-caret ( caret -- )
-    dup restart-timer dup show-gadget relayout-1 ;
 
 USE: line-editor
 
@@ -37,7 +23,6 @@ TUPLE: editor line caret font color ;
     #! Execute a quotation in the line editor scope, then
     #! update the display.
     swap [ editor-line swap bind ] keep
-    dup editor-caret reset-caret
     dup relayout scroll>caret ; inline
 
 : editor-text ( editor -- text )
@@ -71,8 +56,8 @@ TUPLE: editor line caret font color ;
 M: editor gadget-gestures
     drop H{
         { T{ button-down } [ click-editor ] }
-        { T{ gain-focus } [ editor-caret show-caret ] }
+        { T{ gain-focus } [ editor-caret show-gadget ] }
-        { T{ lose-focus } [ editor-caret hide-caret ] }
+        { T{ lose-focus } [ editor-caret hide-gadget ] }
         { T{ key-down f f "BACKSPACE" } [ [ T{ char-elt } delete-prev-elt ] with-editor ] }
         { T{ key-down f f "DELETE" } [ [ T{ char-elt } delete-next-elt ] with-editor ] }
         { T{ key-down f { C+ } "BACKSPACE" } [ [ T{ word-elt } delete-prev-elt ] with-editor ] }

library/ui/gadgets/frames.factor

@@ -27,7 +27,7 @@ C: frame ( -- frame )
 : delegate>frame ( tuple -- ) <frame> swap set-delegate ;
 
 : (fill-center) ( vec n -- )
-    over first pick third + - 0 max 1 rot set-nth ;
+    over first pick third + [-] 1 rot set-nth ;
 
 : fill-center ( horiz vert dim -- )
     tuck second (fill-center) first (fill-center) ;

library/ui/gadgets/grids.factor

@@ -42,7 +42,7 @@ M: grid pref-dim* ( grid -- dim )
     [
         [
             [ 0 [ + ] reduce ] keep length
-            1- 0 max gap * +
+            1 [-] gap * +
         ] 2apply 0 3array
     ] with-grid ;
 

library/ui/gadgets/sliders.factor

@@ -25,7 +25,7 @@ TUPLE: slider elevator thumb value saved max page ;
     dup slider-page over slider-max 1 max / 1 min
     swap elevator-length * min-thumb-dim max ;
 
-: slider-max* dup slider-max swap slider-page - 0 max ;
+: slider-max* dup slider-max swap slider-page [-] ;
 
 : slider-scale ( slider -- n )
     #! A scaling factor such that if x is a slider co-ordinate,

library/ui/gadgets/tracks.factor

@@ -19,7 +19,7 @@ C: track ( orientation -- track )
     [ delegate>pack ] keep 1 over set-pack-fill ;
 
 : divider-sizes ( seq -- dim )
-    length 1- 0 max divider-size n*v ;
+    length 1 [-] divider-size n*v ;
 
 : track-dim ( track -- dim )
     #! Space available for content (minus dividers)

library/ui/gestures.factor

@@ -113,10 +113,15 @@ V{ } clone hand-buttons set-global
     T{ lose-focus } swap each-gesture
     T{ gain-focus } swap each-gesture ;
 
+: focus-receiver ( world -- seq )
+    #! If the world is not focused, we want focus-gestures to
+    #! only send focus-lost and not focus-gained.
+    dup world-focused? [ focused-ancestors ] [ drop f ] if ;
+
 : request-focus* ( gadget world -- )
     dup focused-ancestors >r
     [ set-world-focus ] keep
-    focused-ancestors r> focus-gestures ;
+    focus-receiver r> focus-gestures ;
 
 : request-focus ( gadget -- )
     dup focusable-child swap find-world request-focus* ;

library/ui/layouts.factor

@@ -123,7 +123,7 @@ C: pack ( vector -- pack )
 
 : gap-dims ( gap sizes -- seeq )
     [ { 0 0 0 } [ v+ ] reduce ] keep
-    length 1- 0 max rot n*v v+ ;
+    length 1 [-] rot n*v v+ ;
 
 : pack-pref-dim ( children gadget -- dim )
     [ >r [ max-dim ] keep r> pack-gap swap gap-dims ] keep

library/ui/timers.factor

@@ -5,12 +5,10 @@ USING: hashtables kernel math namespaces sequences ;
 
 TUPLE: timer object delay last ;
 
-: timer-now millis swap set-timer-last ;
-
 C: timer ( object delay -- timer )
     [ set-timer-delay ] keep
     [ set-timer-object ] keep
-    dup timer-now ;
+    millis over set-timer-last ;
 
 GENERIC: tick ( ms object -- )
 
@@ -23,13 +21,10 @@ GENERIC: tick ( ms object -- )
 
 : remove-timer ( object -- ) timers remove-hash ;
 
-: restart-timer ( object -- )
-    timers hash [ timer-now ] when* ;
-
 : next-time ( timer -- ms ) dup timer-delay swap timer-last + ;
 
 : advance-timer ( ms timer -- delay )
-    [ timer-last - 0 max ] 2keep set-timer-last ;
+    [ timer-last [-] ] 2keep set-timer-last ;
 
 : do-timer ( ms timer -- )
     dup next-time pick <= [

library/ui/ui.factor

@@ -117,10 +117,12 @@ C: titled-gadget ( gadget title -- )
 
 : focus-world ( world -- )
     #! Sent when native window receives focus
+    t over set-world-focused?
     dup raised-window
     focused-ancestors f focus-gestures ;
 
 : unfocus-world ( world -- )
+    f over set-world-focused?
     #! Sent when native window loses focus.
     focused-ancestors f swap focus-gestures ;
 

library/ui/world.factor

@@ -14,7 +14,7 @@ math namespaces opengl sequences ;
 !   we don't store this in the world's rect-loc, since the
 !   co-ordinate system might be different, and generally the
 !   UI code assumes that everything starts at { 0 0 0 }.
-TUPLE: world gadget status focus fonts handle loc ;
+TUPLE: world gadget status focus focused? fonts handle loc ;
 
 : free-fonts ( world -- )
     dup world-handle select-gl-context
@@ -48,5 +48,6 @@ M: world pref-dim* ( world -- dim )
 
 : reset-world ( world -- )
     f over set-world-focus
+    f over set-world-focused?
     f over set-world-handle
     world-fonts clear-hash ;