put a slot on worlds for window-resources which get disposed when window is closed

db4
Joe Groff 2009-07-01 13:54:42 -05:00
parent d077d52968
commit 77104b7256
4 changed files with 32 additions and 13 deletions

View File

@ -27,10 +27,6 @@ GENERIC: flush-gl-context ( handle -- )
HOOK: offscreen-pixels ui-backend ( world -- alien w h ) HOOK: offscreen-pixels ui-backend ( world -- alien w h )
: with-gl-context ( handle quot -- )
'[ select-gl-context @ ]
[ flush-gl-context gl-error ] bi ; inline
HOOK: (with-ui) ui-backend ( quot -- ) HOOK: (with-ui) ui-backend ( quot -- )
HOOK: (grab-input) ui-backend ( handle -- ) HOOK: (grab-input) ui-backend ( handle -- )

View File

@ -1,6 +1,6 @@
USING: ui.gadgets ui.render ui.text ui.text.private USING: ui.gadgets ui.render ui.text ui.text.private
ui.gestures ui.backend help.markup help.syntax ui.gestures ui.backend help.markup help.syntax
models opengl sequences strings ; models opengl sequences strings destructors ;
IN: ui.gadgets.worlds IN: ui.gadgets.worlds
HELP: user-input HELP: user-input
@ -29,10 +29,17 @@ HELP: set-title
{ $description "Sets the title bar of the native window containing the world." } { $description "Sets the title bar of the native window containing the world." }
{ $notes "This word should not be called directly by user code. Instead, change the " { $snippet "title" } " slot model; see " { $link "models" } "." } ; { $notes "This word should not be called directly by user code. Instead, change the " { $snippet "title" } " slot model; see " { $link "models" } "." } ;
HELP: select-gl-context HELP: context-world
{ $values { "handle" "a backend-specific handle" } } { $var-description "Holds the " { $link world } " whose OpenGL context was most recently made active by " { $link set-gl-context } "." } ;
HELP: set-gl-context
{ $values { "world" world } }
{ $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ; { $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ;
HELP: window-resource
{ $values { "resource" disposable } { "resource" disposable } }
{ $description "Marks " { $snippet "resource" } " to be destroyed with " { $link dispose } " when the window with the currently active OpenGL context (set by " { $link set-gl-context } ") is closed. " { $snippet "resource" } " is left unmodified at the top of the stack." } ;
HELP: flush-gl-context HELP: flush-gl-context
{ $values { "handle" "a backend-specific handle" } } { $values { "handle" "a backend-specific handle" } }
{ $description "Ensures all GL rendering calls made to an OpenGL context finish rendering to the screen. This word is called automatically by the UI after drawing a " { $link world } "." } ; { $description "Ensures all GL rendering calls made to an OpenGL context finish rendering to the screen. This word is called automatically by the UI after drawing a " { $link world } "." } ;

View File

@ -34,7 +34,8 @@ TUPLE: world < track
text-handle handle images text-handle handle images
window-loc window-loc
pixel-format-attributes pixel-format-attributes
window-controls ; window-controls
window-resources ;
TUPLE: world-attributes TUPLE: world-attributes
{ world-class initial: world } { world-class initial: world }
@ -77,11 +78,24 @@ TUPLE: world-attributes
'[ f _ [ (>>status-owner) ] [ status>> set-model ] 2bi ] when '[ f _ [ (>>status-owner) ] [ status>> set-model ] 2bi ] when
] [ 2drop ] if ; ] [ 2drop ] if ;
SYMBOL: context-world
: window-resource ( resource -- resource )
dup context-world get-global window-resources>> push ;
: set-gl-context ( world -- )
[ context-world set-global ]
[ handle>> select-gl-context ] bi ;
: with-gl-context ( world quot -- )
'[ set-gl-context @ ]
[ flush-gl-context gl-error ] bi ; inline
ERROR: no-world-found ; ERROR: no-world-found ;
: find-gl-context ( gadget -- ) : find-gl-context ( gadget -- )
find-world dup find-world dup
[ handle>> select-gl-context ] [ no-world-found ] if ; [ handle>> set-gl-context ] [ no-world-found ] if ;
: (request-focus) ( child world ? -- ) : (request-focus) ( child world ? -- )
pick parent>> pick eq? [ pick parent>> pick eq? [
@ -98,7 +112,8 @@ M: world request-focus-on ( child gadget -- )
t >>root? t >>root?
f >>active? f >>active?
{ 0 0 } >>window-loc { 0 0 } >>window-loc
f >>grab-input? ; f >>grab-input?
V{ } clone >>window-resources ;
: apply-world-attributes ( world attributes -- world ) : apply-world-attributes ( world attributes -- world )
{ {
@ -149,7 +164,7 @@ M: world (>>dim)
[ call-next-method ] [ call-next-method ]
[ [
dup handle>> dup handle>>
[ select-gl-context resize-world ] [ set-gl-context resize-world ]
[ drop ] if* [ drop ] if*
] bi ; ] bi ;

View File

@ -61,7 +61,7 @@ SYMBOL: windows
: set-up-window ( world -- ) : set-up-window ( world -- )
{ {
[ handle>> select-gl-context ] [ handle>> set-gl-context ]
[ [ title>> ] keep set-title ] [ [ title>> ] keep set-title ]
[ begin-world ] [ begin-world ]
[ resize-world ] [ resize-world ]
@ -89,12 +89,13 @@ M: world graft*
: (ungraft-world) ( world -- ) : (ungraft-world) ( world -- )
{ {
[ handle>> select-gl-context ] [ handle>> set-gl-context ]
[ text-handle>> [ dispose ] when* ] [ text-handle>> [ dispose ] when* ]
[ images>> [ dispose ] when* ] [ images>> [ dispose ] when* ]
[ hand-clicked close-global ] [ hand-clicked close-global ]
[ hand-gadget close-global ] [ hand-gadget close-global ]
[ end-world ] [ end-world ]
[ [ [ [ dispose ] when* ] each V{ } clone ] change-window-resources ]
} cleave ; } cleave ;
M: world ungraft* M: world ungraft*