From 7e196e7e2ee1cb41cc95288e7548667d23c62267 Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 22 Nov 2006 02:45:22 +0000 Subject: [PATCH] Tracks are no longer resizable because I'm a lazy arsehole; better layout for workspace popups --- TODO.FACTOR.txt | 1 - library/ui/gadgets/tracks.factor | 121 ++---------------------------- library/ui/load.factor | 1 - library/ui/test/tracks.factor | 55 -------------- library/ui/tools/workspace.factor | 24 +++--- 5 files changed, 20 insertions(+), 182 deletions(-) delete mode 100644 library/ui/test/tracks.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 9d2c8706f6..2983efd144 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -19,7 +19,6 @@ - 10000 [ dup number>string ] map describe in the UI - available-modules - :trace -- roundoff is still not quite right with tracks - slider needs to be modelized - variable width word wrap - graphical crossref tool diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor index 80855da8ab..f8c17b1f42 100644 --- a/library/ui/gadgets/tracks.factor +++ b/library/ui/gadgets/tracks.factor @@ -4,141 +4,36 @@ IN: gadgets-tracks USING: gadgets gadgets-theme generic io kernel math namespaces sequences words ; -TUPLE: divider ; - -: divider-# ( divider -- n ) - dup gadget-parent gadget-children index 2 /i ; - -: divider-size { 8 8 } ; - -M: divider pref-dim* drop divider-size ; - -TUPLE: track sizes saved-sizes ; +TUPLE: track sizes ; C: track ( orientation -- track ) [ delegate>pack ] keep 1 over set-pack-fill - t over set-gadget-clipped? ; - -: divider-sizes ( seq -- dim ) - length 1 [-] divider-size n*v ; - -: track-dim ( track -- dim ) - #! Space available for content (minus dividers) - dup rect-dim swap track-sizes divider-sizes v- ; + V{ } clone over set-track-sizes ; : track-layout ( track -- sizes ) - dup track-dim swap track-sizes - [ [ over n*v , ] [ divider-size , ] interleave ] { } make - nip ; + dup rect-dim swap track-sizes [ v*n ] map-with ; M: track layout* dup track-layout pack-layout ; : track-pref-dims ( dims sizes -- dim ) - [ [ dup zero? [ drop ] [ v/n ] if ] 2map max-dim ] keep - divider-sizes v+ [ >fixnum ] map ; + [ v/n ] 2map max-dim [ >fixnum ] map ; M: track pref-dim* [ - dup gadget-children - 2 group 0 pref-dims + dup gadget-children pref-dims dup rot track-sizes track-pref-dims >r max-dim r> ] keep gadget-orientation set-axis ; -: divider-delta ( track -- delta ) - #! How far the divider has moved along the track? - drag-loc over track-dim { 1 1 } vmax v/ - swap gadget-orientation v. ; - -: save-sizes ( track -- ) - dup track-sizes clone swap set-track-saved-sizes ; - -: restore-sizes ( track -- ) - dup track-saved-sizes clone swap set-track-sizes ; - -: set-nth-0 ( n seq -- old ) 2dup nth >r 0 -rot set-nth r> ; - -: +nth ( delta n seq -- ) [ + ] change-nth ; - -: clamp-nth ( i j sizes -- ) [ set-nth-0 swap ] keep +nth ; - -: clamp-up? ( delta n sizes -- ? ) nth + 0 < ; - -: clamp-down? ( delta n sizes -- ? ) >r 1+ r> nth swap - 0 < ; - -: change-last-size ( delta n sizes -- ) - #! Its a bit simpler to resize the last divider since we - #! don't have to adjust the next one. - 3dup clamp-up? [ set-nth-0 2drop ] [ +nth ] if ; - -: change-inner-size ( delta n sizes -- ) - #! When changing a divider which isn't the last, we have to - #! resize the next area, too. - { - { [ 3dup clamp-up? ] [ >r dup 1+ swap r> clamp-nth drop ] } - { [ 3dup clamp-down? ] [ >r dup 1+ r> clamp-nth drop ] } - { [ t ] [ pick neg pick 1+ pick +nth +nth ] } - } cond ; - -: change-size ( delta n sizes -- ) - over 1+ over length = - [ change-last-size ] [ change-inner-size ] if ; - -: change-divider ( delta n track -- ) - [ dup restore-sizes track-sizes change-size ] keep - relayout-1 ; - -: divider-motion ( divider -- ) - dup gadget-parent divider-delta - over divider-# rot gadget-parent change-divider ; - -divider H{ - { T{ button-down } [ gadget-parent save-sizes ] } - { T{ button-up } [ drop ] } - { T{ drag } [ divider-motion ] } -} set-gestures - -C: divider ( -- divider ) - dup delegate>gadget ; - -: normalize-sizes ( sizes -- sizes ) - dup sum swap [ swap / ] map-with ; - -: track-add-size ( sizes -- sizes ) - dup length 1 max recip add normalize-sizes ; - -: add-divider ( track -- ) - dup track-sizes empty? - [ drop ] [ swap add-gadget ] if ; - -: track-add ( gadget track -- ) - dup add-divider [ add-gadget ] keep - dup track-sizes track-add-size swap set-track-sizes ; - -: remove-divider ( n track -- ) - 2dup gadget-children length = [ >r 1- r> ] when - nth-gadget unparent ; - -: track-remove-size ( n track -- ) - [ >r 2 /i r> track-sizes remove-nth normalize-sizes ] keep - set-track-sizes ; - -: track-remove@ ( n track -- ) - 2dup nth-gadget unparent - dup gadget-children empty? [ 2dup remove-divider ] unless - [ track-remove-size ] keep - relayout-1 ; - -: track-remove ( gadget track -- ) - [ gadget-children index ] keep track-remove@ ; +: track-add ( gadget track size -- ) + over track-sizes push add-gadget ; : build-track ( track specs -- ) #! Specs is an array of quadruples { quot post setter loc }. #! The setter has stack effect ( new gadget -- ), #! the loc is a ratio from 0 to 1. - [ swap [ [ drop track-add ] build-spec ] with-gadget ] 2keep - [ peek ] map swap set-track-sizes ; inline + swap [ [ track-add ] build-spec ] with-gadget ; inline : make-track ( specs orientation -- gadget ) [ swap build-track ] keep ; inline diff --git a/library/ui/load.factor b/library/ui/load.factor index f892a7848f..167a79ff6e 100644 --- a/library/ui/load.factor +++ b/library/ui/load.factor @@ -64,6 +64,5 @@ PROVIDE: library/ui "test/scrolling.factor" "test/search.factor" "test/sliders.factor" - "test/tracks.factor" "test/titled-gadget.factor" } } ; diff --git a/library/ui/test/tracks.factor b/library/ui/test/tracks.factor deleted file mode 100644 index 1537b95d27..0000000000 --- a/library/ui/test/tracks.factor +++ /dev/null @@ -1,55 +0,0 @@ -IN: temporary -USING: gadgets-tracks gadgets test kernel namespaces math -sequences ; - -[ { 1/3 1/2 1/6 } ] [ - { 1/3 1/2 1/6 } track-add-size 1 head* normalize-sizes -] unit-test - -{ - { - [ { 100 200 } over set-rect-dim ] - f - f - 1/2 - } - { - [ { 100 100 } over set-rect-dim ] - f - f - 1/4 - } - { - [ { 100 100 } over set-rect-dim ] - f - f - 1/4 - } -} { 0 1 } make-track "track" set - -"track" get dup prefer layout - -[ { 100 416 } ] [ "track" get rect-dim ] unit-test - -[ V{ { 100 200 } { 100 8 } { 100 100 } { 100 8 } { 100 100 } } ] -[ "track" get gadget-children [ rect-dim ] map ] unit-test - -[ { 1/2 1/4 1/4 } ] [ "track" get track-sizes ] unit-test - - { 70 70 } over set-rect-dim "track" get track-add -"track" get layout -[ { 3/8 3/16 3/16 1/4 } ] [ "track" get track-sizes ] unit-test - -"track" get [ gadget-children length 1- ] keep track-remove@ -"track" get layout -[ { 1/2 1/4 1/4 } ] [ "track" get track-sizes ] unit-test - -[ V{ { 100 200 } { 100 8 } { 100 100 } { 100 8 } { 100 100 } } ] -[ "track" get gadget-children [ rect-dim ] map ] unit-test - -{ - { [ ] f f 0 } - { [ ] f f 1 } -} { 0 1 } make-track "track" set - -[ { 0 8 } ] [ "track" get pref-dim ] unit-test diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index 41e85a30cd..fe31742e20 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -53,28 +53,26 @@ tool "toolbar" { { "Dataflow" } } ; +: ( workspace -- tabs ) + workspace-book control-model + workspace-tabs dup length [ swap first 2array ] 2map + ; + : ( -- gadget ) workspace-tabs 1 [ execute ] map ; C: workspace ( -- workspace ) { { [ ] set-workspace-book f @center } + { [ gadget get ] f f @top } { [ gadget get { workspace } ] f f @bottom } } make-frame* ; M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; -: ( workspace -- tabs ) - workspace-book control-model - workspace-tabs dup length [ swap first 2array ] 2map - ; - : init-status ( world -- ) dup world-status swap @bottom grid-add ; -: init-tabs ( world -- ) - [ world-gadget ] keep @top grid-add ; - : hide-popup ( workspace -- ) dup workspace-popup unparent f over set-workspace-popup @@ -85,10 +83,12 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; request-focus ; : popup-dim ( workspace -- dim ) - rect-dim first2 3 /i 2array ; + rect-dim first2 4 /i 2array ; : popup-loc ( workspace -- loc ) - dup rect-dim swap popup-dim v- ; + dup rect-dim + over popup-dim v- + swap rect-loc v+ ; : layout-popup ( workspace gadget -- ) over popup-dim over set-gadget-dim @@ -96,7 +96,8 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; M: workspace layout* dup delegate layout* - dup workspace-popup dup [ layout-popup ] [ 2drop ] if ; + dup workspace-book swap workspace-popup dup + [ layout-popup ] [ 2drop ] if ; M: workspace children-on nip gadget-children ; @@ -105,7 +106,6 @@ M: workspace focusable-child* workspace-book ; : workspace-window ( -- workspace ) dup [ init-status ] keep - [ init-tabs ] keep open-window listener-gadget get-tool start-listener ;