2005-06-23 03:15:44 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: gadgets
|
2005-06-27 03:47:22 -04:00
|
|
|
USING: generic kernel lists math matrices namespaces sequences
|
|
|
|
styles ;
|
2005-06-23 03:15:44 -04:00
|
|
|
|
|
|
|
TUPLE: divider splitter ;
|
|
|
|
|
2005-06-25 16:43:00 -04:00
|
|
|
: divider-size { 8 8 0 } ;
|
2005-06-23 03:15:44 -04:00
|
|
|
|
2005-06-28 23:50:23 -04:00
|
|
|
M: divider pref-dim drop divider-size ;
|
2005-06-25 16:43:00 -04:00
|
|
|
|
2005-07-01 19:52:08 -04:00
|
|
|
TUPLE: splitter split ;
|
2005-06-23 03:15:44 -04:00
|
|
|
|
2005-06-25 20:39:53 -04:00
|
|
|
: hand>split ( splitter -- n )
|
|
|
|
hand relative hand hand-click-rel v- divider-size 1/2 v*n v+ ;
|
|
|
|
|
|
|
|
: divider-motion ( splitter -- )
|
|
|
|
dup hand>split
|
2005-07-19 04:23:33 -04:00
|
|
|
over rectangle-dim { 1 1 1 } vmax v/ over pack-vector v.
|
2005-06-25 20:39:53 -04:00
|
|
|
0 max 1 min over set-splitter-split relayout ;
|
|
|
|
|
|
|
|
: divider-actions ( thumb -- )
|
|
|
|
dup [ drop ] [ button-down 1 ] set-action
|
|
|
|
dup [ drop ] [ button-up 1 ] set-action
|
|
|
|
[ gadget-parent divider-motion ] [ drag 1 ] set-action ;
|
|
|
|
|
|
|
|
C: divider ( -- divider )
|
|
|
|
<plain-gadget> over set-delegate
|
|
|
|
dup t reverse-video set-paint-prop
|
|
|
|
dup divider-actions ;
|
2005-06-23 22:35:41 -04:00
|
|
|
|
2005-07-09 16:49:13 -04:00
|
|
|
C: splitter ( first second split vector -- splitter )
|
2005-07-01 19:52:08 -04:00
|
|
|
[ >r 0 1 rot <pack> r> set-delegate ] keep
|
2005-07-09 16:49:13 -04:00
|
|
|
[ set-splitter-split ] keep
|
2005-06-25 16:43:00 -04:00
|
|
|
swapd
|
|
|
|
[ add-gadget ] keep
|
|
|
|
<divider> over add-gadget
|
2005-07-09 16:49:13 -04:00
|
|
|
[ add-gadget ] keep ;
|
2005-06-23 22:35:41 -04:00
|
|
|
|
2005-07-09 16:49:13 -04:00
|
|
|
: <x-splitter> ( first second split -- splitter )
|
|
|
|
{ 0 1 0 } <splitter> ;
|
2005-06-23 03:15:44 -04:00
|
|
|
|
2005-07-09 16:49:13 -04:00
|
|
|
: <y-splitter> ( first second split -- splitter )
|
|
|
|
{ 1 0 0 } <splitter> ;
|
2005-06-23 03:15:44 -04:00
|
|
|
|
2005-06-25 16:43:00 -04:00
|
|
|
: splitter-part ( splitter -- vec )
|
2005-07-19 04:23:33 -04:00
|
|
|
dup splitter-split swap rectangle-dim
|
2005-07-13 21:28:23 -04:00
|
|
|
n*v divider-size 1/2 v*n v- ;
|
2005-06-23 22:35:41 -04:00
|
|
|
|
2005-08-14 01:17:25 -04:00
|
|
|
: splitter-layout ( splitter -- { a b c } )
|
2005-06-23 22:35:41 -04:00
|
|
|
[
|
2005-06-25 16:43:00 -04:00
|
|
|
dup splitter-part ,
|
|
|
|
divider-size ,
|
2005-07-19 04:23:33 -04:00
|
|
|
dup rectangle-dim divider-size v- swap splitter-part v- ,
|
2005-08-14 01:17:25 -04:00
|
|
|
] make-vector ;
|
2005-06-23 22:35:41 -04:00
|
|
|
|
2005-06-23 03:15:44 -04:00
|
|
|
M: splitter layout* ( splitter -- )
|
2005-06-29 19:40:44 -04:00
|
|
|
dup splitter-layout packed-layout ;
|