diff options
Diffstat (limited to 'chickadee/graphics/gpu.scm')
| -rw-r--r-- | chickadee/graphics/gpu.scm | 248 |
1 files changed, 0 insertions, 248 deletions
diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm deleted file mode 100644 index c5d4702..0000000 --- a/chickadee/graphics/gpu.scm +++ /dev/null @@ -1,248 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2016, 2019 David Thompson <davet@gnu.org> -;;; -;;; Chickadee is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation, either version 3 of the License, -;;; or (at your option) any later version. -;;; -;;; Chickadee is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see -;;; <http://www.gnu.org/licenses/>. - -(define-module (chickadee graphics gpu) - #:use-module (chickadee graphics gl) - #:use-module (gl) - #:use-module (gl enums) - #:use-module (oop goops) - #:use-module (srfi srfi-9) - #:use-module (system foreign) - #:export (make-gpu-state - gpu-state-ref - gpu-state-set! - - gpu-finalize - gpu-guard - gpu-reap! - - make-gpu - current-gpu - gpu? - gpu-gl-context - gpu-gl-version - gpu-glsl-version - gpu-max-texture-size - gpu-blend-mode - gpu-polygon-mode - gpu-cull-face-mode - gpu-depth-test - gpu-stencil-test - gpu-framebuffer - gpu-shader - gpu-texture - gpu-vertex-buffer - gpu-vertex-array - gpu-viewport - gpu-multisample - gpu-color-mask - set-gpu-blend-mode! - set-gpu-polygon-mode! - set-gpu-cull-face-mode! - set-gpu-depth-test! - set-gpu-stencil-test! - set-gpu-framebuffer! - set-gpu-shader! - set-gpu-texture! - set-gpu-vertex-buffer! - set-gpu-vertex-array! - set-gpu-viewport! - set-gpu-multisample! - set-gpu-color-mask!)) - - -;;; -;;; GPU state -;;; - -(define-record-type <gpu-state> - (make-gpu-state bind value) - gpu-state? - (bind gpu-state-bind) - (value gpu-state-ref %gpu-state-set!)) - -(define (gpu-state-set! state new-value) - (unless (eq? new-value (gpu-state-ref state)) - ((gpu-state-bind state) new-value) - (%gpu-state-set! state new-value))) - - -;;; -;;; GPU -;;; - -(define-record-type <gpu> - (%make-gpu gl-context - gl-version - glsl-version - guardian - max-texture-size - blend-mode - polygon-mode - cull-face-mode - depth-test - stencil-test - framebuffer - shader - textures - vertex-buffer - vertex-array - viewport - multisample - color-mask) - gpu? - (gl-context gpu-gl-context) - (gl-version gpu-gl-version) - (glsl-version gpu-glsl-version) - (guardian gpu-guardian) - (max-texture-size gpu-max-texture-size) - (blend-mode %gpu-blend-mode) - (polygon-mode %gpu-polygon-mode) - (cull-face-mode %gpu-cull-face-mode) - (depth-test %gpu-depth-test) - (stencil-test %gpu-stencil-test) - (framebuffer %gpu-framebuffer) - (shader %gpu-shader) - (textures gpu-textures) - (vertex-buffer %gpu-vertex-buffer) - (vertex-array %gpu-vertex-array) - (viewport %gpu-viewport) - (multisample %gpu-multisample) - (color-mask %gpu-color-mask)) - -(define current-gpu (make-parameter #f)) - -(define-generic gpu-finalize) - -(define (gpu-guard obj) - "Protect OBJ for the garbage collector until OBJ has been deleted -from the GPU's memory." - ((gpu-guardian (current-gpu)) obj) - obj) - -(define (gpu-reap! gpu) - "Delete all GPU objects that are no longer being referenced." - (let ((guardian (gpu-guardian gpu))) - (let loop ((obj (guardian))) - (when obj - (gpu-finalize obj) - (loop (guardian)))))) - -(define (max-texture-size) - (let ((bv (make-s32vector 1))) - (gl-get-integer-v (get-p-name max-texture-size) - (bytevector->pointer bv)) - (s32vector-ref bv 0))) - -(define (apply-multisample multisample?) - (if multisample? - (gl-enable (version-1-3 multisample)) - (gl-disable (version-1-3 multisample)))) - -(define (make-gpu gl-context) - (define (extract-version attr) - (car (string-split (pointer->string (gl-get-string attr)) #\space))) - (let ((textures (make-vector 32)) - ;; Lazily resolve bindings to avoid circular dependencies. - (blend-module (resolve-interface '(chickadee graphics blend))) - (polygon-module (resolve-interface '(chickadee graphics polygon))) - (depth-module (resolve-interface '(chickadee graphics depth))) - (stencil-module (resolve-interface '(chickadee graphics stencil))) - (buffer-module (resolve-interface '(chickadee graphics buffer))) - (framebuffer-module (resolve-interface '(chickadee graphics framebuffer))) - (shader-module (resolve-interface '(chickadee graphics shader))) - (texture-module (resolve-interface '(chickadee graphics texture))) - (viewport-module (resolve-interface '(chickadee graphics viewport))) - (color-module (resolve-interface '(chickadee graphics color))) - (gl-version (extract-version (string-name version))) - (glsl-version (extract-version (version-2-0 shading-language-version)))) - ;; Create state for 32 texture units. - (let loop ((i 0)) - (when (< i 32) - (vector-set! textures i - (let ((apply-texture (module-ref texture-module 'apply-texture))) - (make-gpu-state (lambda (texture) - (apply-texture i texture)) - (module-ref texture-module 'null-texture)))) - (loop (+ i 1)))) - (%make-gpu gl-context - gl-version - glsl-version - (make-guardian) - (max-texture-size) - (make-gpu-state (module-ref blend-module 'apply-blend-mode) - 'replace) - (make-gpu-state (module-ref polygon-module 'apply-polygon-mode) - (module-ref polygon-module 'fill-polygon-mode)) - (make-gpu-state (module-ref polygon-module 'apply-cull-face-mode) - (module-ref polygon-module 'back-cull-face-mode)) - (make-gpu-state (module-ref depth-module 'apply-depth-test) #f) - (make-gpu-state (module-ref stencil-module 'apply-stencil-test) #f) - (make-gpu-state (module-ref framebuffer-module 'apply-framebuffer) - (module-ref framebuffer-module 'null-framebuffer)) - (make-gpu-state (module-ref shader-module 'apply-shader) - (module-ref shader-module 'null-shader)) - textures - (make-gpu-state (module-ref buffer-module 'apply-buffer) - (module-ref buffer-module 'null-buffer)) - (make-gpu-state (module-ref buffer-module 'apply-vertex-array) - (module-ref buffer-module 'null-vertex-array)) - (make-gpu-state (module-ref viewport-module 'apply-viewport) - (module-ref viewport-module 'null-viewport)) - (make-gpu-state apply-multisample #f) - (make-gpu-state (module-ref color-module 'apply-color-mask) - (module-ref color-module 'default-color-mask))))) - -(define-syntax-rule (define-gpu-getter name ref) - (define (name gpu) - (gpu-state-ref (ref gpu)))) - -(define-gpu-getter gpu-blend-mode %gpu-blend-mode) -(define-gpu-getter gpu-blend-mode %gpu-polygon-mode) -(define-gpu-getter gpu-blend-mode %gpu-cull-face-mode) -(define-gpu-getter gpu-depth-test %gpu-depth-test) -(define-gpu-getter gpu-stencil-test %gpu-stencil-test) -(define-gpu-getter gpu-framebuffer %gpu-framebuffer) -(define-gpu-getter gpu-shader %gpu-shader) -(define-gpu-getter gpu-vertex-buffer %gpu-vertex-buffer) -(define-gpu-getter gpu-vertex-array %gpu-vertex-array) -(define-gpu-getter gpu-viewport %gpu-viewport) -(define-gpu-getter gpu-multisample %gpu-multisample) -(define-gpu-getter gpu-color-mask %gpu-color-mask) - -(define-syntax-rule (define-gpu-setter name ref) - (define (name gpu x) - (gpu-state-set! (ref gpu) x))) - -(define-gpu-setter set-gpu-blend-mode! %gpu-blend-mode) -(define-gpu-setter set-gpu-polygon-mode! %gpu-polygon-mode) -(define-gpu-setter set-gpu-cull-face-mode! %gpu-cull-face-mode) -(define-gpu-setter set-gpu-depth-test! %gpu-depth-test) -(define-gpu-setter set-gpu-stencil-test! %gpu-stencil-test) -(define-gpu-setter set-gpu-framebuffer! %gpu-framebuffer) -(define-gpu-setter set-gpu-shader! %gpu-shader) -(define-gpu-setter set-gpu-vertex-buffer! %gpu-vertex-buffer) -(define-gpu-setter set-gpu-vertex-array! %gpu-vertex-array) -(define-gpu-setter set-gpu-viewport! %gpu-viewport) -(define-gpu-setter set-gpu-multisample! %gpu-multisample) -(define-gpu-setter set-gpu-color-mask! %gpu-color-mask) - -(define (gpu-texture gpu texture-unit) - (gpu-state-ref (vector-ref (gpu-textures gpu) texture-unit))) - -(define (set-gpu-texture! gpu texture-unit texture) - (gpu-state-set! (vector-ref (gpu-textures gpu) texture-unit) texture)) |