parser sequences sets strings threads ui.backend ui.gadgets
ui.gadgets.private ui.gadgets.worlds ui.gestures vocabs.parser
words ;
+FROM: namespaces => change-global ;
IN: ui
<PRIVATE
: window ( handle -- world ) windows get-global at ;
-: window-focus ( handle -- gadget ) window world-focus ;
-
: register-window ( world handle -- )
#! Add the new window just below the topmost window. Why?
#! So that if the new window doesn't actually receive focus
[ [ length 1 - dup 1 - ] keep exchange ] [ drop ] if ;
: unregister-window ( handle -- )
- windows [ [ first = not ] with filter ] change-global ;
+ windows [ [ first = ] with reject ] change-global ;
: raised-window ( world -- )
windows get-global
[ [ clean-up-broken-window ] [ ui-error ] bi* ] recover
] bi ;
+: dispose-window-resources ( world -- )
+ [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ;
+
M: world ungraft*
{
[ set-gl-context ]
[ hand-clicked close-global ]
[ hand-gadget close-global ]
[ end-world ]
- [ [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ]
- [ [ (close-window) f ] change-handle drop ]
+ [ dispose-window-resources ]
[ unfocus-world ]
+ [ [ (close-window) f ] change-handle drop ]
[ promise>> t swap fulfill ]
} cleave ;
dup hand-world get-global eq?
[ hand-loc get-global swap move-hand ] [ drop ] if ;
-: layout-queued ( -- seq )
+: (layout-queued) ( deque -- seq )
[
in-layout? on
- layout-queue [
+ [
dup layout find-world [ , ] when*
] slurp-deque
- ] { } make members ;
+ ] { } make members ; inline
+
+: layout-queued ( -- seq )
+ layout-queue dup deque-empty?
+ [ drop { } ] [ (layout-queued) ] if ;
: redraw-worlds ( seq -- )
[ dup update-hand draw-world ] each ;
PRIVATE>
-: find-window ( quot -- world )
- [ windows get values ] dip
+: find-window ( quot: ( world -- ? ) -- world )
+ [ windows get-global values ] dip
'[ dup children>> [ ] [ nip first ] if-empty @ ]
find-last nip ; inline
call( -- ) notify-ui-thread start-ui-thread ;
: ?attributes ( gadget title/attributes -- attributes )
- dup string? [ world-attributes new swap >>title ] [ clone ] if
+ dup string? [ <world-attributes> swap >>title ] [ clone ] if
swap [ [ [ 1array ] [ f ] if* ] curry unless* ] curry change-gadgets ;
PRIVATE>
find-world raise-window* ;
: topmost-window ( -- world )
- windows get last second ;
+ windows get-global last second ;
HOOK: close-window ui-backend ( gadget -- )
<flag> ui-notify-flag set-global
] "ui" add-startup-hook
+HOOK: resize-window ui-backend ( world dim -- )
+M: object resize-window 2drop ;
+
+: relayout-window ( gadget -- )
+ [ relayout ]
+ [ find-world [ dup pref-dim resize-window ] when* ] bi ;
+
: with-ui ( quot: ( -- ) -- )
ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;
: define-main-window ( word attributes quot -- )
[
- '[ [ f _ clone @ open-window ] with-ui ] (( -- )) define-declared
+ '[ [ f _ clone @ open-window ] with-ui ] ( -- ) define-declared
] [ 2drop current-vocab main<< ] 3bi ;
SYNTAX: MAIN-WINDOW:
- CREATE
+ scan-new-word
world-attributes parse-main-window-attributes
parse-definition
define-main-window ;