diff options
Diffstat (limited to 'chickadee/graphics.scm')
| -rw-r--r-- | chickadee/graphics.scm | 340 |
1 files changed, 340 insertions, 0 deletions
diff --git a/chickadee/graphics.scm b/chickadee/graphics.scm new file mode 100644 index 0000000..a6a4bb0 --- /dev/null +++ b/chickadee/graphics.scm @@ -0,0 +1,340 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2024 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. + +(define-module (chickadee graphics) + #:use-module ((chickadee graphics backend) #:prefix gpu:) + #:use-module (chickadee graphics blend) + #:use-module (chickadee graphics buffer) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics pass) + #:use-module (chickadee graphics pipeline) + #:use-module (chickadee graphics primitive) + #:use-module (chickadee graphics shader) + #:use-module (chickadee graphics texture) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-111) + #:export (current-projection + current-viewport + current-scissor + current-pass + with-render-pass + draw + stream-draw + flush-stream + define-graphics-variable + graphics-variable-ref) + #:re-export ((gpu:gpu-limits? . gpu-limits?) + (gpu:gpu-limits-max-texture-dimension-1d . gpu-limits-max-texture-dimension-1d) + (gpu:gpu-limits-max-texture-dimension-2d . gpu-limits-max-texture-dimension-2d) + (gpu:gpu-limits-max-texture-dimension-3d . gpu-limits-max-texture-dimension-3d) + (gpu:gpu-limits-max-texture-array-layers . gpu-limits-max-texture-array-layers) + (gpu:gpu-limits-max-sampled-textures-per-shader-stage . gpu-limits-max-sampled-textures-per-shader-stage) + (gpu:gpu-limits-max-samplers-per-shader-stage . gpu-limits-max-samplers-per-shader-stage) + (gpu:gpu-limits-max-uniform-buffers-per-shader-stage . gpu-limits-max-uniform-buffers-per-shader-stage) + (gpu:gpu-limits-max-uniform-buffer-binding-size . gpu-limits-max-uniform-buffer-binding-size) + (gpu:gpu-limits-max-bindings . gpu-limits-max-bindings) + (gpu:gpu-limits-max-vertex-buffers . gpu-limits-max-vertex-buffers) + (gpu:gpu-limits-max-buffer-size . gpu-limits-max-buffer-size) + (gpu:gpu-limits-max-vertex-attributes . gpu-limits-max-vertex-attributes) + (gpu:gpu-limits-max-vertex-buffer-array-stride . gpu-limits-max-vertex-buffer-array-stride) + (gpu:gpu-limits-max-inter-stage-shader-components . gpu-limits-max-inter-stage-shader-components) + (gpu:gpu-limits-max-inter-stage-shader-variables . gpu-limits-max-inter-stage-shader-variables) + (gpu:gpu-limits-max-color-attachments . gpu-limits-max-color-attachments) + (gpu:current-gpu . current-gpu) + (gpu:gpu? . gpu?) + (gpu:gpu-name . gpu-name) + (gpu:gpu-description . gpu-description) + (gpu:gpu-limits . gpu-limits))) + +;; Private API stuff shhhhhhh... +(define buffer-handle (@@ (chickadee graphics buffer) buffer-handle)) +(define texture-handle (@@ (chickadee graphics texture) texture-handle)) +(define texture-view-handle (@@ (chickadee graphics texture) texture-view-handle)) +(define sampler-handle (@@ (chickadee graphics texture) sampler-handle)) +(define render-pipeline-handle (@@ (chickadee graphics pipeline) render-pipeline-handle)) +(define <render-pipeline> (@@ (chickadee graphics pipeline) <render-pipeline>)) + +(define-syntax-rule (define-graphics-variable name exp) + (define name + (let ((cache '())) + (define (get-it) + (let ((gpu (gpu:current-gpu))) + (or (assq-ref cache gpu) + (let ((val exp)) + (set! cache (cons (cons gpu val) cache)) + val)))) + get-it))) + +(define-syntax-rule (graphics-variable-ref var) (var)) + +(define current-projection (make-parameter #f)) +(define current-viewport (make-parameter #f)) +(define current-scissor (make-parameter #f)) +(define current-pass (make-parameter #f)) + +(define-graphics-variable last-pass (box #f)) + +(define (begin-frame) + (set-box! (graphics-variable-ref last-pass) #f) + (begin-stream) + (gpu:begin-frame (gpu:current-gpu))) + +(define (end-frame view) + (end-stream) + (gpu:end-frame (gpu:current-gpu) (texture-view-handle view))) + +(define (begin-render-pass pass) + (define (resolve-texture-view view) + (match view + (#f #f) + ((? texture-view?) + (texture-view-handle view)) + ((? procedure?) + (texture-view-handle (view))))) + (match pass + (($ <render-pass> colors depth+stencil) + (let* ((gpu (gpu:current-gpu)) + (cmd (gpu:request-begin-render-pass-command gpu))) + (gpu:set-begin-render-pass-command-pass! cmd pass) + (do ((i 0 (+ i 1))) + ((= i (vector-length colors))) + (match (vector-ref colors i) + (($ <color-attachment> view resolve-target op) + (let ((view (resolve-texture-view view)) + (resolve-target (resolve-texture-view resolve-target))) + (gpu:begin-render-pass-command-color-attachment-set! + cmd i view resolve-target op))))) + (match depth+stencil + (#f #t) + (($ <depth+stencil-attachment> view depth-op stencil-op) + (let ((view (resolve-texture-view view))) + (gpu:begin-render-pass-command-depth+stencil-attachment-set! + cmd view depth-op stencil-op)))) + (gpu:submit gpu cmd))))) + +(define (end-render-pass pass) + (let* ((gpu (gpu:current-gpu)) + (cmd (gpu:request-end-render-pass-command gpu))) + (gpu:set-end-render-pass-command-pass! cmd pass) + (gpu:submit gpu cmd))) + +(define (draw* count instances pipeline pass viewport scissor blend-constant + stencil-reference index-buffer vertex-buffers bindings) + (unless (eq? count 0) + (let* ((gpu (gpu:current-gpu)) + (cmd (gpu:request-draw-command gpu)) + (pass-box (graphics-variable-ref last-pass)) + (pass* (unbox pass-box))) + (unless (eq? pass pass*) + (when pass* + (end-render-pass pass*)) + (begin-render-pass pass) + (set-box! pass-box pass)) + (gpu:set-draw-command-pass! cmd pass) + (gpu:set-draw-command-pipeline! cmd (render-pipeline-handle pipeline)) + (gpu:set-draw-command-viewport! cmd viewport) + (gpu:set-draw-command-scissor! cmd scissor) + (gpu:set-draw-command-blend-constant! cmd blend-constant) + (gpu:set-draw-command-stencil-reference! cmd stencil-reference) + (gpu:set-draw-command-count! cmd count) + (gpu:set-draw-command-instances! cmd instances) + (when index-buffer + (gpu:set-draw-command-index-buffer! cmd (buffer-handle index-buffer))) + (do ((i 0 (+ i 1))) + ((= i (vector-length vertex-buffers))) + (let ((buffer (buffer-handle (vector-ref vertex-buffers i)))) + (gpu:set-draw-command-vertex-buffer! cmd i buffer))) + (do ((i 0 (+ i 1))) + ((= i (vector-length bindings))) + (match (vector-ref bindings i) + ((? buffer? buffer) + (gpu:set-draw-command-binding! cmd i (buffer-handle buffer))) + ((? texture? texture) + (gpu:set-draw-command-binding! cmd i (texture-handle texture))) + ((? texture-view? texture) + (gpu:set-draw-command-binding! cmd i (texture-view-handle texture))) + ((? sampler? sampler) + (gpu:set-draw-command-binding! cmd i (sampler-handle sampler))) + (#f #f))) + (gpu:submit gpu cmd)))) + +(define* (draw count #:key + pipeline + (pass (current-pass)) + (viewport (current-viewport)) + (scissor (current-scissor)) + (blend-constant black) + (stencil-reference #xffffFFFF) + index-buffer + (vertex-buffers #()) + (bindings #()) + instances) + (unless (render-pass? pass) + (error "no render pass specified")) + (unless (eq? count 0) + (flush-stream) + (draw* count instances pipeline pass viewport scissor blend-constant + stencil-reference index-buffer vertex-buffers bindings))) + + +;;; +;;; Immediate mode streaming +;;; + +;; This streaming interface is inspired by love2d. The way it works +;; is that the user calls 'stream-draw' and passes along all the +;; desired pipeline and texture/sampler/buffer binding details. If +;; the settings match what was used in the previous 'stream-draw' call +;; then the new data is simply appended to the current vertex/index +;; accumulation buffers. If the settings do not match, then the +;; stream is flushed. Flushing a stream issues a draw call for the +;; batch, clears the accumulation buffers and resets pipeline, +;; bindings, and counters. Furthermore, if any non-streaming draw +;; calls are made via 'draw' or if any relevant dynamic state is +;; changed between 'stream-draw' calls then the stream is also +;; flushed. +(define-record-type <stream-state> + (make-stream-state count vertices indices bindings bindings-length + pipeline-cache vertex-buffer-vec) + stream-state? + (count stream-state-count set-stream-state-count!) + (vertices stream-state-vertices) + (indices stream-state-indices) + (bindings stream-state-bindings) + (bindings-length stream-state-bindings-length set-stream-state-bindings-length!) + (pipeline stream-state-pipeline set-stream-state-pipeline!) + (pipeline-cache stream-state-pipeline-cache set-stream-state-pipeline-cache!) + (pass stream-state-pass set-stream-state-pass!) + (projection stream-state-projection set-stream-state-projection!) + (viewport stream-state-viewport set-stream-state-viewport!) + (scissor stream-state-scissor set-stream-state-scissor!) + (vertex-buffer-vec stream-state-vertex-buffer-vec)) + +(define-graphics-variable stream-state + (let ((limits (gpu:gpu-limits (gpu:current-gpu)))) + (make-stream-state 0 (make-dbuffer #:name "Stream vertices") + (make-dbuffer #:name "Stream indices" #:usage '(index)) + (make-vector (gpu:gpu-limits-max-vertex-buffers limits)) + 0 '() (vector #f)))) + +(define %default-primitive-mode (make-primitive-mode)) +(define %default-color-target (make-color-target)) + +(define (begin-stream) + (match (graphics-variable-ref stream-state) + ((and state ($ <stream-state> count vertices indices bindings)) + (dbuffer-map! vertices) + (dbuffer-map! indices) + (set-stream-state-count! state 0) + (set-stream-state-pipeline! state #f) + (set-stream-state-pass! state #f) + (set-stream-state-projection! state #f) + (set-stream-state-viewport! state #f) + (set-stream-state-scissor! state #f) + (vector-fill! bindings #f)))) + +(define (end-stream) + (match (graphics-variable-ref stream-state) + ((and state ($ <stream-state> count vertices indices bindings _ pipeline _ + pass projection viewport scissor vertex-vec)) + (dbuffer-unmap! vertices) + (dbuffer-unmap! indices) + (vector-set! vertex-vec 0 (dbuffer-buffer vertices)) + (unless (eq? count 0) + (draw* (/ (dbuffer-length indices) 4) #f pipeline pass + viewport scissor black #xffffFFFF (dbuffer-buffer indices) + vertex-vec bindings) + (set-stream-state-count! state 0))))) + +(define (flush-stream) + (end-stream) + (begin-stream)) + +(define* (stream-draw #:key + count + shader + (primitive %default-primitive-mode) + (color-target %default-color-target) + depth+stencil + (vertex-layout #()) + (binding-layout #()) + (bindings #())) + (match (graphics-variable-ref stream-state) + ((and state + ($ <stream-state> _ vertices indices bindings* bindings-length + pipeline cache pass projection viewport scissor)) + (define-inlinable (pipeline-equal? pipeline) + (match pipeline + (($ <render-pipeline> _ _ _ _ shader* primitive* color-target* + depth+stencil* vertex-layout* binding-layout*) + (and (eq? shader shader*) + (equal? primitive primitive*) + (equal? color-target color-target*) + (equal? depth+stencil depth+stencil*) + (equal? vertex-layout vertex-layout*) + (equal? binding-layout binding-layout*))))) + (let ((pass* (current-pass)) + (projection* (current-projection)) + (viewport* (current-viewport)) + (scissor* (current-scissor))) + ;; Check if *all* settings are the same as the previous stream + ;; draw call, including various bits of dynamic state. If + ;; anything is different, draw the batch, clear it, and start + ;; over with the new settings. + (unless (and pipeline + (pipeline-equal? pipeline) + (= (vector-length bindings) bindings-length) + (let loop ((i 0)) + (or (= i (vector-length bindings)) + (and (eq? (vector-ref bindings i) + (vector-ref bindings* i)) + (loop (+ i 1))))) + (eq? pass pass*) + (eq? viewport viewport*) + (eq? scissor scissor*) + (eq? projection projection*)) + (let ((pipeline + (let loop ((pipelines cache)) + (match pipelines + (() + (let ((new (make-render-pipeline + #:name "Stream render pipeline" + #:shader shader + #:primitive primitive + #:color-target color-target + #:depth+stencil depth+stencil + #:vertex-layout vertex-layout + #:binding-layout binding-layout))) + (set-stream-state-pipeline-cache! state (cons new cache)) + new)) + ((pipeline . rest) + (if (pipeline-equal? pipeline) + pipeline + (loop rest))))))) + (flush-stream) + (set-stream-state-pipeline! state pipeline) + (set-stream-state-pass! state pass*) + (set-stream-state-projection! state projection*) + (set-stream-state-viewport! state viewport*) + (set-stream-state-scissor! state scissor*) + (set-stream-state-bindings-length! state (vector-length bindings)) + (vector-fill! bindings* #f) + (do ((i 0 (+ i 1))) + ((= i (vector-length bindings))) + (vector-set! bindings* i (vector-ref bindings i)))))) + (let ((count* (stream-state-count state))) + (set-stream-state-count! state (+ count* count)) + (values vertices indices count*))))) |