summaryrefslogtreecommitdiff
path: root/chickadee/graphics/backend.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chickadee/graphics/backend.scm')
-rw-r--r--chickadee/graphics/backend.scm442
1 files changed, 442 insertions, 0 deletions
diff --git a/chickadee/graphics/backend.scm b/chickadee/graphics/backend.scm
new file mode 100644
index 0000000..caa56ac
--- /dev/null
+++ b/chickadee/graphics/backend.scm
@@ -0,0 +1,442 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2023 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;; http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Commentary
+;;
+;; Graphics backend.
+;;
+;;; Code:
+
+(define-module (chickadee graphics backend)
+ #:use-module (chickadee data pool)
+ #:use-module (chickadee graphics color)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:export (<draw-command>
+ draw-command?
+ draw-command-pipeline
+ draw-command-pass
+ draw-command-viewport
+ draw-command-scissor
+ draw-command-blend-constant
+ draw-command-stencil-reference
+ draw-command-start
+ draw-command-count
+ draw-command-instances
+ draw-command-index-buffer
+ set-draw-command-pipeline!
+ set-draw-command-pass!
+ set-draw-command-viewport!
+ set-draw-command-scissor!
+ set-draw-command-blend-constant!
+ set-draw-command-stencil-reference!
+ set-draw-command-start!
+ set-draw-command-count!
+ set-draw-command-instances!
+ set-draw-command-index-buffer!
+ set-draw-command-vertex-buffer!
+ set-draw-command-binding!
+
+ <begin-render-pass-command>
+ begin-render-pass-command?
+ begin-render-pass-command-pass
+ set-begin-render-pass-command-pass!
+ begin-render-pass-command-color-attachment-set!
+ begin-render-pass-command-depth+stencil-attachment-set!
+
+ <end-render-pass-command>
+ end-render-pass-command?
+ end-render-pass-command-pass
+ set-end-render-pass-command-pass!
+
+ make-gpu-limits
+ gpu-limits?
+ gpu-limits-max-texture-dimension-1d
+ gpu-limits-max-texture-dimension-2d
+ gpu-limits-max-texture-dimension-3d
+ gpu-limits-max-texture-array-layers
+ gpu-limits-max-sampled-textures-per-shader-stage
+ gpu-limits-max-samplers-per-shader-stage
+ gpu-limits-max-uniform-buffers-per-shader-stage
+ gpu-limits-max-uniform-buffer-binding-size
+ gpu-limits-max-bindings
+ gpu-limits-max-vertex-buffers
+ gpu-limits-max-buffer-size
+ gpu-limits-max-vertex-attributes
+ gpu-limits-max-vertex-buffer-array-stride
+ gpu-limits-max-inter-stage-shader-components
+ gpu-limits-max-inter-stage-shader-variables
+ gpu-limits-max-color-attachments
+
+ current-gpu
+ make-gpu
+ gpu?
+ gpu-name
+ gpu-description
+ gpu-limits
+ begin-frame
+ end-frame
+ make-buffer
+ destroy-buffer
+ map-buffer
+ unmap-buffer
+ write-buffer
+ make-texture
+ destroy-texture
+ write-texture
+ make-texture-view
+ destroy-texture-view
+ make-sampler
+ destroy-sampler
+ make-shader
+ destroy-shader
+ make-render-pipeline
+ destroy-render-pipeline
+ request-begin-render-pass-command
+ request-end-render-pass-command
+ request-draw-command
+ submit))
+
+
+;;;
+;;; GPU commands
+;;;
+
+;; TODO: Pool commands and re-use them each frame.
+
+(define (make-vector* k thunk)
+ (let ((v (make-vector k)))
+ (do ((i 0 (+ i 1)))
+ ((= i (vector-length v)))
+ (vector-set! v i (thunk)))
+ v))
+
+(define-record-type <begin-render-pass-command>
+ (make-begin-render-pass-command color-attachments depth+stencil-attachment)
+ begin-render-pass-command?
+ (pass begin-render-pass-command-pass set-begin-render-pass-command-pass!)
+ (color-attachments begin-render-pass-command-color-attachments)
+ (depth+stencil-attachment begin-render-pass-command-depth+stencil-attachment))
+
+(define (fresh-begin-render-pass-command max-color-attachments)
+ (make-begin-render-pass-command (make-vector* max-color-attachments
+ (lambda () (make-vector 3 #f)))
+ (make-vector 3 #f)))
+
+(define (begin-render-pass-command-color-attachment-set! cmd i view
+ resolve-target op)
+ (let ((v (vector-ref (begin-render-pass-command-color-attachments cmd) i)))
+ (vector-set! v 0 view)
+ (vector-set! v 1 resolve-target)
+ (vector-set! v 2 op)))
+
+(define (begin-render-pass-command-depth+stencil-attachment-set! cmd view
+ depth-op
+ stencil-op)
+ (let ((v (begin-render-pass-command-depth+stencil-attachment cmd)))
+ (vector-set! v 0 view)
+ (vector-set! v 1 depth-op)
+ (vector-set! v 2 stencil-op)))
+
+(define-record-type <end-render-pass-command>
+ (make-end-render-pass-command)
+ end-render-pass-command?
+ (pass end-render-pass-command-pass set-end-render-pass-command-pass!))
+
+(define (fresh-end-render-pass-command)
+ (make-end-render-pass-command))
+
+(define-record-type <draw-command>
+ (make-draw-command start count vertex-buffers bindings)
+ draw-command?
+ (pipeline draw-command-pipeline set-draw-command-pipeline!)
+ (pass draw-command-pass set-draw-command-pass!)
+ (viewport draw-command-viewport set-draw-command-viewport!)
+ (scissor draw-command-scissor set-draw-command-scissor!)
+ (blend-constant draw-command-blend-constant set-draw-command-blend-constant!)
+ (stencil-reference draw-command-stencil-reference!
+ set-draw-command-stencil-reference!)
+ (start draw-command-start set-draw-command-start!)
+ (count draw-command-count set-draw-command-count!)
+ (instances draw-command-instances set-draw-command-instances!)
+ (index-buffer draw-command-index-buffer set-draw-command-index-buffer!)
+ (vertex-buffers draw-command-vertex-buffers)
+ (bindings draw-command-bindings))
+
+(define (set-draw-command-vertex-buffer! cmd i buffer)
+ (vector-set! (draw-command-vertex-buffers cmd) i buffer))
+
+(define (set-draw-command-binding! cmd i obj)
+ (vector-set! (draw-command-bindings cmd) i obj))
+
+
+;;;
+;;; GPU backend
+;;;
+
+(define-record-type <gpu-limits>
+ (%make-gpu-limits max-texture-dimension-1d
+ max-texture-dimension-2d
+ max-texture-dimension-3d
+ max-texture-array-layers
+ max-sampled-textures-per-shader-stage
+ max-samplers-per-shader-stage
+ max-uniform-buffers-per-shader-stage
+ max-uniform-buffer-binding-size
+ max-bindings
+ max-vertex-buffers
+ max-buffer-size
+ max-vertex-attributes
+ max-vertex-buffer-array-stride
+ max-inter-stage-shader-components
+ max-inter-stage-shader-variables
+ max-color-attachments)
+ gpu-limits?
+ (max-texture-dimension-1d gpu-limits-max-texture-dimension-1d)
+ (max-texture-dimension-2d gpu-limits-max-texture-dimension-2d)
+ (max-texture-dimension-3d gpu-limits-max-texture-dimension-3d)
+ (max-texture-array-layers gpu-limits-max-texture-array-layers)
+ (max-sampled-textures-per-shader-stage
+ gpu-limits-max-sampled-textures-per-shader-stage)
+ (max-samplers-per-shader-stage gpu-limits-max-samplers-per-shader-stage)
+ (max-uniform-buffers-per-shader-stage gpu-limits-max-uniform-buffers-per-shader-stage)
+ (max-uniform-buffer-binding-size gpu-limits-max-uniform-buffer-binding-size)
+ (max-bindings gpu-limits-max-bindings)
+ (max-vertex-buffers gpu-limits-max-vertex-buffers)
+ (max-buffer-size gpu-limits-max-buffer-size)
+ (max-vertex-attributes gpu-limits-max-vertex-attributes)
+ (max-vertex-buffer-array-stride gpu-limits-max-vertex-buffer-array-stride)
+ (max-inter-stage-shader-components gpu-limits-max-inter-stage-shader-components)
+ (max-inter-stage-shader-variables gpu-limits-max-inter-stage-shader-variables)
+ (max-color-attachments gpu-limits-max-color-attachments))
+
+(define* (make-gpu-limits #:key
+ max-texture-dimension-1d
+ max-texture-dimension-2d
+ max-texture-dimension-3d
+ max-texture-array-layers
+ max-sampled-textures-per-shader-stage
+ max-samplers-per-shader-stage
+ max-uniform-buffers-per-shader-stage
+ max-uniform-buffer-binding-size
+ max-bindings
+ max-vertex-buffers
+ max-buffer-size
+ max-vertex-attributes
+ max-vertex-buffer-array-stride
+ max-inter-stage-shader-components
+ max-inter-stage-shader-variables
+ max-color-attachments)
+ (%make-gpu-limits max-texture-dimension-1d
+ max-texture-dimension-2d
+ max-texture-dimension-3d
+ max-texture-array-layers
+ max-sampled-textures-per-shader-stage
+ max-samplers-per-shader-stage
+ max-uniform-buffers-per-shader-stage
+ max-uniform-buffer-binding-size
+ max-bindings
+ max-vertex-buffers
+ max-buffer-size
+ max-vertex-attributes
+ max-vertex-buffer-array-stride
+ max-inter-stage-shader-components
+ max-inter-stage-shader-variables
+ max-color-attachments))
+
+(define-record-type <gpu>
+ (%make-gpu name
+ description
+ limits
+ internal
+ begin-frame
+ end-frame
+ make-buffer
+ destroy-buffer
+ map-buffer
+ unmap-buffer
+ write-buffer
+ make-texture
+ destroy-texture
+ write-texture
+ make-texture-view
+ destroy-texture-view
+ make-sampler
+ destroy-sampler
+ make-shader
+ destroy-shader
+ make-render-pipeline
+ destroy-render-pipeline
+ submit
+ draw-command-pool)
+ gpu?
+ (name gpu-name)
+ (description gpu-description)
+ (limits gpu-limits)
+ (internal gpu-internal)
+ (begin-frame gpu-begin-frame)
+ (end-frame gpu-end-frame)
+ (make-buffer gpu-make-buffer)
+ (destroy-buffer gpu-destroy-buffer)
+ (map-buffer gpu-map-buffer)
+ (unmap-buffer gpu-unmap-buffer)
+ (write-buffer gpu-write-buffer)
+ (make-texture gpu-make-texture)
+ (destroy-texture gpu-destroy-texture)
+ (write-texture gpu-write-texture)
+ (make-texture-view gpu-make-texture-view)
+ (destroy-texture-view gpu-destroy-texture-view)
+ (make-sampler gpu-make-sampler)
+ (destroy-sampler gpu-destroy-sampler)
+ (make-shader gpu-make-shader)
+ (destroy-shader gpu-destroy-shader)
+ (make-render-pipeline gpu-make-render-pipeline)
+ (destroy-render-pipeline gpu-destroy-render-pipeline)
+ (submit gpu-submit)
+ (draw-command-pool gpu-draw-command-pool))
+
+(define (print-gpu gpu port)
+ (format port "#<gpu ~a>" (gpu-name gpu)))
+
+(set-record-type-printer! <gpu> print-gpu)
+
+(define (nop1 x) #t)
+
+(define-syntax unimplemented
+ (lambda (x)
+ (syntax-case x ()
+ ((_ name)
+ (with-syntax ((msg (string-append (symbol->string
+ (syntax->datum #'name))
+ " unimplemented")))
+ #'(lambda args (error msg)))))))
+
+(define* (make-gpu name description internal #:key
+ limits
+ (begin-frame nop1)
+ (end-frame nop1)
+ (make-buffer (unimplemented make-buffer))
+ (destroy-buffer (unimplemented destroy-buffer))
+ (map-buffer (unimplemented map-buffer))
+ (unmap-buffer (unimplemented unmap-buffer))
+ (write-buffer (unimplemented write-buffer))
+ (make-texture (unimplemented make-texture))
+ (destroy-texture (unimplemented destroy-texture))
+ (write-texture (unimplemented write-texture))
+ (make-texture-view (unimplemented make-texture-view))
+ (destroy-texture-view (unimplemented destroy-texture-view))
+ (make-sampler (unimplemented make-sampler))
+ (destroy-sampler (unimplemented destroy-sampler))
+ (make-shader (unimplemented make-shader))
+ (destroy-shader (unimplemented destroy-shader))
+ (make-render-pipeline (unimplemented make-render-pipeline))
+ (destroy-render-pipeline (unimplemented destroy-render-pipeline))
+ (submit (unimplemented submit)))
+ (let ((max-vertex-buffers (gpu-limits-max-vertex-buffers limits))
+ (max-bindings (gpu-limits-max-bindings limits)))
+ (define (fresh-draw-command)
+ (make-draw-command 0 0 (make-vector max-vertex-buffers)
+ (make-vector max-bindings)))
+ (define (init-draw-command cmd)
+ (set-draw-command-pipeline! cmd #f)
+ (set-draw-command-pass! cmd #f)
+ (set-draw-command-viewport! cmd #f)
+ (set-draw-command-scissor! cmd #f)
+ (set-draw-command-blend-constant! cmd black)
+ (set-draw-command-stencil-reference! cmd #xffffFFFF)
+ (set-draw-command-start! cmd 0)
+ (set-draw-command-count! cmd 0)
+ (set-draw-command-index-buffer! cmd #f)
+ (vector-fill! (draw-command-vertex-buffers cmd) #f)
+ (vector-fill! (draw-command-bindings cmd) #f))
+ (%make-gpu name
+ description
+ limits
+ internal
+ begin-frame
+ end-frame
+ make-buffer
+ destroy-buffer
+ map-buffer
+ unmap-buffer
+ write-buffer
+ make-texture
+ destroy-texture
+ write-texture
+ make-texture-view
+ destroy-texture-view
+ make-sampler
+ destroy-sampler
+ make-shader
+ destroy-shader
+ make-render-pipeline
+ destroy-render-pipeline
+ submit
+ (make-pool draw-command? fresh-draw-command init-draw-command))))
+
+(define current-gpu (make-parameter #f))
+
+(define-syntax-rule (define-delegate name getter args ...)
+ (define (name backend args ...)
+ ((getter backend) (gpu-internal backend) args ...)))
+
+(define-delegate begin-frame gpu-begin-frame)
+(define-delegate end-frame gpu-end-frame view)
+
+(define-delegate make-buffer gpu-make-buffer length usage)
+(define-delegate destroy-buffer gpu-destroy-buffer buffer)
+(define-delegate map-buffer gpu-map-buffer buffer mode offset length)
+(define-delegate unmap-buffer gpu-unmap-buffer buffer)
+(define-delegate write-buffer gpu-write-buffer
+ buffer buffer-offset data data-offset length)
+
+(define-delegate make-texture gpu-make-texture
+ width height depth mip-levels samples dimension format)
+(define-delegate destroy-texture gpu-destroy-texture texture)
+(define-delegate write-texture gpu-write-texture
+ texture x y z width height depth mip-level format data offset)
+
+(define-delegate make-texture-view gpu-make-texture-view
+ texture format dimension aspect base-mip-level mip-levels base-layer layers)
+(define-delegate destroy-texture-view gpu-destroy-texture-view view)
+
+(define-delegate make-sampler gpu-make-sampler
+ address-mode-u address-mode-v address-mode-w
+ mag-filter min-filter mipmap-filter)
+(define-delegate destroy-sampler gpu-destroy-sampler sampler)
+
+(define-delegate make-shader gpu-make-shader source)
+(define-delegate destroy-shader gpu-destroy-shader shader)
+
+(define-delegate make-render-pipeline gpu-make-render-pipeline
+ shader primitive color-target depth+stencil vertex-layout binding-layout)
+(define-delegate destroy-render-pipeline gpu-destroy-render-pipeline pipeline)
+
+(define (request-begin-render-pass-command gpu)
+ (fresh-begin-render-pass-command
+ (gpu-limits-max-color-attachments (gpu-limits gpu))))
+
+(define (request-end-render-pass-command gpu)
+ (fresh-end-render-pass-command))
+
+(define (request-draw-command gpu)
+ (pool-borrow (gpu-draw-command-pool gpu)))
+
+(define (submit gpu command)
+ ((gpu-submit gpu) (gpu-internal gpu) command)
+ (cond
+ ((draw-command? command)
+ (pool-return (gpu-draw-command-pool gpu) command))
+ (else (values))))