diff --git a/extra/ui/gadgets/tiling/tiling.factor b/extra/ui/gadgets/tiling/tiling.factor new file mode 100644 index 0000000000..982bbd077f --- /dev/null +++ b/extra/ui/gadgets/tiling/tiling.factor @@ -0,0 +1,118 @@ + +USING: kernel sequences math math.order + ui.gadgets ui.gadgets.tracks ui.gestures + accessors ; + +IN: ui.gadgets.tiling + +TUPLE: tiling < track gadgets columns first focused ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init-tiling ( tiling -- tiling ) + init-track + { 1 0 } >>orientation + V{ } clone >>gadgets + 2 >>columns + 0 >>first + 0 >>focused ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ( -- gadget ) + tiling new + init-tiling ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: bounded-subseq ( seq a b -- seq ) + [ 0 max ] dip + pick length [ min ] curry bi@ + rot + subseq ; + +: tiling-gadgets-to-map ( tiling -- gadgets ) + [ gadgets>> ] + [ first>> ] + [ [ first>> ] [ columns>> ] bi + ] + tri + bounded-subseq ; + +: tiling-map-gadgets ( tiling -- tiling ) + dup clear-track + dup tiling-gadgets-to-map [ 1 track-add* ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: tiling-add ( tiling gadget -- tiling ) + over gadgets>> push + tiling-map-gadgets ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: first-gadget ( tiling -- index ) drop 0 ; + +: last-gadget ( tiling -- index ) gadgets>> length 1 - ; + +: first-viewable ( tiling -- index ) first>> ; + +: last-viewable ( tiling -- index ) [ first>> ] [ columns>> ] bi + 1 - ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: make-focused-mapped ( tiling -- tiling ) + + dup [ focused>> ] [ first>> ] bi < + [ dup first>> 1 - >>first ] + [ ] + if + + dup [ last-viewable ] [ focused>> ] bi < + [ dup first>> 1 + >>first ] + [ ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: check-focused-bounds ( tiling -- tiling ) + dup focused>> 0 max over gadgets>> length 1 - min >>focused ; + +: focus-left ( tiling -- tiling ) + dup focused>> 1 - >>focused + check-focused-bounds + make-focused-mapped + tiling-map-gadgets + dup request-focus ; + +: focus-right ( tiling -- tiling ) + dup focused>> 1 + >>focused + check-focused-bounds + make-focused-mapped + tiling-map-gadgets + dup request-focus ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: add-column ( tiling -- tiling ) + dup columns>> 1 + >>columns + tiling-map-gadgets ; + +: del-column ( tiling -- tiling ) + dup columns>> 1 - 1 max >>columns + tiling-map-gadgets ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M: tiling focusable-child* ( tiling -- child/t ) + [ focused>> ] [ gadgets>> ] bi nth ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +tiling + H{ + { T{ key-down f { A+ } "LEFT" } [ focus-left drop ] } + { T{ key-down f { A+ } "RIGHT" } [ focus-right drop ] } + { T{ key-down f { C+ } "[" } [ del-column drop ] } + { T{ key-down f { C+ } "]" } [ add-column drop ] } + } +set-gestures \ No newline at end of file