Tracks are no longer resizable because I'm a lazy arsehole; better layout for workspace popups
slava
parent
6970aae0c4
commit
7e196e7e2e
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <column> 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 ] [ <divider> 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 )
|
||||
<track> [ swap build-track ] keep ; inline
|
||||
|
|
|
|||
|
|
@ -64,6 +64,5 @@ PROVIDE: library/ui
|
|||
"test/scrolling.factor"
|
||||
"test/search.factor"
|
||||
"test/sliders.factor"
|
||||
"test/tracks.factor"
|
||||
"test/titled-gadget.factor"
|
||||
} } ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
{
|
||||
{
|
||||
[ <gadget> { 100 200 } over set-rect-dim ]
|
||||
f
|
||||
f
|
||||
1/2
|
||||
}
|
||||
{
|
||||
[ <gadget> { 100 100 } over set-rect-dim ]
|
||||
f
|
||||
f
|
||||
1/4
|
||||
}
|
||||
{
|
||||
[ <gadget> { 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
|
||||
|
||||
<gadget> { 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
|
||||
|
||||
{
|
||||
{ [ <gadget> ] f f 0 }
|
||||
{ [ <gadget> ] f f 1 }
|
||||
} { 0 1 } make-track "track" set
|
||||
|
||||
[ { 0 8 } ] [ "track" get pref-dim ] unit-test
|
||||
|
|
@ -53,28 +53,26 @@ tool "toolbar" {
|
|||
{ "Dataflow" <dataflow-gadget> }
|
||||
} ;
|
||||
|
||||
: <workspace-tabs> ( workspace -- tabs )
|
||||
workspace-book control-model
|
||||
workspace-tabs dup length [ swap first 2array ] 2map
|
||||
<radio-box> ;
|
||||
|
||||
: <workspace-book> ( -- gadget )
|
||||
workspace-tabs 1 <column> [ execute <tool> ] map <book> ;
|
||||
|
||||
C: workspace ( -- workspace )
|
||||
{
|
||||
{ [ <workspace-book> ] set-workspace-book f @center }
|
||||
{ [ gadget get <workspace-tabs> ] f f @top }
|
||||
{ [ gadget get { workspace } <toolbar> ] f f @bottom }
|
||||
} make-frame* ;
|
||||
|
||||
M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
|
||||
|
||||
: <workspace-tabs> ( workspace -- tabs )
|
||||
workspace-book control-model
|
||||
workspace-tabs dup length [ swap first 2array ] 2map
|
||||
<radio-box> ;
|
||||
|
||||
: init-status ( world -- )
|
||||
dup world-status <presentation-help> swap @bottom grid-add ;
|
||||
|
||||
: init-tabs ( world -- )
|
||||
[ world-gadget <workspace-tabs> ] 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 )
|
||||
<workspace> dup <world>
|
||||
[ init-status ] keep
|
||||
[ init-tabs ] keep
|
||||
open-window
|
||||
listener-gadget get-tool start-listener ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue