put a slot on worlds for window-resources which get disposed when window is closed
							parent
							
								
									d077d52968
								
							
						
					
					
						commit
						77104b7256
					
				| 
						 | 
				
			
			@ -27,10 +27,6 @@ GENERIC: flush-gl-context ( handle -- )
 | 
			
		|||
 | 
			
		||||
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: (grab-input) ui-backend ( handle -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
USING: ui.gadgets ui.render ui.text ui.text.private
 | 
			
		||||
ui.gestures ui.backend help.markup help.syntax
 | 
			
		||||
models opengl sequences strings ;
 | 
			
		||||
models opengl sequences strings destructors ;
 | 
			
		||||
IN: ui.gadgets.worlds
 | 
			
		||||
 | 
			
		||||
HELP: user-input
 | 
			
		||||
| 
						 | 
				
			
			@ -29,10 +29,17 @@ HELP: set-title
 | 
			
		|||
{ $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" } "." } ;
 | 
			
		||||
 | 
			
		||||
HELP: select-gl-context
 | 
			
		||||
{ $values { "handle" "a backend-specific handle" } }
 | 
			
		||||
HELP: context-world
 | 
			
		||||
{ $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 } "." } ;
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
{ $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 } "." } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -34,7 +34,8 @@ TUPLE: world < track
 | 
			
		|||
    text-handle handle images
 | 
			
		||||
    window-loc
 | 
			
		||||
    pixel-format-attributes
 | 
			
		||||
    window-controls ;
 | 
			
		||||
    window-controls
 | 
			
		||||
    window-resources ;
 | 
			
		||||
 | 
			
		||||
TUPLE: world-attributes
 | 
			
		||||
    { world-class initial: world }
 | 
			
		||||
| 
						 | 
				
			
			@ -77,11 +78,24 @@ TUPLE: world-attributes
 | 
			
		|||
        '[ f _ [ (>>status-owner) ] [ status>> set-model ] 2bi ] when
 | 
			
		||||
    ] [ 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 ;
 | 
			
		||||
 | 
			
		||||
: find-gl-context ( gadget -- )
 | 
			
		||||
    find-world dup
 | 
			
		||||
    [ handle>> select-gl-context ] [ no-world-found ] if ;
 | 
			
		||||
    [ handle>> set-gl-context ] [ no-world-found ] if ;
 | 
			
		||||
 | 
			
		||||
: (request-focus) ( child world ? -- )
 | 
			
		||||
    pick parent>> pick eq? [
 | 
			
		||||
| 
						 | 
				
			
			@ -98,7 +112,8 @@ M: world request-focus-on ( child gadget -- )
 | 
			
		|||
        t >>root?
 | 
			
		||||
        f >>active?
 | 
			
		||||
        { 0 0 } >>window-loc
 | 
			
		||||
        f >>grab-input? ;
 | 
			
		||||
        f >>grab-input?
 | 
			
		||||
        V{ } clone >>window-resources ;
 | 
			
		||||
 | 
			
		||||
: apply-world-attributes ( world attributes -- world )
 | 
			
		||||
    {
 | 
			
		||||
| 
						 | 
				
			
			@ -149,7 +164,7 @@ M: world (>>dim)
 | 
			
		|||
    [ call-next-method ]
 | 
			
		||||
    [
 | 
			
		||||
        dup handle>>
 | 
			
		||||
        [ select-gl-context resize-world ]
 | 
			
		||||
        [ set-gl-context resize-world ]
 | 
			
		||||
        [ drop ] if*
 | 
			
		||||
    ] bi ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -61,7 +61,7 @@ SYMBOL: windows
 | 
			
		|||
 | 
			
		||||
: set-up-window ( world -- )
 | 
			
		||||
    {
 | 
			
		||||
        [ handle>> select-gl-context ]
 | 
			
		||||
        [ handle>> set-gl-context ]
 | 
			
		||||
        [ [ title>> ] keep set-title ]
 | 
			
		||||
        [ begin-world ]
 | 
			
		||||
        [ resize-world ]
 | 
			
		||||
| 
						 | 
				
			
			@ -89,12 +89,13 @@ M: world graft*
 | 
			
		|||
 | 
			
		||||
: (ungraft-world) ( world -- )
 | 
			
		||||
    {
 | 
			
		||||
        [ handle>> select-gl-context ]
 | 
			
		||||
        [ handle>> set-gl-context ]
 | 
			
		||||
        [ text-handle>> [ dispose ] when* ]
 | 
			
		||||
        [ images>> [ dispose ] when* ]
 | 
			
		||||
        [ hand-clicked close-global ]
 | 
			
		||||
        [ hand-gadget close-global ]
 | 
			
		||||
        [ end-world ]
 | 
			
		||||
        [ [ [ [ dispose ] when* ] each V{ } clone ] change-window-resources ]
 | 
			
		||||
    } cleave ;
 | 
			
		||||
 | 
			
		||||
M: world ungraft*
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue