Common Lisp libimpeller openGL example

example-gl.lisp

;; https://github.com/borodust/aw-sdl3
;; https://github.com/borodust/aw-impeller/
;; sbcl --eval "(asdf:load-system :aw-impeller/example-gl)" --eval "(impeller.example-gl:run)" --quit

(cl:defpackage :impeller.example-gl
  (:use :cl)
  (:export #:run))
(cl:in-package :impeller.example-gl)

;;
;; Inspired by Impeller's GL example:
;;   https://github.com/flutter/flutter/blob/main/engine/src/flutter/impeller/toolkit/interop/example_gl.c
;;

(cffi:define-foreign-library
    (impeller
     :search-path (asdf:system-relative-pathname :aw-impeller "src/lib/"))
  (:unix "libimpeller.so"))


(cffi:define-foreign-library
    (sdl3-clawed
     :search-path (asdf:system-relative-pathname :aw-impeller "src/lib/"))
  (:unix "libsdl3.clawed.so"))


(defun impeller-draw-gl (surface)
  "Draw white background and red box to OpenGL framebuffer surface."
  (cffi-c-ref:c-with ((clear-color (:struct %impeller:color))
                      (box-color (:struct %impeller:color))
                      (box-rect (:struct %impeller:rect)))
    (setf (clear-color :red) 1f0
          (clear-color :green) 1f0
          (clear-color :blue) 1f0
          (clear-color :alpha) 1f0

          (box-color :red) 1f0
          (box-color :green) 0f0
          (box-color :blue) 0f0
          (box-color :alpha) 1f0

          (box-rect :x) 10f0
          (box-rect :y) 10f0
          (box-rect :width) 100f0
          (box-rect :height) 100f0)
    (let* ((dl-builder (%impeller:display-list-builder-new (cffi:null-pointer)))
           (paint (%impeller:paint-new)))
      (unwind-protect
           (progn
             (%impeller:paint-set-color paint (clear-color &))
             (%impeller:display-list-builder-draw-paint dl-builder paint)

             (%impeller:paint-set-color paint (box-color &))
             (%impeller:display-list-builder-draw-rect dl-builder (box-rect &) paint)

             (let ((dl (%impeller:display-list-builder-create-display-list-new
                        dl-builder)))
               (when (cffi:null-pointer-p dl)
                 (error "Failed to create Impeller display list"))
               (unwind-protect
                    (%impeller:surface-draw-display-list surface dl)
                 (%impeller:display-list-release dl))))
        (%impeller:paint-release paint)
        (%impeller:display-list-builder-release dl-builder)))))


(cffi:defcallback gl-proc-address-getter :pointer
    ((proc-name :string)
     (user-data :pointer))
  "Retrieve GL function address from SDL3."
  (declare (ignore user-data))
  (%sdl3:gl-get-proc-address proc-name))


(defun impeller-run-gl (framebuffer-width framebuffer-height)
  "Initialize OpenGL context and render loop."
  (cffi-c-ref:c-with ((fb-size (:struct %impeller:i-size)))
    (setf (fb-size :width) framebuffer-width
          (fb-size :height) framebuffer-height)
    (let ((ctx (%impeller:context-create-open-gles-new
                 %impeller:+version+
                 (cffi:callback gl-proc-address-getter)
                 (cffi:null-pointer))))
      (when (cffi:null-pointer-p ctx)
        (error "Failed to create Impeller OpenGL context"))
      (unwind-protect
           (let ((surface (%impeller:surface-create-wrapped-fbo-new
                           ctx 0 0 (fb-size &))))
             (when (cffi:null-pointer-p surface)
               (error "Failed to create wrapped framebuffer surface"))
             (unwind-protect
                  (impeller-draw-gl surface)
               (%impeller:surface-release surface)))
        (%impeller:context-release ctx)))))


(defun main-run-gl ()
  "Setup window, initialize OpenGL, and render."
  (%sdl3:init %sdl3:+init-video+)
  (let ((window (cffi:with-foreign-string (name "AW-IMPELLER/AW-SDL3 Example (OpenGL)")
                  (%sdl3:create-window name 800 600
                                       %sdl3:+window-opengl+))))
    (when (cffi:null-pointer-p window)
      (error "Failed to create a window"))
    (unwind-protect
         (progn
           (let ((gl-ctx (%sdl3:gl-create-context window)))
             (when (cffi:null-pointer-p gl-ctx)
               (error "Failed to create OpenGL context"))
             (unwind-protect
                  (progn
                    (%sdl3:gl-make-current window gl-ctx)
                    (cffi:with-foreign-objects ((w :int)
                                                (h :int))
                      (%sdl3:get-window-size-in-pixels window w h)
                      (let ((width (cffi:mem-ref w :int))
                            (height (cffi:mem-ref h :int)))
                        (impeller-run-gl width height)
                        (%sdl3:gl-swap-window window)))
                    (sleep 5))
               (%sdl3:gl-destroy-context gl-ctx))))
      (%sdl3:destroy-window window)
      (%sdl3:quit))))


(defun run ()
  "Load libraries, run example, and cleanup."
  (unwind-protect
       (let ((errout *error-output*))
         (cffi:load-foreign-library 'impeller)
         (cffi:load-foreign-library 'sdl3-clawed)
         (flet ((%runner ()
                  (handler-case
                      (main-run-gl)
                    (serious-condition (c)
                      (format errout "~A" c)))))
           (trivial-main-thread:call-in-main-thread #'%runner :blocking t)))
    (cffi:close-foreign-library 'impeller)
    (cffi:close-foreign-library 'sdl3-clawed)))