2 USING: kernel sequences math math.order
3 ui.gadgets ui.gadgets.tracks ui.gestures
8 TUPLE: tiling < track gadgets tiles first focused ;
10 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
12 : init-tiling ( tiling -- tiling )
20 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22 : <tiling> ( -- gadget ) tiling new init-tiling ;
24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26 : bounded-subseq ( seq a b -- seq )
28 pick length [ min ] curry bi@
32 : tiling-gadgets-to-map ( tiling -- gadgets )
35 [ [ first>> ] [ tiles>> ] bi + ]
39 : tiling-map-gadgets ( tiling -- tiling )
41 dup tiling-gadgets-to-map [ 1 track-add ] each ;
43 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
45 : tiling-add ( tiling gadget -- tiling )
49 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
51 : first-gadget ( tiling -- index ) drop 0 ;
53 : last-gadget ( tiling -- index ) gadgets>> length 1 - ;
55 : first-viewable ( tiling -- index ) first>> ;
57 : last-viewable ( tiling -- index ) [ first>> ] [ tiles>> ] bi + 1 - ;
59 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
61 : make-focused-mapped ( tiling -- tiling )
63 dup [ focused>> ] [ first>> ] bi <
64 [ dup first>> 1 - >>first ]
68 dup [ last-viewable ] [ focused>> ] bi <
69 [ dup first>> 1 + >>first ]
73 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
75 : check-focused-bounds ( tiling -- tiling )
76 dup focused>> 0 max over gadgets>> length 1 - min >>focused ;
78 : focus-prev ( tiling -- tiling )
79 dup focused>> 1 - >>focused
85 : focus-next ( tiling -- tiling )
86 dup focused>> 1 + >>focused
92 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
94 : exchanged! ( seq a b -- )
96 pick length 1 - '[ , min ] bi@
99 : move-prev ( tiling -- tiling )
100 dup [ gadgets>> ] [ focused>> 1 - ] [ focused>> ] tri exchanged!
103 : move-next ( tiling -- tiling )
104 dup [ gadgets>> ] [ focused>> ] [ focused>> 1 + ] tri exchanged!
107 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
109 : add-tile ( tiling -- tiling )
110 dup tiles>> 1 + >>tiles
113 : del-tile ( tiling -- tiling )
114 dup tiles>> 1 - 1 max >>tiles
117 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
119 M: tiling focusable-child* ( tiling -- child/t )
120 [ focused>> ] [ gadgets>> ] bi nth ;
122 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
124 TUPLE: tiling-shelf < tiling ;
125 TUPLE: tiling-pile < tiling ;
127 : <tiling-shelf> ( -- gadget )
128 tiling-shelf new init-tiling { 1 0 } >>orientation ;
130 : <tiling-pile> ( -- gadget )
131 tiling-pile new init-tiling { 0 1 } >>orientation ;
135 { T{ key-down f { A+ } "LEFT" } [ focus-prev drop ] }
136 { T{ key-down f { A+ } "RIGHT" } [ focus-next drop ] }
137 { T{ key-down f { S+ A+ } "LEFT" } [ move-prev drop ] }
138 { T{ key-down f { S+ A+ } "RIGHT" } [ move-next drop ] }
139 { T{ key-down f { C+ } "[" } [ del-tile drop ] }
140 { T{ key-down f { C+ } "]" } [ add-tile drop ] }
146 { T{ key-down f { A+ } "UP" } [ focus-prev drop ] }
147 { T{ key-down f { A+ } "DOWN" } [ focus-next drop ] }
148 { T{ key-down f { S+ A+ } "UP" } [ move-prev drop ] }
149 { T{ key-down f { S+ A+ } "DOWN" } [ move-next drop ] }
150 { T{ key-down f { C+ } "[" } [ del-tile drop ] }
151 { T{ key-down f { C+ } "]" } [ add-tile drop ] }