ui.gadgets.*: updates for new effects
parent
54b24fd8b1
commit
73e30123f5
|
@ -19,7 +19,7 @@ M: book model-changed
|
|||
: new-book ( pages model class -- book )
|
||||
new-gadget
|
||||
swap >>model
|
||||
[ add-gadgets ] keep ; inline
|
||||
[ swap add-gadgets drop ] keep ; inline
|
||||
|
||||
: <book> ( pages model -- book )
|
||||
book new-book ;
|
||||
|
|
|
@ -10,7 +10,7 @@ TUPLE: border < gadget
|
|||
{ align initial: { 1/2 1/2 } } ;
|
||||
|
||||
: new-border ( child class -- border )
|
||||
new-gadget [ add-gadget ] keep ; inline
|
||||
new-gadget [ swap add-gadget drop ] keep ; inline
|
||||
|
||||
: <border> ( child gap -- border )
|
||||
swap border new-border
|
||||
|
|
|
@ -12,7 +12,7 @@ grid
|
|||
|
||||
: new-grid ( children class -- grid )
|
||||
new-gadget
|
||||
[ (>>grid) ] [ >r concat r> add-gadgets ] [ nip ] 2tri ;
|
||||
[ (>>grid) ] [ >r concat r> swap add-gadgets drop ] [ nip ] 2tri ;
|
||||
inline
|
||||
|
||||
: <grid> ( children -- grid )
|
||||
|
@ -21,7 +21,7 @@ grid
|
|||
: grid-child ( grid i j -- gadget ) rot grid>> nth nth ;
|
||||
|
||||
: grid-add ( gadget grid i j -- )
|
||||
>r >r 2dup add-gadget r> r>
|
||||
>r >r 2dup swap add-gadget drop r> r>
|
||||
3dup grid-child unparent rot grid>> nth set-nth ;
|
||||
|
||||
: grid-remove ( grid i j -- )
|
||||
|
|
|
@ -45,7 +45,7 @@ M: incremental pref-dim*
|
|||
|
||||
: add-incremental ( gadget incremental -- )
|
||||
not-in-layout
|
||||
2dup (add-gadget)
|
||||
2dup swap (add-gadget) drop
|
||||
over prefer-incremental
|
||||
over layout-later
|
||||
2dup incremental-loc
|
||||
|
|
|
@ -48,7 +48,7 @@ TUPLE: list < pack index presenter color hook ;
|
|||
M: list model-changed
|
||||
nip
|
||||
dup clear-gadget
|
||||
dup <list-items> over add-gadgets
|
||||
dup <list-items> over swap add-gadgets drop
|
||||
bound-index ;
|
||||
|
||||
: selected-rect ( list -- rect )
|
||||
|
|
|
@ -15,7 +15,7 @@ TUPLE: menu-glass < gadget ;
|
|||
: <menu-glass> ( menu world -- glass )
|
||||
menu-glass new-gadget
|
||||
>r over menu-loc over set-rect-loc r>
|
||||
[ add-gadget ] keep ;
|
||||
[ swap add-gadget drop ] keep ;
|
||||
|
||||
M: menu-glass layout* gadget-child prefer ;
|
||||
|
||||
|
@ -26,7 +26,7 @@ M: menu-glass layout* gadget-child prefer ;
|
|||
: show-glass ( gadget world -- )
|
||||
over hand-clicked set-global
|
||||
[ hide-glass ] keep
|
||||
[ add-gadget ] 2keep
|
||||
[ swap add-gadget drop ] 2keep
|
||||
set-world-glass ;
|
||||
|
||||
: show-menu ( gadget owner -- )
|
||||
|
|
|
@ -22,10 +22,10 @@ selection-color caret mark selecting? ;
|
|||
drop ;
|
||||
|
||||
: add-output ( current pane -- )
|
||||
[ set-pane-output ] [ add-gadget ] 2bi ;
|
||||
[ set-pane-output ] [ swap add-gadget drop ] 2bi ;
|
||||
|
||||
: add-current ( current pane -- )
|
||||
[ set-pane-current ] [ add-gadget ] 2bi ;
|
||||
[ set-pane-current ] [ swap add-gadget drop ] 2bi ;
|
||||
|
||||
: prepare-line ( pane -- )
|
||||
[ clear-selection ]
|
||||
|
@ -120,7 +120,7 @@ C: <pane-stream> pane-stream
|
|||
GENERIC: write-gadget ( gadget stream -- )
|
||||
|
||||
M: pane-stream write-gadget
|
||||
pane-stream-pane pane-current add-gadget ;
|
||||
pane-stream-pane pane-current swap add-gadget drop ;
|
||||
|
||||
M: style-stream write-gadget
|
||||
stream>> write-gadget ;
|
||||
|
@ -299,12 +299,12 @@ M: paragraph dispose drop ;
|
|||
|
||||
: gadget-write ( string gadget -- )
|
||||
over empty?
|
||||
[ 2drop ] [ >r <label> text-theme r> add-gadget ] if ;
|
||||
[ 2drop ] [ >r <label> text-theme r> swap add-gadget drop ] if ;
|
||||
|
||||
M: pack stream-write gadget-write ;
|
||||
|
||||
: gadget-bl ( style stream -- )
|
||||
>r " " <word-break-gadget> style-label r> add-gadget ;
|
||||
>r " " <word-break-gadget> style-label r> swap add-gadget drop ;
|
||||
|
||||
M: paragraph stream-write
|
||||
swap " " split
|
||||
|
@ -322,7 +322,7 @@ M: paragraph stream-write1
|
|||
|
||||
: gadget-format ( string style stream -- )
|
||||
pick empty?
|
||||
[ 3drop ] [ >r swap <styled-label> r> add-gadget ] if ;
|
||||
[ 3drop ] [ >r swap <styled-label> r> swap add-gadget drop ] if ;
|
||||
|
||||
M: pack stream-format
|
||||
gadget-format ;
|
||||
|
|
|
@ -140,7 +140,7 @@ M: elevator layout*
|
|||
|
||||
: elevator, ( orientation -- )
|
||||
dup <elevator> g-> set-slider-elevator
|
||||
swap <thumb> g-> set-slider-thumb over add-gadget
|
||||
swap <thumb> g-> set-slider-thumb add-gadget
|
||||
@center frame, ;
|
||||
|
||||
: <left-button> ( -- button )
|
||||
|
|
|
@ -16,7 +16,7 @@ DEFER: (del-page)
|
|||
[ [ gadget-parent '[ , , , (del-page) ] "X" swap
|
||||
<bevel-button> @right frame, ] 3keep
|
||||
[ swapd <toggle-button> @center frame, ] dip ] make-frame
|
||||
swap add-gadget ;
|
||||
add-gadget drop ;
|
||||
|
||||
: redo-toggler ( tabbed -- )
|
||||
[ names>> ] [ model>> ] [ toggler>> ] tri
|
||||
|
@ -41,7 +41,7 @@ DEFER: (del-page)
|
|||
[ [ model>> swap ]
|
||||
[ names>> length 1 - swap ]
|
||||
[ toggler>> ] tri add-toggle ]
|
||||
[ content>> add-gadget ]
|
||||
[ content>> swap add-gadget drop ]
|
||||
[ refresh-book ] tri ;
|
||||
|
||||
: del-page ( name tabbed -- )
|
||||
|
|
|
@ -47,7 +47,7 @@ M: track pref-dim*
|
|||
rot gadget-orientation set-axis ;
|
||||
|
||||
: track-add ( gadget track constraint -- )
|
||||
over track-sizes push add-gadget ;
|
||||
over track-sizes push swap add-gadget drop ;
|
||||
|
||||
: track, ( gadget constraint -- )
|
||||
gadget get swap track-add ;
|
||||
|
|
|
@ -18,7 +18,7 @@ TUPLE: viewport < gadget ;
|
|||
viewport new-gadget
|
||||
swap >>model
|
||||
t >>clipped?
|
||||
[ add-gadget ] keep ;
|
||||
[ swap add-gadget drop ] keep ;
|
||||
|
||||
M: viewport layout*
|
||||
dup rect-dim viewport-gap 2 v*n v-
|
||||
|
|
|
@ -7,7 +7,7 @@ TUPLE: wrapper < gadget ;
|
|||
|
||||
: new-wrapper ( child class -- wrapper )
|
||||
new-gadget
|
||||
[ add-gadget ] keep ; inline
|
||||
[ swap add-gadget drop ] keep ; inline
|
||||
|
||||
: <wrapper> ( child -- border )
|
||||
wrapper new-wrapper ;
|
||||
|
|
Loading…
Reference in New Issue