add with-display-render-target macro

lem-project · Nov 28, 2023 · 4039486 · 4039486
1 parent 931f3a2
commit 4039486
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 4 deletions.
diff --git a/frontends/sdl2/display.lisp b/frontends/sdl2/display.lisp
@@ -36,7 +36,8 @@
            :display-height
            :adapt-high-dpi-font-size
            :change-font
-           :with-renderer))
+           :with-renderer
+           :with-display-render-target))
 (in-package :lem-sdl2/display)
 
 (defvar *display*)
@@ -113,6 +114,15 @@
 (defmacro with-renderer ((display) &body body)
   `(call-with-renderer ,display (lambda () ,@body)))
 
+(defun call-with-display-render-target (display texture function)
+  (let ((previous (sdl2::sdl-get-render-target (display-renderer display))))
+    (sdl2:set-render-target (display-renderer display) texture)
+    (unwind-protect (funcall function)
+      (sdl2:set-render-target (display-renderer display) previous))))
+
+(defmacro with-display-render-target ((display texture) &body body)
+  `(call-with-display-render-target ,display ,texture (lambda () ,@body)))
+
 (defmethod clear ((display display))
   (sdl2:set-render-target (display-renderer display) (display-texture display))
   (set-render-color display (display-background-color display))

diff --git a/frontends/sdl2/view.lisp b/frontends/sdl2/view.lisp
@@ -84,9 +84,9 @@
     (setf (view-texture view) nil)))
 
 (defmethod render-clear ((view view) display)
-  (sdl2:set-render-target (display:display-renderer display) (view-texture view))
-  (display:set-render-color display (display:display-background-color display))
-  (sdl2:render-clear (display:display-renderer display)))
+  (display::with-display-render-target (display (view-texture view))
+    (display:set-render-color display (display:display-background-color display))
+    (sdl2:render-clear (display:display-renderer display))))
 
 (defmethod resize ((view view) display width height)
   (when (view-use-modeline view) (incf height))