101 lines
2.7 KiB
Factor
101 lines
2.7 KiB
Factor
! Copyright (C) 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: gadgets-tracks
|
|
USING: gadgets gadgets-layouts gadgets-theme io kernel math
|
|
namespaces sequences ;
|
|
|
|
TUPLE: divider ;
|
|
|
|
: divider-# ( divider -- n )
|
|
dup gadget-parent gadget-children index 2 /i ;
|
|
|
|
: divider-size { 8 8 0 } ;
|
|
|
|
M: divider pref-dim* drop divider-size ;
|
|
|
|
TUPLE: track sizes saved-sizes ;
|
|
|
|
C: track ( orientation -- track )
|
|
[ delegate>pack ] keep 1 over set-pack-fill ;
|
|
|
|
: <x-track> { 0 1 0 } <track> ;
|
|
|
|
: <y-track> { 1 0 0 } <track> ;
|
|
|
|
: track-dim ( track -- dim )
|
|
#! Space available for content (minus dividers)
|
|
dup rect-dim swap track-sizes length 1-
|
|
divider-size n*v v- ;
|
|
|
|
: track-layout ( track -- sizes )
|
|
dup track-dim swap track-sizes
|
|
[ [ over n*v , ] [ divider-size , ] interleave ] { } make
|
|
nip ;
|
|
|
|
M: track layout* ( splitter -- )
|
|
dup track-layout packed-layout ;
|
|
|
|
: divider-delta ( track -- delta )
|
|
#! How far the divider has moved along the track?
|
|
drag-loc over track-dim { 1 1 1 } vmax v/
|
|
swap gadget-orientation v. ;
|
|
|
|
: +nth ( delta n seq -- ) swap [ + ] change-nth ;
|
|
|
|
: save-sizes ( track -- )
|
|
dup track-sizes clone swap set-track-saved-sizes ;
|
|
|
|
: restore-sizes ( track -- )
|
|
dup track-saved-sizes clone swap set-track-sizes ;
|
|
|
|
: change-divider ( delta n track -- )
|
|
[
|
|
dup restore-sizes
|
|
track-sizes
|
|
[ +nth ] 3keep
|
|
>r 1+ >r neg r> r> 2dup length = [ 3drop ] [ +nth ] if
|
|
] keep relayout-1 ;
|
|
|
|
: divider-motion ( divider -- )
|
|
dup gadget-parent divider-delta
|
|
over divider-# rot gadget-parent change-divider ;
|
|
|
|
: divider-actions ( divider -- )
|
|
dup [ gadget-parent save-sizes ] T{ button-down } set-action
|
|
dup [ drop ] T{ button-up } set-action
|
|
[ divider-motion ] T{ drag } set-action ;
|
|
|
|
C: divider ( -- divider )
|
|
dup delegate>gadget
|
|
dup divider-actions
|
|
dup reverse-video-theme ;
|
|
|
|
: 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 ;
|
|
|
|
: nth-gadget gadget-children nth ;
|
|
|
|
: track-remove@ ( n track -- )
|
|
#! Remove the divider if this is not the last child.
|
|
2dup nth-gadget unparent
|
|
dup gadget-children empty? [
|
|
2dup gadget-children length = [ >r 1- r> ] when
|
|
2dup nth-gadget unparent
|
|
] unless
|
|
[ >r 2 /i r> track-sizes remove-index normalize-sizes ] keep
|
|
[ set-track-sizes ] keep relayout-1 ;
|
|
|
|
: track-remove ( gadget track -- )
|
|
[ gadget-children index ] keep track-remove@ ;
|