diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2082b0da71..ba43830184 100644 --- a/TODO.FACTOR.txt +++ b/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 diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index c1174c3301..ffea40712f 100644 --- a/library/cocoa/ui.factor +++ b/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" } diff --git a/library/opengl/opengl-utils.factor b/library/opengl/opengl-utils.factor index 6278078de6..e1c01c7ae6 100644 --- a/library/opengl/opengl-utils.factor +++ b/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 ; diff --git a/library/ui/hand.factor b/library/ui/hand.factor index 71dad2728e..4502e0c234 100644 --- a/library/ui/hand.factor +++ b/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? [ diff --git a/library/ui/menus.factor b/library/ui/menus.factor index 6b0eb48f25..cf2c6327d7 100644 --- a/library/ui/menus.factor +++ b/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 ; diff --git a/library/ui/outliner.factor b/library/ui/outliner.factor index 3cbf16c303..bfe3ee91a8 100644 --- a/library/ui/outliner.factor +++ b/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 ; + +: ( -- 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: - -: set-outliner-expanded? ( expanded? outliner -- ) - #! Call the expander quotation if expanding. - over not 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: arrow-right arrow-down ? { 0.5 0.5 0.5 1.0 } swap ; +DEFER: set-outliner-expanded? + : ( ? -- gadget ) #! If true, the button expands, otherwise it collapses. dup [ swap find-outliner set-outliner-expanded? ] curry - >r r> - ; + >r r> ; + +: setup-expand ( expanded? outliner -- ) + >r not 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 [ ] [ 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. diff --git a/library/x11/ui.factor b/library/x11/ui.factor index d3179c4a62..6b4b2d35f7 100644 --- a/library/x11/ui.factor +++ b/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>