Refactoring usages of >r/r> to dip in UI
Slava Pestov
parent
268f3e4838
commit
cdf3b48986
|
|
@ -33,7 +33,7 @@ SYMBOL: selection
|
|||
|
||||
: gadget-copy ( gadget clipboard -- )
|
||||
over gadget-selection?
|
||||
[ >r [ gadget-selection ] keep r> copy-clipboard ]
|
||||
[ [ [ gadget-selection ] keep ] dip copy-clipboard ]
|
||||
[ 2drop ]
|
||||
if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ command-line kernel memory namespaces cocoa.messages
|
|||
cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
|
||||
cocoa.windows cocoa.classes cocoa.application sequences system
|
||||
ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
|
||||
ui.cocoa.views core-foundation threads math.geometry.rect ;
|
||||
ui.cocoa.views core-foundation threads math.geometry.rect fry ;
|
||||
IN: ui.cocoa
|
||||
|
||||
TUPLE: handle view window ;
|
||||
|
|
@ -15,7 +15,7 @@ C: <handle> handle
|
|||
SINGLETON: cocoa-ui-backend
|
||||
|
||||
M: cocoa-ui-backend do-events ( -- )
|
||||
[ NSApp [ do-event ] curry loop ui-wait ] with-autorelease-pool ;
|
||||
[ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
|
||||
|
||||
TUPLE: pasteboard handle ;
|
||||
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ CLASS: {
|
|||
}
|
||||
|
||||
{ "application:openFiles:" "void" { "id" "SEL" "id" "id" }
|
||||
[ >r 3drop r> finder-run-files ]
|
||||
[ [ 3drop ] dip finder-run-files ]
|
||||
}
|
||||
|
||||
{ "newFactorWorkspace:" "id" { "id" "SEL" "id" }
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ core-foundation threads combinators math.geometry.rect ;
|
|||
IN: ui.cocoa.views
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
over >r mouse-location r> window move-hand fire-motion ;
|
||||
[ mouse-location ] [ drop window ] 2bi move-hand fire-motion ;
|
||||
|
||||
: button ( event -- n )
|
||||
#! Cocoa -> Factor UI button mapping
|
||||
|
|
@ -85,18 +85,19 @@ IN: ui.cocoa.views
|
|||
mouse-location rot window send-button-up ;
|
||||
|
||||
: send-wheel$ ( view event -- )
|
||||
over >r
|
||||
dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
|
||||
mouse-location
|
||||
r> window send-wheel ;
|
||||
[
|
||||
dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
|
||||
mouse-location
|
||||
] [ drop window ] 2bi send-wheel ;
|
||||
|
||||
: send-action$ ( view event gesture -- junk )
|
||||
>r drop window r> send-action f ;
|
||||
[ drop window ] dip send-action f ;
|
||||
|
||||
: add-resize-observer ( observer object -- )
|
||||
>r "updateFactorGadgetSize:"
|
||||
"NSViewFrameDidChangeNotification" <NSString>
|
||||
r> add-observer ;
|
||||
[
|
||||
"updateFactorGadgetSize:"
|
||||
"NSViewFrameDidChangeNotification" <NSString>
|
||||
] dip add-observer ;
|
||||
|
||||
: string-or-nil? ( NSString -- ? )
|
||||
[ CF>string NSStringPboardType = ] [ t ] if* ;
|
||||
|
|
@ -109,7 +110,7 @@ IN: ui.cocoa.views
|
|||
] if ;
|
||||
|
||||
: NSRect>rect ( NSRect world -- rect )
|
||||
>r dup NSRect-x over NSRect-y r>
|
||||
[ dup NSRect-x over NSRect-y ] dip
|
||||
rect-dim second swap - 2array
|
||||
over NSRect-w rot NSRect-h 2array
|
||||
<rect> ;
|
||||
|
|
@ -256,7 +257,7 @@ CLASS: {
|
|||
{ "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
|
||||
[
|
||||
! We return either self or nil
|
||||
>r >r over window-focus r> r>
|
||||
[ over window-focus ] 2dip
|
||||
valid-service? [ drop ] [ 2drop f ] if
|
||||
]
|
||||
}
|
||||
|
|
@ -278,7 +279,7 @@ CLASS: {
|
|||
{ "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
|
||||
[
|
||||
pasteboard-string dup [
|
||||
>r drop window-focus r> swap user-input 1
|
||||
[ drop window-focus ] dip swap user-input 1
|
||||
] [
|
||||
3drop 0
|
||||
] if
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays definitions kernel sequences strings
|
||||
math assocs words generic namespaces make assocs quotations
|
||||
splitting ui.gestures unicode.case unicode.categories tr ;
|
||||
splitting ui.gestures unicode.case unicode.categories tr fry ;
|
||||
IN: ui.commands
|
||||
|
||||
SYMBOL: +nullary+
|
||||
|
|
@ -37,7 +37,7 @@ GENERIC: command-word ( command -- word )
|
|||
[
|
||||
commands>>
|
||||
[ drop ] assoc-filter
|
||||
[ [ invoke-command ] curry swap set ] assoc-each
|
||||
[ '[ _ invoke-command ] swap set ] assoc-each
|
||||
] each
|
||||
] H{ } make-assoc ;
|
||||
|
||||
|
|
|
|||
|
|
@ -111,7 +111,7 @@ M: freetype-renderer open-font ( font -- open-font )
|
|||
freetype drop open-fonts get [ <font> ] cache ;
|
||||
|
||||
: load-glyph ( font char -- glyph )
|
||||
>r handle>> dup r> 0 FT_Load_Char
|
||||
[ handle>> dup ] dip 0 FT_Load_Char
|
||||
freetype-error face-glyph ;
|
||||
|
||||
: char-width ( open-font char -- w )
|
||||
|
|
@ -174,7 +174,7 @@ M: freetype-renderer string-height ( open-font string -- h )
|
|||
bi 2array ;
|
||||
|
||||
: <char-sprite> ( open-font char -- sprite )
|
||||
over >r render-glyph dup r> glyph-texture-loc
|
||||
over [ render-glyph dup ] dip glyph-texture-loc
|
||||
over glyph-size pick glyph-texture-size <sprite>
|
||||
[ bitmap>texture ] keep [ init-sprite ] keep ;
|
||||
|
||||
|
|
@ -206,7 +206,7 @@ M: freetype-renderer string-height ( open-font string -- h )
|
|||
fonts>> [ open-font H{ } clone 2array ] cache first2 ;
|
||||
|
||||
M: freetype-renderer draw-string ( font string loc -- )
|
||||
>r >r world get font-sprites r> r> (draw-string) ;
|
||||
[ world get font-sprites ] 2dip (draw-string) ;
|
||||
|
||||
: run-char-widths ( open-font string -- widths )
|
||||
char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences models ui.gadgets math.geometry.rect ;
|
||||
USING: accessors kernel sequences models ui.gadgets
|
||||
math.geometry.rect fry ;
|
||||
IN: ui.gadgets.books
|
||||
|
||||
TUPLE: book < gadget ;
|
||||
|
|
@ -25,6 +26,6 @@ M: book model-changed ( model book -- )
|
|||
M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
|
||||
|
||||
M: book layout* ( book -- )
|
||||
[ children>> ] [ dim>> ] bi [ >>dim drop ] curry each ;
|
||||
[ children>> ] [ dim>> ] bi '[ _ >>dim drop ] each ;
|
||||
|
||||
M: book focusable-child* ( book -- child/t ) current-page ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors arrays hashtables kernel models math namespaces
|
||||
make sequences quotations math.vectors combinators sorting
|
||||
binary-search vectors dlists deques models threads
|
||||
concurrency.flags math.order math.geometry.rect ;
|
||||
concurrency.flags math.order math.geometry.rect fry ;
|
||||
IN: ui.gadgets
|
||||
|
||||
SYMBOL: ui-notify-flag
|
||||
|
|
@ -56,9 +56,7 @@ M: gadget model-changed 2drop ;
|
|||
2dup eq? [
|
||||
2drop { 0 0 }
|
||||
] [
|
||||
over rect-loc >r
|
||||
>r parent>> r> relative-loc
|
||||
r> v+
|
||||
over rect-loc [ [ parent>> ] dip relative-loc ] dip v+
|
||||
] if ;
|
||||
|
||||
GENERIC: user-input* ( str gadget -- ? )
|
||||
|
|
@ -73,7 +71,7 @@ M: gadget children-on nip children>> ;
|
|||
[ swap loc>> v- ] dip v. 0 <=> ;
|
||||
|
||||
: (fast-children-on) ( dim axis children -- i )
|
||||
-rot [ ((fast-children-on)) ] 2curry search drop ;
|
||||
-rot '[ _ _ ((fast-children-on)) ] search drop ;
|
||||
|
||||
: fast-children-on ( rect axis children -- from to )
|
||||
[ [ rect-loc ] 2dip (fast-children-on) 0 or ]
|
||||
|
|
@ -95,10 +93,10 @@ M: gadget children-on nip children>> ;
|
|||
: dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ;
|
||||
|
||||
: orient ( gadget seq1 seq2 -- seq )
|
||||
>r >r orientation>> r> r> [ pick set-axis ] 2map nip ;
|
||||
rot orientation>> '[ [ _ ] 2dip set-axis ] 2map ;
|
||||
|
||||
: each-child ( gadget quot -- )
|
||||
>r children>> r> each ; inline
|
||||
[ children>> ] dip each ; inline
|
||||
|
||||
! Selection protocol
|
||||
GENERIC: gadget-selection? ( gadget -- ? )
|
||||
|
|
@ -310,18 +308,18 @@ SYMBOL: in-layout?
|
|||
[ parent>> ] follow ;
|
||||
|
||||
: each-parent ( gadget quot -- ? )
|
||||
>r parents r> all? ; inline
|
||||
[ parents ] dip all? ; inline
|
||||
|
||||
: find-parent ( gadget quot -- parent )
|
||||
>r parents r> find nip ; inline
|
||||
[ parents ] dip find nip ; inline
|
||||
|
||||
: screen-loc ( gadget -- loc )
|
||||
parents { 0 0 } [ rect-loc v+ ] reduce ;
|
||||
|
||||
: (screen-rect) ( gadget -- loc ext )
|
||||
dup parent>> [
|
||||
>r rect-extent r> (screen-rect)
|
||||
>r tuck v+ r> vmin >r v+ r>
|
||||
[ rect-extent ] dip (screen-rect)
|
||||
[ tuck v+ ] dip vmin [ v+ ] dip
|
||||
] [
|
||||
rect-extent
|
||||
] if* ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors math namespaces opengl opengl.gl sequences
|
||||
math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ;
|
||||
USING: kernel accessors math namespaces opengl opengl.gl
|
||||
sequences math.vectors ui.gadgets ui.gadgets.grids ui.render
|
||||
math.geometry.rect fry ;
|
||||
IN: ui.gadgets.grid-lines
|
||||
|
||||
TUPLE: grid-lines color ;
|
||||
|
|
@ -19,8 +20,8 @@ SYMBOL: grid-dim
|
|||
|
||||
: draw-grid-lines ( gaps orientation -- )
|
||||
[ grid get swap grid-positions grid get rect-dim suffix ] dip
|
||||
[ [ v- ] curry map ] keep
|
||||
[ swap grid-line-from/to gl-line ] curry each ;
|
||||
[ '[ _ v- ] map ] keep
|
||||
'[ _ swap grid-line-from/to gl-line ] each ;
|
||||
|
||||
M: grid-lines draw-boundary
|
||||
color>> gl-color [
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math namespaces make sequences words io
|
||||
io.streams.string math.vectors ui.gadgets columns accessors
|
||||
math.geometry.rect locals ;
|
||||
math.geometry.rect locals fry ;
|
||||
IN: ui.gadgets.grids
|
||||
|
||||
TUPLE: grid < gadget
|
||||
|
|
@ -48,21 +48,18 @@ grid
|
|||
dupd add-gaps dim-sum v+ ;
|
||||
|
||||
M: grid pref-dim*
|
||||
dup gap>> swap compute-grid >r over r>
|
||||
gap-sum >r gap-sum r> (pair-up) ;
|
||||
dup gap>> swap compute-grid [ over ] dip
|
||||
[ gap-sum ] 2bi@ (pair-up) ;
|
||||
|
||||
: do-grid ( dims grid quot -- )
|
||||
-rot grid>>
|
||||
[ [ pick call ] 2each ] 2each
|
||||
drop ; inline
|
||||
[ grid>> ] dip '[ _ 2each ] 2each ; inline
|
||||
|
||||
: grid-positions ( grid dims -- locs )
|
||||
>r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ;
|
||||
[ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
|
||||
|
||||
: position-grid ( grid horiz vert -- )
|
||||
pick >r
|
||||
>r over r> grid-positions >r grid-positions r>
|
||||
pair-up r> [ (>>loc) ] do-grid ;
|
||||
pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
|
||||
[ (>>loc) ] do-grid ;
|
||||
|
||||
: resize-grid ( grid horiz vert -- )
|
||||
pick fill?>> [
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays ui.gadgets.buttons ui.gadgets.borders
|
||||
ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
|
||||
|
|
@ -19,10 +19,10 @@ TUPLE: labelled-gadget < track content ;
|
|||
M: labelled-gadget focusable-child* content>> ;
|
||||
|
||||
: <labelled-scroller> ( gadget title -- gadget )
|
||||
>r <scroller> r> <labelled-gadget> ;
|
||||
[ <scroller> ] dip <labelled-gadget> ;
|
||||
|
||||
: <labelled-pane> ( model quot scrolls? title -- gadget )
|
||||
>r >r <pane-control> r> >>scrolls? r>
|
||||
[ [ <pane-control> ] dip >>scrolls? ] dip
|
||||
<labelled-scroller> ;
|
||||
|
||||
: <close-box> ( quot -- button/f )
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ TUPLE: label < gadget text font color ;
|
|||
|
||||
: set-label-string ( string label -- )
|
||||
CHAR: \n pick memq? [
|
||||
>r string-lines r> (>>text)
|
||||
[ string-lines ] dip (>>text)
|
||||
] [
|
||||
(>>text)
|
||||
] if ; inline
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ TUPLE: list < pack index presenter color hook ;
|
|||
hook>> [ [ list? ] find-parent ] prepend ;
|
||||
|
||||
: <list-presentation> ( hook elt presenter -- gadget )
|
||||
keep >r >label text-theme r>
|
||||
keep [ >label text-theme ] dip
|
||||
<presentation>
|
||||
swap >>hook ; inline
|
||||
|
||||
|
|
@ -42,7 +42,7 @@ TUPLE: list < pack index presenter color hook ;
|
|||
[ presenter>> ]
|
||||
[ control-value ]
|
||||
tri [
|
||||
>r 2dup r> swap <list-presentation>
|
||||
[ 2dup ] dip swap <list-presentation>
|
||||
] map 2nip ;
|
||||
|
||||
M: list model-changed
|
||||
|
|
@ -113,8 +113,8 @@ M: list focusable-child* drop t ;
|
|||
select-gadget ;
|
||||
|
||||
: list-page ( list vec -- )
|
||||
>r dup selected-rect rect-bounds 2 v/n v+
|
||||
over visible-dim r> v* v+ swap select-at ;
|
||||
[ dup selected-rect rect-bounds 2 v/n v+ over visible-dim ] dip
|
||||
v* v+ swap select-at ;
|
||||
|
||||
: list-page-up ( list -- ) { 0 -1 } list-page ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,13 +8,13 @@ math.geometry.rect ;
|
|||
IN: ui.gadgets.menus
|
||||
|
||||
: menu-loc ( world menu -- loc )
|
||||
>r rect-dim r> pref-dim [v-] hand-loc get-global vmin ;
|
||||
[ rect-dim ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
|
||||
|
||||
TUPLE: menu-glass < gadget ;
|
||||
|
||||
: <menu-glass> ( menu world -- glass )
|
||||
menu-glass new-gadget
|
||||
>r over menu-loc >>loc r>
|
||||
[ over menu-loc >>loc ] dip
|
||||
swap add-gadget ;
|
||||
|
||||
M: menu-glass layout* gadget-child prefer ;
|
||||
|
|
|
|||
|
|
@ -19,10 +19,10 @@ TUPLE: pack < gadget
|
|||
{ 0 0 } [ v+ over v+ ] accumulate 2nip ;
|
||||
|
||||
: aligned-locs ( gadget sizes -- seq )
|
||||
[ >r dup align>> swap rect-dim r> v- n*v ] with map ;
|
||||
[ [ dup align>> swap rect-dim ] dip v- n*v ] with map ;
|
||||
|
||||
: packed-locs ( gadget sizes -- seq )
|
||||
over gap>> over gap-locs >r dupd aligned-locs r> orient ;
|
||||
over gap>> over gap-locs [ dupd aligned-locs ] dip orient ;
|
||||
|
||||
: round-dims ( seq -- newseq )
|
||||
{ 0 0 } swap
|
||||
|
|
@ -31,8 +31,9 @@ TUPLE: pack < gadget
|
|||
|
||||
: pack-layout ( pack sizes -- )
|
||||
round-dims over children>>
|
||||
>r dupd packed-dims r> 2dup [ (>>dim) ] 2each
|
||||
>r packed-locs r> [ (>>loc) ] 2each ;
|
||||
[ dupd packed-dims ] dip
|
||||
[ [ (>>dim) ] 2each ]
|
||||
[ [ packed-locs ] dip [ (>>loc) ] 2each ] 2bi ;
|
||||
|
||||
: <pack> ( orientation -- pack )
|
||||
pack new-gadget
|
||||
|
|
@ -48,7 +49,7 @@ TUPLE: pack < gadget
|
|||
[ dim-sum ] keep length 1 [-] rot n*v v+ ;
|
||||
|
||||
: pack-pref-dim ( gadget sizes -- dim )
|
||||
over gap>> over gap-dims >r max-dim r>
|
||||
over gap>> over gap-dims [ max-dim ] dip
|
||||
rot orientation>> set-axis ;
|
||||
|
||||
M: pack pref-dim*
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ opengl combinators math.vectors sorting splitting
|
|||
io.streams.nested assocs ui.gadgets.presentations
|
||||
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
|
||||
classes.tuple models continuations destructors accessors
|
||||
math.geometry.rect ;
|
||||
math.geometry.rect fry ;
|
||||
IN: ui.gadgets.panes
|
||||
|
||||
TUPLE: pane < pack
|
||||
|
|
@ -59,7 +59,7 @@ M: pane gadget-selection ( pane -- string/f )
|
|||
GENERIC: draw-selection ( loc obj -- )
|
||||
|
||||
: if-fits ( rect quot -- )
|
||||
>r clip get over intersects? r> [ drop ] if ; inline
|
||||
[ clip get over intersects? ] dip [ drop ] if ; inline
|
||||
|
||||
M: gadget draw-selection ( loc gadget -- )
|
||||
swap offset-rect [
|
||||
|
|
@ -135,8 +135,8 @@ M: style-stream write-gadget
|
|||
|
||||
: with-pane ( pane quot -- )
|
||||
over scroll>top
|
||||
over pane-clear >r <pane-stream> r>
|
||||
over >r with-output-stream* r> ?nl ; inline
|
||||
over pane-clear [ <pane-stream> ] dip
|
||||
over [ with-output-stream* ] dip ?nl ; inline
|
||||
|
||||
: make-pane ( quot -- gadget )
|
||||
<pane> [ swap with-pane ] keep smash-pane ; inline
|
||||
|
|
@ -154,7 +154,7 @@ M: pane-control model-changed ( model pane-control -- )
|
|||
swap >>model ;
|
||||
|
||||
: do-pane-stream ( pane-stream quot -- )
|
||||
>r pane>> r> keep scroll-pane ; inline
|
||||
[ pane>> ] dip keep scroll-pane ; inline
|
||||
|
||||
M: pane-stream stream-nl
|
||||
[ pane-nl drop ] do-pane-stream ;
|
||||
|
|
@ -178,7 +178,7 @@ M: pane-stream make-span-stream
|
|||
! Character styles
|
||||
|
||||
: apply-style ( style gadget key quot -- style gadget )
|
||||
>r pick at r> when* ; inline
|
||||
[ pick at ] dip when* ; inline
|
||||
|
||||
: apply-foreground-style ( style gadget -- style gadget )
|
||||
foreground [ >>color ] apply-style ;
|
||||
|
|
@ -228,7 +228,7 @@ M: pane-stream make-span-stream
|
|||
border-width [ <border> ] apply-style ;
|
||||
|
||||
: apply-printer-style ( style gadget -- style gadget )
|
||||
presented-printer [ [ make-pane ] curry >>printer ] apply-style ;
|
||||
presented-printer [ '[ _ make-pane ] >>printer ] apply-style ;
|
||||
|
||||
: style-pane ( style pane -- pane )
|
||||
apply-border-width-style
|
||||
|
|
@ -284,10 +284,10 @@ M: pane-stream make-cell-stream
|
|||
pane-cell-stream new-nested-pane-stream ;
|
||||
|
||||
M: pane-stream stream-write-table
|
||||
>r
|
||||
swap [ [ pane>> smash-pane ] map ] map
|
||||
styled-grid
|
||||
r> print-gadget ;
|
||||
[
|
||||
swap [ [ pane>> smash-pane ] map ] map
|
||||
styled-grid
|
||||
] dip print-gadget ;
|
||||
|
||||
! Stream utilities
|
||||
M: pack dispose drop ;
|
||||
|
|
@ -309,7 +309,7 @@ M: paragraph stream-write
|
|||
drop ;
|
||||
|
||||
: gadget-write1 ( char gadget -- )
|
||||
>r 1string r> stream-write ;
|
||||
[ 1string ] dip stream-write ;
|
||||
|
||||
M: pack stream-write1 gadget-write1 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ TUPLE: presentation < button object hook ;
|
|||
|
||||
: invoke-presentation ( presentation command -- )
|
||||
over dup hook>> call
|
||||
>r object>> r> invoke-command ;
|
||||
[ object>> ] dip invoke-command ;
|
||||
|
||||
: invoke-primary ( presentation -- )
|
||||
dup object>> primary-operation
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
|
|||
ui.gadgets.frames ui.gadgets.grids math.order
|
||||
ui.gadgets.theme ui.render kernel math namespaces sequences
|
||||
vectors models models.range math.vectors math.functions
|
||||
quotations colors math.geometry.rect ;
|
||||
quotations colors math.geometry.rect fry ;
|
||||
IN: ui.gadgets.sliders
|
||||
|
||||
TUPLE: elevator < gadget direction ;
|
||||
|
|
@ -104,13 +104,14 @@ elevator H{
|
|||
|
||||
: layout-thumb-loc ( slider -- )
|
||||
dup thumb-loc (layout-thumb)
|
||||
>r [ floor ] map r> (>>loc) ;
|
||||
[ [ floor ] map ] dip (>>loc) ;
|
||||
|
||||
: layout-thumb-dim ( slider -- )
|
||||
dup dup thumb-dim (layout-thumb) >r
|
||||
>r dup rect-dim r>
|
||||
rot orientation>> set-axis [ ceiling ] map
|
||||
r> (>>dim) ;
|
||||
dup dup thumb-dim (layout-thumb)
|
||||
[
|
||||
[ dup rect-dim ] dip
|
||||
rot orientation>> set-axis [ ceiling ] map
|
||||
] dip (>>dim) ;
|
||||
|
||||
: layout-thumb ( slider -- )
|
||||
dup layout-thumb-loc layout-thumb-dim ;
|
||||
|
|
@ -121,13 +122,13 @@ M: elevator layout*
|
|||
: slide-by-line ( amount slider -- ) [ line>> * ] keep slide-by ;
|
||||
|
||||
: <slide-button> ( vector polygon amount -- button )
|
||||
>r gray swap <polygon-gadget> r>
|
||||
[ swap find-slider slide-by-line ] curry <repeat-button>
|
||||
[ gray swap <polygon-gadget> ] dip
|
||||
'[ _ swap find-slider slide-by-line ] <repeat-button>
|
||||
swap >>orientation ;
|
||||
|
||||
: elevator, ( gadget orientation -- gadget )
|
||||
tuck <elevator> >>elevator
|
||||
swap <thumb> >>thumb
|
||||
swap <thumb> >>thumb
|
||||
dup elevator>> over thumb>> add-gadget
|
||||
@center grid-add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -16,4 +16,4 @@ IN: ui.gadgets.status-bar
|
|||
open-world-window ;
|
||||
|
||||
: show-summary ( object gadget -- )
|
||||
>r [ summary ] [ "" ] if* r> show-status ;
|
||||
[ [ summary ] [ "" ] if* ] dip show-status ;
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ M: world request-focus-on ( child gadget -- )
|
|||
M: world layout*
|
||||
dup call-next-method
|
||||
dup glass>> [
|
||||
>r dup rect-dim r> (>>dim)
|
||||
[ dup rect-dim ] dip (>>dim)
|
||||
] when* drop ;
|
||||
|
||||
M: world focusable-child* gadget-child ;
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ SYMBOL: operations
|
|||
operations get [ predicate>> call ] with filter ;
|
||||
|
||||
: find-operation ( obj quot -- command )
|
||||
>r object-operations r> find-last nip ; inline
|
||||
[ object-operations ] dip find-last nip ; inline
|
||||
|
||||
: primary-operation ( obj -- operation )
|
||||
[ command>> +primary+ word-prop ] find-operation ;
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ SYMBOL: viewport-translation
|
|||
|
||||
: flip-rect ( rect -- loc dim )
|
||||
rect-bounds [
|
||||
>r { 1 -1 } v* r> { 0 -1 } v* v+
|
||||
[ { 1 -1 } v* ] dip { 0 -1 } v* v+
|
||||
viewport-translation get v+
|
||||
] keep ;
|
||||
|
||||
|
|
@ -79,9 +79,7 @@ DEFER: draw-gadget
|
|||
>absolute clip [ rect-intersect ] change ;
|
||||
|
||||
: with-clipping ( gadget quot -- )
|
||||
clip get >r
|
||||
over change-clip do-clip call
|
||||
r> clip set do-clip ; inline
|
||||
clip get [ over change-clip do-clip call ] dip clip set do-clip ; inline
|
||||
|
||||
: draw-gadget ( gadget -- )
|
||||
{
|
||||
|
|
@ -200,7 +198,7 @@ M: polygon draw-interior
|
|||
|
||||
: <polygon-gadget> ( color points -- gadget )
|
||||
dup max-dim
|
||||
>r <polygon> <gadget> r> >>dim
|
||||
[ <polygon> <gadget> ] dip >>dim
|
||||
swap >>interior ;
|
||||
|
||||
! Font rendering
|
||||
|
|
@ -242,7 +240,7 @@ HOOK: free-fonts font-renderer ( world -- )
|
|||
[
|
||||
[
|
||||
2dup { 0 0 } draw-string
|
||||
>r open-font r> string-height
|
||||
[ open-font ] dip string-height
|
||||
0.0 swap 0.0 glTranslated
|
||||
] with each
|
||||
] with-translation
|
||||
|
|
|
|||
|
|
@ -1,12 +1,11 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ui.gadgets colors kernel ui.render namespaces
|
||||
models models.mapping sequences ui.gadgets.buttons
|
||||
ui.gadgets.packs ui.gadgets.labels tools.deploy.config
|
||||
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
|
||||
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
|
||||
tools.deploy vocabs ui.tools.workspace system accessors ;
|
||||
|
||||
USING: ui.gadgets colors kernel ui.render namespaces models
|
||||
models.mapping sequences ui.gadgets.buttons ui.gadgets.packs
|
||||
ui.gadgets.labels tools.deploy.config namespaces
|
||||
ui.gadgets.editors ui.gadgets.borders ui.gestures ui.commands
|
||||
assocs ui.gadgets.tracks ui ui.tools.listener tools.deploy
|
||||
vocabs ui.tools.workspace system accessors fry ;
|
||||
IN: ui.tools.deploy
|
||||
|
||||
TUPLE: deploy-gadget < pack vocab settings ;
|
||||
|
|
@ -83,7 +82,7 @@ TUPLE: deploy-gadget < pack vocab settings ;
|
|||
|
||||
: com-deploy ( gadget -- )
|
||||
dup com-save
|
||||
dup find-deploy-vocab [ deploy ] curry call-listener
|
||||
dup find-deploy-vocab '[ _ deploy ] call-listener
|
||||
close-window ;
|
||||
|
||||
: com-help ( -- )
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ quotations sequences strings threads listener classes.tuple
|
|||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
|
||||
ui.gadgets.presentations ui.gadgets.worlds ui.gestures
|
||||
definitions calendar concurrency.flags concurrency.mailboxes
|
||||
ui.tools.workspace accessors sets destructors ;
|
||||
ui.tools.workspace accessors sets destructors fry ;
|
||||
IN: ui.tools.interactor
|
||||
|
||||
! If waiting is t, we're waiting for user input, and invoking
|
||||
|
|
@ -88,7 +88,7 @@ M: interactor model-changed
|
|||
[ editor-string ] keep
|
||||
[ interactor-input. ] 2keep
|
||||
[ add-interactor-history ] keep
|
||||
[ clear-input ] curry "Clearing input" spawn drop ;
|
||||
'[ _ clear-input ] "Clearing input" spawn drop ;
|
||||
|
||||
: interactor-eof ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
|
|
@ -126,7 +126,7 @@ M: interactor stream-read
|
|||
swap dup zero? [
|
||||
2drop ""
|
||||
] [
|
||||
>r interactor-read dup [ "\n" join ] when r> short head
|
||||
[ interactor-read dup [ "\n" join ] when ] dip short head
|
||||
] if ;
|
||||
|
||||
M: interactor stream-read-partial
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ M: listener-gadget focusable-child*
|
|||
input>> ;
|
||||
|
||||
M: listener-gadget call-tool* ( input listener -- )
|
||||
>r string>> r> input>> set-editor-string ;
|
||||
[ string>> ] dip input>> set-editor-string ;
|
||||
|
||||
M: listener-gadget tool-scroller
|
||||
output>> find-scroller ;
|
||||
|
|
@ -95,13 +95,13 @@ M: engine-word word-completion-string
|
|||
: use-if-necessary ( word seq -- )
|
||||
over vocabulary>> over and [
|
||||
2dup [ assoc-stack ] keep = [ 2drop ] [
|
||||
>r vocabulary>> vocab-words r> push
|
||||
[ vocabulary>> vocab-words ] dip push
|
||||
] if
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: insert-word ( word -- )
|
||||
get-workspace listener>> input>>
|
||||
[ >r word-completion-string r> user-input* drop ]
|
||||
[ [ word-completion-string ] dip user-input* drop ]
|
||||
[ interactor-use use-if-necessary ]
|
||||
2bi ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ui.tools.workspace kernel quotations tools.profiler
|
||||
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors ;
|
||||
ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
|
||||
IN: ui.tools.profiler
|
||||
|
||||
TUPLE: profiler-gadget < track pane ;
|
||||
|
|
@ -14,7 +14,7 @@ TUPLE: profiler-gadget < track pane ;
|
|||
dup pane>> <scroller> 1 track-add ;
|
||||
|
||||
: with-profiler-pane ( gadget quot -- )
|
||||
>r pane>> r> with-pane ;
|
||||
[ pane>> ] dip with-pane ;
|
||||
|
||||
: com-full-profile ( gadget -- )
|
||||
[ profile. ] with-profiler-pane ;
|
||||
|
|
@ -39,10 +39,10 @@ profiler-gadget "toolbar" f {
|
|||
GENERIC: profiler-presentation ( obj -- quot )
|
||||
|
||||
M: usage-profile profiler-presentation
|
||||
word>> [ usage-profile. ] curry ;
|
||||
word>> '[ _ usage-profile. ] ;
|
||||
|
||||
M: vocab-profile profiler-presentation
|
||||
vocab>> [ vocab-profile. ] curry ;
|
||||
vocab>> '[ _ vocab-profile. ] ;
|
||||
|
||||
M: f profiler-presentation
|
||||
drop [ vocabs-profile. ] ;
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ IN: ui.tools.search.tests
|
|||
] with-grafted-gadget ;
|
||||
|
||||
: test-live-search ( gadget quot -- ? )
|
||||
>r update-live-search dup assert-non-empty r> all? ;
|
||||
[ update-live-search dup assert-non-empty ] dip all? ;
|
||||
|
||||
[ t ] [
|
||||
"swp" all-words f <definition-search>
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
|
|||
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
|
||||
ui.gadgets.presentations ui.gestures words vocabs.loader
|
||||
tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
|
||||
mirrors ;
|
||||
mirrors fry ;
|
||||
IN: ui.tools
|
||||
|
||||
: <workspace-tabs> ( workspace -- tabs )
|
||||
|
|
@ -93,7 +93,7 @@ workspace "workflow" f {
|
|||
] workspace-window-hook set-global
|
||||
|
||||
: inspect-continuation ( traceback -- )
|
||||
control-value [ inspect ] curry call-listener ;
|
||||
control-value '[ _ inspect ] call-listener ;
|
||||
|
||||
traceback-gadget "toolbar" f {
|
||||
{ T{ key-down f f "v" } variables }
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ ui.tools.listener ui.tools.traceback ui.gadgets.buttons
|
|||
ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
|
||||
models models.filter ui.tools.workspace ui.gestures
|
||||
ui.gadgets.labels ui threads namespaces make tools.walker assocs
|
||||
combinators ;
|
||||
combinators fry ;
|
||||
IN: ui.tools.walker
|
||||
|
||||
TUPLE: walker-gadget < track
|
||||
|
|
@ -53,7 +53,7 @@ M: walker-gadget focusable-child*
|
|||
] "" make ;
|
||||
|
||||
: <thread-status> ( model thread -- gadget )
|
||||
[ walker-state-string ] curry <filter> <label-control> ;
|
||||
'[ _ walker-state-string ] <filter> <label-control> ;
|
||||
|
||||
: <walker-gadget> ( status continuation thread -- gadget )
|
||||
{ 0 1 } walker-gadget new-track
|
||||
|
|
@ -89,7 +89,7 @@ walker-gadget "toolbar" f {
|
|||
} cond ;
|
||||
|
||||
: find-walker-window ( thread -- world/f )
|
||||
[ swap walker-for-thread? ] curry find-window ;
|
||||
'[ _ swap walker-for-thread? ] find-window ;
|
||||
|
||||
: walker-window ( status continuation thread -- )
|
||||
[ <walker-gadget> ] [ name>> ] bi open-status-window ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes continuations help help.topics kernel models
|
||||
sequences assocs arrays namespaces accessors math.vectors ui
|
||||
sequences assocs arrays namespaces accessors math.vectors fry ui
|
||||
ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
|
||||
ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
|
||||
|
|
@ -33,7 +33,7 @@ M: gadget tool-scroller drop f ;
|
|||
set-model ;
|
||||
|
||||
: get-workspace* ( quot -- workspace )
|
||||
[ >r dup workspace? r> [ drop f ] if ] curry find-window
|
||||
'[ dup workspace? _ [ drop f ] if ] find-window
|
||||
[ dup raise-window gadget-child ]
|
||||
[ workspace-window* ] if* ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -288,7 +288,7 @@ SYMBOL: nc-buttons
|
|||
: mouse-wheel ( lParam -- array ) >lo-hi [ sgn neg ] map ;
|
||||
|
||||
: mouse-absolute>relative ( lparam handle -- array )
|
||||
>r >lo-hi r>
|
||||
[ >lo-hi ] dip
|
||||
"RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
|
||||
get-RECT-top-left 2array v- ;
|
||||
|
||||
|
|
@ -297,7 +297,7 @@ SYMBOL: nc-buttons
|
|||
[ <button-down> ] [ <button-up> ] if ;
|
||||
|
||||
: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
|
||||
nip >r mouse-event>gesture r> >lo-hi rot window ;
|
||||
[ drop mouse-event>gesture ] dip >lo-hi rot window ;
|
||||
|
||||
: set-capture ( hwnd -- )
|
||||
mouse-captured get [
|
||||
|
|
@ -312,10 +312,10 @@ SYMBOL: nc-buttons
|
|||
mouse-captured off ;
|
||||
|
||||
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
|
||||
>r >r
|
||||
over set-capture
|
||||
dup message>button drop nc-buttons get delete
|
||||
r> r> prepare-mouse send-button-down ;
|
||||
[
|
||||
over set-capture
|
||||
dup message>button drop nc-buttons get delete
|
||||
] 2dip prepare-mouse send-button-down ;
|
||||
|
||||
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
|
||||
mouse-captured get [ release-capture ] when
|
||||
|
|
@ -337,9 +337,10 @@ SYMBOL: nc-buttons
|
|||
TrackMouseEvent drop
|
||||
>lo-hi swap window move-hand fire-motion ;
|
||||
|
||||
: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
|
||||
>r nip r>
|
||||
pick mouse-absolute>relative >r mouse-wheel r> rot window send-wheel ;
|
||||
:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
|
||||
lParam mouse-wheel
|
||||
hWnd mouse-absolute>relative
|
||||
hWnd window send-wheel ;
|
||||
|
||||
: handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
|
||||
#! message sent if windows needs application to stop dragging
|
||||
|
|
@ -456,10 +457,11 @@ M: windows-ui-backend do-events
|
|||
|
||||
: create-window ( rect -- hwnd )
|
||||
make-adjusted-RECT
|
||||
>r class-name-ptr get-global f r>
|
||||
>r >r >r ex-style r> r>
|
||||
[ class-name-ptr get-global f ] dip
|
||||
[
|
||||
[ ex-style ] 2dip
|
||||
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
|
||||
r> get-RECT-dimensions
|
||||
] dip get-RECT-dimensions
|
||||
f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
|
||||
|
||||
: show-window ( hWnd -- )
|
||||
|
|
@ -515,7 +517,7 @@ M: windows-ui-backend raise-window* ( world -- )
|
|||
M: windows-ui-backend set-title ( string world -- )
|
||||
handle>>
|
||||
dup title>> [ free ] when*
|
||||
>r utf16n malloc-string r>
|
||||
[ utf16n malloc-string ] dip
|
||||
2dup (>>title)
|
||||
hWnd>> WM_SETTEXT 0 roll alien-address SendMessage drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ M: world configure-event
|
|||
: key-down-event>gesture ( event world -- string gesture )
|
||||
dupd
|
||||
handle>> xic>> lookup-string
|
||||
>r swap event-modifiers r> key-code <key-down> ;
|
||||
[ swap event-modifiers ] dip key-code <key-down> ;
|
||||
|
||||
M: world key-down-event
|
||||
[ key-down-event>gesture ] keep
|
||||
|
|
@ -92,18 +92,18 @@ M: world key-down-event
|
|||
dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
|
||||
|
||||
M: world key-up-event
|
||||
>r key-up-event>gesture r> world-focus propagate-gesture ;
|
||||
[ key-up-event>gesture ] dip world-focus propagate-gesture ;
|
||||
|
||||
: mouse-event>gesture ( event -- modifiers button loc )
|
||||
dup event-modifiers over XButtonEvent-button
|
||||
rot mouse-event-loc ;
|
||||
|
||||
M: world button-down-event
|
||||
>r mouse-event>gesture >r <button-down> r> r>
|
||||
[ mouse-event>gesture [ <button-down> ] dip ] dip
|
||||
send-button-down ;
|
||||
|
||||
M: world button-up-event
|
||||
>r mouse-event>gesture >r <button-up> r> r>
|
||||
[ mouse-event>gesture [ <button-up> ] dip ] dip
|
||||
send-button-up ;
|
||||
|
||||
: mouse-event>scroll-direction ( event -- pair )
|
||||
|
|
@ -115,7 +115,7 @@ M: world button-up-event
|
|||
} at ;
|
||||
|
||||
M: world wheel-event
|
||||
>r dup mouse-event>scroll-direction swap mouse-event-loc r>
|
||||
[ dup mouse-event>scroll-direction swap mouse-event-loc ] dip
|
||||
send-wheel ;
|
||||
|
||||
M: world enter-event motion-event ;
|
||||
|
|
@ -123,7 +123,7 @@ M: world enter-event motion-event ;
|
|||
M: world leave-event 2drop forget-rollover ;
|
||||
|
||||
M: world motion-event
|
||||
>r dup XMotionEvent-x swap XMotionEvent-y 2array r>
|
||||
[ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip
|
||||
move-hand fire-motion ;
|
||||
|
||||
M: world focus-in-event
|
||||
|
|
@ -158,7 +158,7 @@ M: world selection-notify-event
|
|||
[ XSelectionRequestEvent-requestor ] keep
|
||||
[ XSelectionRequestEvent-property ] keep
|
||||
[ XSelectionRequestEvent-target ] keep
|
||||
>r 8 PropModeReplace r>
|
||||
[ 8 PropModeReplace ] dip
|
||||
[
|
||||
XSelectionRequestEvent-selection
|
||||
clipboard-for-atom contents>>
|
||||
|
|
@ -208,8 +208,7 @@ M: x-clipboard copy-clipboard
|
|||
(>>contents) ;
|
||||
|
||||
M: x-clipboard paste-clipboard
|
||||
>r find-world handle>> window>>
|
||||
r> atom>> convert-selection ;
|
||||
[ find-world handle>> window>> ] dip atom>> convert-selection ;
|
||||
|
||||
: init-clipboard ( -- )
|
||||
XA_PRIMARY <x-clipboard> selection set-global
|
||||
|
|
@ -219,14 +218,13 @@ M: x-clipboard paste-clipboard
|
|||
dup [ 127 <= ] all? [ XStoreName drop ] [ 3drop ] if ;
|
||||
|
||||
: set-title-new ( dpy window string -- )
|
||||
>r
|
||||
XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace
|
||||
r> utf8 encode dup length XChangeProperty drop ;
|
||||
[ XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace ] dip
|
||||
utf8 encode dup length XChangeProperty drop ;
|
||||
|
||||
M: x11-ui-backend set-title ( string world -- )
|
||||
handle>> window>> swap dpy get -rot
|
||||
3dup set-title-old set-title-new ;
|
||||
|
||||
|
||||
M: x11-ui-backend set-fullscreen* ( ? world -- )
|
||||
handle>> window>> "XClientMessageEvent" <c-object>
|
||||
tuck set-XClientMessageEvent-window
|
||||
|
|
@ -237,8 +235,7 @@ M: x11-ui-backend set-fullscreen* ( ? world -- )
|
|||
"_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
|
||||
32 over set-XClientMessageEvent-format
|
||||
"_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
|
||||
>r dpy get root get 0 SubstructureNotifyMask r> XSendEvent drop ;
|
||||
|
||||
[ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
|
||||
|
||||
M: x11-ui-backend (open-window) ( world -- )
|
||||
dup gadget-window
|
||||
|
|
|
|||
Loading…
Reference in New Issue