Prepare for multiple render backends

alloy/renderer.lisp

@@ -119,7 +119,7 @@
        (%gl:uniform-1f loc value)))))
 
 (defmethod opengl:bind ((shader trial:shader-program))
-  (gl:use-program (trial:gl-name shader)))
+  (trial:activate shader))
 
 (defmethod alloy:allocate ((shader trial:shader))
   (trial:allocate shader))
@@ -165,10 +165,8 @@
                  :vertex-form NIL))
 
 (defmethod opengl:draw-vertex-array ((array trial:vertex-array) primitive-type offset count)
-  (gl:bind-vertex-array (trial:gl-name array))
-  (if (trial:indexed-p array)
-      (%gl:draw-elements primitive-type count (trial:element-type (trial:indexed-p array)) offset)
-      (%gl:draw-arrays primitive-type offset count)))
+  (setf (trial:size array) count)
+  (trial:render array offset))
 
 (defclass framebuffer (trial:framebuffer)
   ((target :initform NIL :accessor target)))
@@ -196,15 +194,10 @@
 
 (defmethod opengl:bind ((framebuffer trial:framebuffer))
   (setf (target framebuffer) (gl:get-integer :draw-framebuffer-binding))
-  (gl:bind-framebuffer :draw-framebuffer (gl-resource-name framebuffer))
-  (gl:clear :color-buffer :depth-buffer :stencil-buffer))
+  (trial:activate framebuffer))
 
 (defmethod opengl:blit-framebuffer ((framebuffer trial:framebuffer))
-  (gl:bind-framebuffer :read-framebuffer (trial:gl-name framebuffer))
-  (gl:bind-framebuffer :draw-framebuffer (target framebuffer))
-  (let ((w (trial:width framebuffer))
-        (h (trial:height framebuffer)))
-    (%gl:blit-framebuffer 0 0 w h 0 0 w h '(:color-buffer :depth-buffer :stencil-buffer) :nearest)))
+  (trial:render framebuffer (target framebuffer)))
 
 (defclass image (trial:texture simple:image)
   ())
@@ -266,8 +259,7 @@
   (trial:deallocate texture))
 
 (defmethod opengl:bind ((texture trial:texture))
-  (gl:active-texture :texture0)
-  (gl:bind-texture :texture-2D (trial:gl-name texture)))
+  (trial:bind texture NIL))
 
 (defmethod simple:size ((image trial:image))
   (alloy:size (trial:width image) (trial:height image)))

alloy/ui.lisp

@@ -131,10 +131,8 @@
   (trial:stage (trial:framebuffer pass) area))
 
 (defmethod trial:render :around ((pass ui-pass) target)
-  (trial:with-pushed-features
-    (trial:enable-feature :depth-test)
-    (gl:clear-color 0 0 0 0)
-    (call-next-method)))
+  (setf (clear-color *context*) 0)
+  (call-next-method))
 
 ;; KLUDGE: No idea why this is necessary, fuck me.
 (defmethod simple:request-font :around ((pass ui-pass) font &key)

assets/environment-map.lisp

@@ -57,7 +57,7 @@
       ;; then we let GL bake the mips for the envmap.
       (setf (min-filter envmap) :linear)
       (render envmap-renderer envmap)
-      (gl:bind-texture (target envmap) (gl-name envmap))
+      (bind envmap NIL)
       (setf (min-filter envmap) :linear-mipmap-linear)
       ;; Now map the irradiance and prefiltered maps as usual.
       (render irrmap-renderer irrmap)

assets/shader-image.lisp

@@ -18,15 +18,13 @@
   (render (// 'trial 'fullscreen-square) program))
 
 (defmethod render ((renderer image-renderer) (texture texture))
-  (let ((fbo (gl:gen-framebuffer)))
-    (gl:bind-framebuffer :framebuffer fbo)
+  (let ((framebuffer (make-instance 'framebuffer :data-pointer (gl:gen-framebuffer))))
     (unwind-protect
          (progn
-           (gl:viewport 0 0 (width texture) (height texture))
-           (%gl:framebuffer-texture :framebuffer :color-attachment0 (gl-name texture) 0)
+           (bind texture framebuffer)
+           (activate framebuffer)
            (render renderer NIL))
-      (gl:bind-framebuffer :framebuffer 0)
-      (gl:delete-framebuffers (list fbo)))))
+      (deallocate framebuffer))))
 
 (define-class-shader (image-renderer :vertex-shader)
   "

context.lisp

@@ -46,15 +46,11 @@
    (wait-lock :initform (bt:make-lock "Context wait lock") :reader context-wait-lock)
    (handler :initarg :handler :accessor handler)
    (shared-with :initarg :share-with :reader shared-with)
-   (glsl-target-version :initarg :glsl-version :initform NIL :accessor glsl-target-version)
    (binding-point-allocator :initform (make-array 256 :element-type 'bit) :accessor binding-point-allocator))
   (:default-initargs
    :title "Trial"
    :width 1280
    :height 720
-   :glsl-version NIL
-   :version '(3 3)
-   :profile :core
    :double-buffering T
    :stereo-buffer NIL
    :vsync :off
@@ -134,8 +130,7 @@
     (call-next-method)
     (v:info :trial.context "Recreated context successfully.")
     (make-current context)
-    (context-note-debug-info context)
-    (cache-gl-extensions)))
+    (context-note-debug-info context)))
 
 (defmethod current-p ((context context) &optional (thread (bt:current-thread)))
   (eql thread (current-thread context)))
@@ -208,64 +203,12 @@
 (defmethod describe-object :after ((context context) stream)
   (context-info context stream))
 
-(defun context-info (context &key (stream *standard-output*) (show-extensions T))
-  (format stream "~&~%Running GL~a.~a ~a~%~
-                    Sample buffers:     ~a (~a sample~:p)~%~
-                    Max texture size:   ~a~%~
-                    Max texture units:  ~a ~a ~a ~a ~a ~a~%~
-               ~@[~{Max compute groups: ~a ~a ~a~%~
-                    Max work groups:    ~a ~a ~a (~a)~%~}~]~
-                    GL Vendor:          ~a~%~
-                    GL Renderer:        ~a~%~
-                    GL Version:         ~a~%~
-                    GL Shader Language: ~a~%~
-                    ~@[GL Extensions:      ~{~a~^ ~}~%~]"
-          (gl-property :major-version)
-          (gl-property :minor-version)
-          (profile context)
-          (gl-property :sample-buffers)
-          (gl-property :samples)
-          (gl-property :max-texture-size)
-          (gl-property :max-vertex-texture-image-units)
-          ;; Fuck you, GL, and your stupid legacy crap.
-          (gl-property :max-texture-image-units)
-          (gl-property :max-tess-control-texture-image-units)
-          (gl-property :max-tess-evaluation-texture-image-units)
-          (gl-property :max-geometry-texture-image-units)
-          (gl-property :max-compute-texture-image-units)
-          (when-gl-extension :GL-ARB-COMPUTE-SHADER
-            (append (coerce (gl-property :max-compute-work-group-count) 'list)
-                    (coerce (gl-property :max-compute-work-group-size) 'list)
-                    (list (gl-property :max-compute-work-group-invocations))))
-          (gl-property :vendor)
-          (gl-property :renderer)
-          (gl-property :version)
-          (gl-property :shading-language-version)
-          (when show-extensions
-            (ignore-errors
-             (loop for i from 0 below (gl:get* :num-extensions)
-                   collect (gl:get-string-i :extensions i))))))
-
 (defun context-note-debug-info (context)
   (v:debug :trial.context "Context information: ~a"
            (let ((*print-right-margin* 1000)) ; SBCL fails otherwise. Huh?
              (with-output-to-string (out)
                (context-info context :stream out)))))
 
-(defmethod glsl-target-version ((context context))
-  (let ((slot (slot-value context 'glsl-target-version)))
-    (or slot (format NIL "~{~d~d~}0" (version context)))))
-
-(defmethod glsl-version-header ((context context))
-  (format NIL "#version ~a~@[ ~a~]"
-          (glsl-target-version context)
-          (case (profile context)
-            (:core "core")
-            (:es "es"))))
-
-(defmethod glsl-target-version ((default (eql T)))
-  (if *context* (glsl-target-version *context*) "330"))
-
 (defmethod (setf icon) ((path pathname) (context context))
   (multiple-value-bind (bits width height pixel-type pixel-format swizzle)
       (load-image path T)

debug.lisp

@@ -25,10 +25,8 @@
   (setf (uniform program "view_matrix") (view-matrix))
   (setf (uniform program "projection_matrix") (projection-matrix))
   (setf (uniform program "texture_image") 0)
-  (gl:active-texture :texture0)
-  (gl:bind-texture :texture-2d (gl-name (// 'trial 'ascii)))
-  (gl:bind-vertex-array (gl-name (text-vao draw)))
-  (gl:draw-arrays :triangles 0 (truncate (length (text draw)) 5)))
+  (bind (// 'trial 'ascii) NIL)
+  (render (text-vao draw) (truncate (length (text draw)) 5)))
 
 (define-class-shader (debug-draw-text :vertex-shader)
   "layout (location = 0) in vec3 position;
@@ -103,10 +101,8 @@ void main(){
 (defmethod render ((draw debug-draw) (program shader-program))
   (setf (uniform program "view_matrix") (view-matrix))
   (setf (uniform program "projection_matrix") (projection-matrix))
-  (gl:bind-vertex-array (gl-name (points-vao draw)))
-  (gl:draw-arrays :points 0 (truncate (length (points draw)) 6))
-  (gl:bind-vertex-array (gl-name (lines-vao draw)))
-  (gl:draw-arrays :lines 0 (truncate (length (lines draw)) 6))
+  (render (points-vao draw) (truncate (length (points draw)) 6))
+  (render (lines-vao draw) (truncate (length (lines draw)) 6))
   (render (text-render draw) T))
 
 (defmacro define-debug-draw-function ((name type) args &body body)

display.lisp

@@ -39,26 +39,23 @@
 (defmethod handle (event (display display)))
 
 (defmethod setup-rendering ((display display))
-  (reset-matrix (model-matrix))
-  (reset-matrix (view-matrix))
-  (reset-matrix (projection-matrix))
-  (reset-features (feature-table))
-  (gl:stencil-mask #xFF)
-  (gl:clear-stencil #x00)
-  (gl:stencil-op :keep :keep :keep)
-  (gl:depth-mask T)
-  (gl:depth-func :lequal)
-  (gl:blend-func-separate :src-alpha :one-minus-src-alpha :one :one-minus-src-alpha)
-  #-arm64 (gl:clear-depth 1.0)
-  (gl:front-face :ccw)
-  (gl:cull-face :back)
-  (gl:pixel-store :unpack-alignment 1)
-  (gl:pixel-store :pack-alignment 1)
-  (with-vec (r g b a) (clear-color display)
-    (gl:clear-color r g b a))
-  (enable-feature :blend :multisample :cull-face :stencil-test :depth-test :texture-cube-map-seamless)
-  (when-gl-extension :gl-arb-depth-clamp
-    (enable-feature :depth-clamp)))
+  (let ((context (context display)))
+    (reset-matrix (model-matrix))
+    (reset-matrix (view-matrix))
+    (reset-matrix (projection-matrix))
+    (reset-features (feature-table))
+    (setf (write-to-depth context) T)
+    (setf (depth-mode context) '<=)
+    (setf (stencil-mode context) '<=)
+    (setf (blend-mode context) :default)
+    (setf (culling-mode context) :default)
+    (setf (stencil-mode context) :default)
+    (setf (clear-color context (clear-color display)))
+    (gl:pixel-store :unpack-alignment 1)
+    (gl:pixel-store :pack-alignment 1)
+    (enable-feature :blend :multisample :cull-face :stencil-test :depth-test :texture-cube-map-seamless)
+    (when-gl-extension :gl-arb-depth-clamp
+      (enable-feature :depth-clamp))))
 
 (defmethod update :after ((display display) tt dt fc)
   (declare (type double-float tt))

effects.lisp

@@ -47,13 +47,14 @@ void main(){
   ((iterations :initarg :iterations :initform 1 :accessor iterations)))
 
 (defmethod render ((pass iterative-post-effect-pass) (program shader-program))
-  (let* ((color (gl-name (color pass)))
+  (let* ((color (color pass))
          (ocolor color)
-         (previous (gl-name (previous-pass pass))))
+         (framebuffer (framebuffer pass))
+         (previous (previous-pass pass)))
     (flet ((swap-buffers ()
              (rotatef color previous)
-             (%gl:framebuffer-texture :framebuffer :color-attachment0 color 0)
-             (gl:bind-texture :texture-2d previous)))
+             (bind color framebuffer)
+             (bind previous 0)))
       (call-next-method)
       (loop with limit = (iterations pass)
             for i from 0
@@ -63,16 +64,16 @@ void main(){
                    (return)))
       ;; KLUDGE: this is wrong for even number of iterations. It essentially
       ;;         discards the last iteration, as it won't be displayed....
-      (when (/= ocolor color)
-        (%gl:framebuffer-texture :framebuffer :color-attachment0 ocolor 0)))))
+      (unless (eq ocolor color)
+        (bind ocolor (framebuffer pass))))))
 
 (define-shader-pass temporal-post-effect-pass (post-effect-pass)
   ((previous :port-type static-input :accessor previous)
    (color :port-type output :reader color)))
 
 (defmethod render :after ((pass temporal-post-effect-pass) thing)
   (rotatef (gl-name (previous pass)) (gl-name (color pass)))
-  (%gl:framebuffer-texture :framebuffer :color-attachment0 (gl-name (color pass)) 0))
+  (bind (color pass) (framebuffer pass)))
 
 (define-shader-pass copy-pass (simple-post-effect-pass)
   ())

fps.lisp

@@ -67,8 +67,7 @@
                 for div = 1 then (* 10 div)
                 do (set-rect i (mod (floor fps div) 10))))
         (update-buffer-data buf T)))
-    (gl:active-texture :texture0)
-    (gl:bind-texture :texture-2d (gl-name (// 'trial 'fps-texture)))
+    (bind (// 'trial 'fps-texture) NIL)
     (render vao program)))
 
 (define-class-shader (fps-counter :vertex-shader)