From 3b26935fb786808a87fd8bb4b7dc1bf8a8a4d6a6 Mon Sep 17 00:00:00 2001
From: Pavel Korolev <dev@borodust.org>
Date: Wed, 22 Sep 2021 00:47:21 +0300
Subject: [PATCH] Expose graphics-context and destroy canvas in the context it
 was created

---
 canvas/canvas.lisp     | 10 ++++++----
 graphics/packages.lisp |  1 +
 graphics/system.lisp   |  9 ++++++++-
 3 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/canvas/canvas.lisp b/canvas/canvas.lisp
index 175f6f7..c546bbe 100644
--- a/canvas/canvas.lisp
+++ b/canvas/canvas.lisp
@@ -11,11 +11,12 @@
 
 
 (defclass canvas (disposable)
-  ((handle :initarg :handle :reader %handle-of)))
+  ((handle :initarg :handle :reader %handle-of)
+   (gx-ctx :initarg :context)))
 
 
-(define-destructor canvas (handle)
-  (run (for-graphics :disposing t ()
+(define-destructor canvas (handle gx-ctx)
+  (run (for-graphics :disposing t :context gx-ctx()
          (bodge-canvas:destroy-canvas handle))))
 
 
@@ -23,7 +24,8 @@
     (canvas-class width height &key (pixel-ratio 1.0) (antialiased t))
   (make-instance canvas-class
                  :handle (bodge-canvas:make-canvas width height :pixel-ratio pixel-ratio
-                                                                :antialiased antialiased)))
+                                                                :antialiased antialiased)
+                 :context (graphics-context)))
 
 (defun render-canvas (canvas renderer)
   (let ((*canvas* canvas))
diff --git a/graphics/packages.lisp b/graphics/packages.lisp
index 5ac9857..48abce7 100644
--- a/graphics/packages.lisp
+++ b/graphics/packages.lisp
@@ -14,6 +14,7 @@
                 #:image->foreign-array)
   (:export graphics-system
            graphics
+           graphics-context
            graphics-context-assembly-flow
            for-graphics
            reset-viewport
diff --git a/graphics/system.lisp b/graphics/system.lisp
index 0c9290e..e7910f0 100644
--- a/graphics/system.lisp
+++ b/graphics/system.lisp
@@ -62,7 +62,10 @@
 (defmethod dispatch ((this graphics-system) (task function) invariant &rest args
                      &key context disposing)
   (with-slots (main-context) this
-    (let ((context (if context context main-context)))
+    (let ((context (if (or (eq context nil)
+                           (eq context t))
+                       main-context
+                       context)))
       (if disposing
           (apply #'execute-with-context context task :important-p t
                                                      :priority :highest
@@ -95,6 +98,10 @@
   (%framebuffer-height-of *graphics-context*))
 
 
+(define-system-function graphics-context graphics-system ()
+  *graphics-context*)
+
+
 (definline graphics ()
   (engine-system 'graphics-system))