From 77104b7256267f4a6469aca04b19a8326ed03841 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 1 Jul 2009 13:54:42 -0500
Subject: [PATCH] put a slot on worlds for window-resources which get disposed
 when window is closed

---
 basis/ui/backend/backend.factor            |  4 ----
 basis/ui/gadgets/worlds/worlds-docs.factor | 13 +++++++++---
 basis/ui/gadgets/worlds/worlds.factor      | 23 ++++++++++++++++++----
 basis/ui/ui.factor                         |  5 +++--
 4 files changed, 32 insertions(+), 13 deletions(-)

diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor
index 3d38439f69..62636fdcdf 100755
--- a/basis/ui/backend/backend.factor
+++ b/basis/ui/backend/backend.factor
@@ -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 -- )
diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor
index d0fd169871..ddaad93b1b 100755
--- a/basis/ui/gadgets/worlds/worlds-docs.factor
+++ b/basis/ui/gadgets/worlds/worlds-docs.factor
@@ -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 } "." } ;
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 82f3637b83..1766abba97 100755
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -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 ;
 
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index db05465986..9d1c40377f 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -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*