Minor

async.lisp

@@ -29,25 +29,28 @@
    (make-instance 'promise-task :promise (promise:make) :func function)
    main))
 
-(defclass task-runner-main (main)
+(defclass task-runner ()
   ((task-thread :initform (make-instance 'task-thread) :accessor task-thread)))
 
-(defmethod initialize-instance ((main task-runner-main) &key)
+(defmethod initialize-instance ((runner task-runner) &key)
   (call-next-method)
-  (start (task-thread main)))
+  (start (task-thread runner)))
 
-(defmethod finalize :after ((main task-runner-main))
-  (stop (task-thread main)))
+(defmethod finalize :after ((runner task-runner))
+  (stop (task-thread runner)))
+
+(defmethod simple-tasks:schedule-task (task (runner task-runner))
+  (simple-tasks:schedule-task task (task-thread runner)))
+
+(defclass task-runner-main (task-runner main)
+  ())
 
 (defmethod update :before ((main task-runner-main) tt dt fc)
   (promise:tick-all dt))
 
 (defmethod simple-tasks:schedule-task (task (default (eql T)))
   (simple-tasks:schedule-task task +main+))
 
-(defmethod simple-tasks:schedule-task (task (main task-runner-main))
-  (simple-tasks:schedule-task task (task-thread +main+)))
-
 (defclass promise-task (simple-tasks:task)
   ((promise :initarg :promise :accessor promise :reader promise:ensure-promise)
    (func :initarg :func :accessor func)))

context.lisp

@@ -73,6 +73,7 @@
   (height 0 :type (unsigned-byte 16))
   (data #() :type (simple-array (unsigned-byte 8))))
 
+(defgeneric create-child-context (context))
 (defgeneric create-context (context))
 (defgeneric destroy-context (context))
 (defgeneric valid-p (context))
@@ -115,6 +116,15 @@
   (destroy-context context)
   (call-next-method))
 
+(defmethod create-child-context ((context context))
+  (let ((restore (current-p context))
+        (child (make-instance 'context :share-with context)))
+    (create-context child)
+    (when restore
+      (done-current child)
+      (make-current context))
+    child))
+
 (defmethod destroy-context :around ((context context))
   (when (valid-p context)
     (with-context (context :force T)

package.lisp

@@ -802,6 +802,7 @@
    #:rgba-icon-width
    #:rgba-icon-height
    #:rgba-icon-data
+   #:create-child-context
    #:create-context
    #:destroy-context
    #:valid-p