Expose graphics-context and destroy canvas in the context it was created

borodust · Sep 21, 2021 · 3b26935 · 3b26935
1 parent 337840c
commit 3b26935
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 5 deletions.
diff --git a/canvas/canvas.lisp b/canvas/canvas.lisp
@@ -11,19 +11,21 @@
 
 
 (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))))
 
 
 (define-system-function make-canvas graphics-system
     (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
@@ -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
@@ -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))