Bla

examples/toolkit.lisp

@@ -29,7 +29,8 @@
     `(progn (defun ,name (,@(rest args))
               (flet ((,thunk (,(first args))
                        ,@body))
-                (unless *screen*
-                  (setf *screen* (make-instance 'screen)))
-                (,thunk *screen*)))
+                (if (boundp '*screen*)
+                    (,thunk *screen*)
+                    (framebuffers:with-screen (*screen* 'screen)
+                      (thunk *screen*)))))
             (pushnew ',name *examples*))))

renderers/framebuffers/package.lisp

@@ -14,6 +14,7 @@
    #:cursor
    #:monitor
    #:screen
-   #:window))
+   #:window
+   #:with-screen))
 
 (push :alloy-framebuffers *features*)

renderers/framebuffers/windowing.lisp

@@ -25,14 +25,23 @@
 (defmethod (setf alloy:cursor) (value (screen screen))
   value)
 
-(defmethod make-window ((screen screen) &rest args &key &allow-other-keys)
+(defmethod window:make-window ((screen screen) &rest args &key &allow-other-keys)
   (apply #'make-instance 'window :screen screen args))
 
 (defmethod process-events ((screen screen) &key timeout)
   (fb:process-events (windows screen) :timeout timeout)
   (setf (windows screen) (remove-if #'fb:close-requested-p (windows screen)))
   screen)
 
+(defmacro with-screen ((screen &optional (type ''screen) &rest initargs) &body body)
+  (let ((thunk (gensym "THUNK")))
+    `(let ((,screen (make-instance ,type ,@initargs)))
+       (locally ,@body)
+       (loop while (windows ,screen)
+             do (dolist (window (windows ,screen))
+                  (alloy:maybe-render ,screen window))
+                (process-events ,screen :timeout T)))))
+
 (defclass cursor (window:cursor)
   ((native :initarg :native :accessor native)
    (icon :initform :default :accessor icon :reader window:icon)))
@@ -46,7 +55,8 @@
           (symbol icon)))
   (setf (icon cursor) icon))
 
-(defclass window (alloy:ui fb:event-handler
+(defclass window (window:window
+                  fb:event-handler
                   org.shirakumo.alloy.renderers.simple.presentations::default-look-and-feel)
   ((native :accessor native)
    (screen :initarg :screen :reader window:screen)
@@ -55,6 +65,7 @@
    (cursor :reader window:cursor)))
 
 (defmethod initialize-instance :after ((window window) &key)
+  #++
   (setf (slot-value window 'cursor) (make-instance 'cursor :window native)))
 
 (defmethod alloy:render ((screen screen) (window window))