Better looking outliners, fix a bug in the hand preventing outliners from working, other cleanups

TODO.FACTOR.txt

@@ -36,10 +36,8 @@
   - only do clipping for certain gadgets
   - use glRect
   - display lists
-- add some padding to launchpad ui
 - saving the image should save window configuration
 - menu drag retarget broken
-- incremental layout flicker
 - changelog in the UI
 - make the UI look better, something like this:
   http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html

library/cocoa/ui.factor

@@ -67,6 +67,8 @@ H{ } clone views set-global
     >r view world-focus r> dup event>gesture pick handle-gesture
     [ [characters] CF>string swap user-input ] [ 2drop ] if ;
 
+: button... button >r view r> ;
+
 "NSOpenGLView" "FactorView" {
     { "drawRect:" "void" { "id" "SEL" "NSRect" }
         [ 2drop view draw-world ]
@@ -89,31 +91,31 @@ H{ } clone views set-global
     }
     
     { "mouseDown:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-down ]
+        [ nip button... send-button-down ]
     }
     
     { "mouseUp:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-up ]
+        [ nip button... send-button-up ]
     }
     
     { "rightMouseDown:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-down ]
+        [ nip button... send-button-down ]
     }
     
     { "rightMouseUp:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-up ]
+        [ nip button... send-button-up ]
     }
     
     { "otherMouseDown:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-down ]
+        [ nip button... send-button-down ]
     }
     
     { "otherMouseUp:" "void" { "id" "SEL" "id" }
-        [ 2nip button send-button-up ]
+        [ nip button... send-button-up ]
     }
     
     { "scrollWheel:" "void" { "id" "SEL" "id" }
-        [ 2nip [deltaY] 0 > send-scroll-wheel ]
+        [ nip [deltaY] 0 > >r view r> send-scroll-wheel ]
     }
     
     { "keyDown:" "void" { "id" "SEL" "id" }

library/opengl/opengl-utils.factor

@@ -33,6 +33,9 @@ sequences ;
 : four-sides ( dim -- )
     dup top-left dup top-right dup bottom-right bottom-left ;
 
+: gl-line ( a b -- )
+    GL_LINES [ gl-vertex gl-vertex ] do-state ;
+
 : gl-fill-rect ( dim -- )
     #! Draws a two-dimensional box.
     GL_QUADS [ four-sides ] do-state ;

library/ui/hand.factor

@@ -20,29 +20,6 @@ SYMBOL: hand-click-loc
 SYMBOL: hand-buttons
 V{ } clone hand-buttons set-global
 
-: button-gesture ( buttons gesture -- )
-    #! Send a gesture like [ button-down 2 ]; if nobody
-    #! handles it, send [ button-down ].
-    swap hand-clicked get-global 3dup >r add r> handle-gesture
-    [ nip handle-gesture drop ] [ 3drop ] if ;
-
-: update-clicked ( -- )
-    hand-gadget get-global hand-clicked set-global
-    hand-loc get-global hand-click-loc set-global ;
-
-: send-button-down ( event -- )
-    update-clicked
-    dup hand-buttons get-global push
-    [ button-down ] button-gesture ;
-
-: send-button-up ( event -- )
-    dup hand-buttons get-global delete
-    [ button-up ] button-gesture ;
-
-: send-wheel ( up/down -- )
-    [ wheel-up ] [ wheel-down ] ?
-    hand-gadget get-global handle-gesture drop ;
-
 : drag-gesture ( -- )
     #! Send a gesture like [ drag 2 ]; if nobody handles it,
     #! send [ drag ].
@@ -109,9 +86,31 @@ V{ } clone hand-buttons set-global
     pick-up hand-gadget set-global
     under-hand r> hand-gestures update-help ;
 
-: update-hand ( world -- )
-    #! Called when a gadget is removed or added.
-    hand-loc get-global swap move-hand ;
+: button-gesture ( buttons gesture -- )
+    #! Send a gesture like [ button-down 2 ]; if nobody
+    #! handles it, send [ button-down ].
+    swap hand-clicked get-global 3dup >r add r> handle-gesture
+    [ nip handle-gesture drop ] [ 3drop ] if ;
+
+: update-clicked ( loc world -- )
+    move-hand
+    hand-gadget get-global hand-clicked set-global
+    hand-loc get-global hand-click-loc set-global ;
+
+: send-button-down ( button# loc world -- )
+    update-clicked
+    dup hand-buttons get-global push
+    [ button-down ] button-gesture ;
+
+: send-button-up ( event loc world -- )
+    move-hand
+    dup hand-buttons get-global delete
+    [ button-up ] button-gesture ;
+
+: send-wheel ( up/down loc world -- )
+    move-hand
+    [ wheel-up ] [ wheel-down ] ?
+    hand-gadget get-global handle-gesture drop ;
 
 : layout-queued ( -- )
     invalid dup queue-empty? [

library/ui/menus.factor

@@ -6,7 +6,8 @@ gadgets-labels gadgets-theme generic kernel lists math
 namespaces sequences ;
 
 : retarget-click ( gadget -- )
-    find-world dup hide-glass update-hand update-clicked ;
+    find-world dup hide-glass
+    hand-loc get-global swap move-hand update-clicked ;
 
 : menu-actions ( glass -- )
     [ retarget-click ] [ button-down ] set-action ;

library/ui/outliner.factor

@@ -3,7 +3,18 @@
 IN: gadgets-outliner
 USING: arrays gadgets gadgets-borders gadgets-buttons
 gadgets-labels gadgets-layouts gadgets-panes gadgets-theme
-generic io kernel lists sequences styles ;
+generic io kernel lists math opengl sequences styles ;
+
+! Vertical line.
+TUPLE: guide color ;
+
+M: guide draw-interior ( gadget interior -- )
+    guide-color gl-color
+    rect-dim dup { 0.5 0 0 } v* swap { 0.5 1 0 } v* gl-line ;
+
+: <guide-gadget> ( -- gadget )
+    <gadget>
+    T{ guide f { 0.5 0.5 0.5 1.0 } } over set-gadget-interior ;
 
 ! Outliner gadget.
 TUPLE: outliner quot ;
@@ -12,14 +23,6 @@ TUPLE: outliner quot ;
     #! If the outliner is expanded, it has a center gadget.
     @center frame-child >boolean ;
 
-DEFER: <expand-button>
-
-: set-outliner-expanded? ( expanded? outliner -- )
-    #! Call the expander quotation if expanding.
-    over not <expand-button> over @top-left frame-add
-    swap [ dup outliner-quot make-pane ] [ f ] if
-    swap @center frame-add ;
-
 : find-outliner ( gadget -- outliner )
     [ outliner? ] find-parent ;
 
@@ -27,11 +30,26 @@ DEFER: <expand-button>
     arrow-right arrow-down ? { 0.5 0.5 0.5 1.0 } swap
     <polygon-gadget> <default-border> ;
 
+DEFER: set-outliner-expanded?
+
 : <expand-button> ( ? -- gadget )
     #! If true, the button expands, otherwise it collapses.
     dup [ swap find-outliner set-outliner-expanded? ] curry
-    >r <expand-arrow> r>
-    <highlight-button> ;
+    >r <expand-arrow> r> <highlight-button> ;
+
+: setup-expand ( expanded? outliner -- )
+    >r not <expand-button> r> @top-left frame-add ;
+
+: setup-center ( expanded? outliner -- )
+    [ swap [ outliner-quot make-pane ] [ drop f ] if ] keep
+    @center frame-add ;
+
+: setup-guide ( expanded? outliner -- )
+    >r [ <guide-gadget> ] [ f ] if r> @left frame-add ;
+
+: set-outliner-expanded? ( expanded? outliner -- )
+    #! Call the expander quotation if expanding.
+    2dup setup-expand 2dup setup-center setup-guide ;
 
 C: outliner ( gadget quot -- gadget )
     #! The quotation generates child gadgets.

library/x11/ui.factor

@@ -18,15 +18,20 @@ M: world resize-event ( event world -- )
     3array
     r> set-gadget-dim ;
 
+: button&loc ( event -- button# loc )
+    dup XButtonEvent-button
+    over XButtonEvent-x
+    rot XButtonEvent-y 0 3array ;
+
 M: world button-down-event ( event world -- )
-    drop XButtonEvent-button send-button-down ;
+    >r button&loc r> send-button-down ;
 
 M: world button-up-event ( event world -- )
-    drop XButtonEvent-button send-button-up ;
+    >r button&loc r> send-button-up ;
 
 M: world wheel-event ( event world -- )
-    drop XButtonEvent-button
-    H{ { 4 -1 } { 5 1 } } hash send-wheel ;
+    >r button&loc >r H{ { 4 -1 } { 5 1 } } hash r>
+    r> send-wheel ;
 
 M: world motion-event ( event world -- )
     >r dup XMotionEvent-x swap XMotionEvent-y 0 3array r>