diff options
| -rw-r--r-- | Makefile.am | 4 | ||||
| -rwxr-xr-x | examples/2048/2048.scm | 1 | ||||
| -rw-r--r-- | sly/game.scm | 14 | ||||
| -rw-r--r-- | sly/render.scm | 206 | ||||
| -rw-r--r-- | sly/render/context.scm | 199 | ||||
| -rw-r--r-- | sly/render/model.scm | 35 | ||||
| -rw-r--r-- | sly/render/scene.scm | 22 |
7 files changed, 243 insertions, 238 deletions
diff --git a/Makefile.am b/Makefile.am index a6405d5..dad4409 100644 --- a/Makefile.am +++ b/Makefile.am @@ -48,14 +48,14 @@ SOURCES = \ sly/render/font.scm \ sly/render/framebuffer.scm \ sly/render/mesh.scm \ - sly/render/model.scm \ sly/render/texture.scm \ sly/render/shader.scm \ sly/render/shape.scm \ sly/render/sprite.scm \ sly/render/tileset.scm \ sly/render/tile-map.scm \ - sly/render/context.scm \ + sly/render.scm \ + sly/render/model.scm \ sly/render/scene.scm \ $(WRAPPER_SOURCES) \ sly.scm diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm index 043835b..97922de 100755 --- a/examples/2048/2048.scm +++ b/examples/2048/2048.scm @@ -35,7 +35,6 @@ (sly math vector) (sly render camera) (sly render color) - (sly render context) (sly render font) (sly render model) (sly render scene) diff --git a/sly/game.scm b/sly/game.scm index b836c22..7e4a79c 100644 --- a/sly/game.scm +++ b/sly/game.scm @@ -34,7 +34,7 @@ #:use-module (sly signal) #:use-module (sly math vector) #:use-module (sly window) - #:use-module (sly render context) + #:use-module (sly render) #:use-module (sly render scene) #:export (draw-hook after-game-loop-error-hook @@ -63,9 +63,9 @@ for the given STACK and error KEY with additional arguments ARGS." (newline cep))) (define* (run-game-loop scene #:key - (frame-rate 60) - (tick-rate 60) - (max-ticks-per-frame 4)) + (frame-rate 60) + (tick-rate 60) + (max-ticks-per-frame 4)) "Run the game loop. SCENE is a signal which contains the current scene to render. FRAME-RATE specifies the optimal number of frames to draw SCENE per second. TICK-RATE specifies the optimal game logic @@ -76,7 +76,7 @@ due to poor performance, the game will start to slow down instead of becoming completely unresponsive and possibly crashing." (let ((tick-interval (interval tick-rate)) (frame-interval (interval frame-rate)) - (context (make-render-context))) + (gfx (make-graphics))) (define (draw dt alpha) "Render a frame." @@ -84,8 +84,8 @@ becoming completely unresponsive and possibly crashing." (gl-viewport 0 0 (vx size) (vy size))) (gl-clear (clear-buffer-mask color-buffer depth-buffer)) (run-hook draw-hook dt alpha) - (with-render-context context - (draw-scene (signal-ref scene) context)) + (with-graphics gfx + (draw-scene (signal-ref scene) gfx)) (SDL:gl-swap-buffers)) (define (update lag) diff --git a/sly/render.scm b/sly/render.scm new file mode 100644 index 0000000..15103cd --- /dev/null +++ b/sly/render.scm @@ -0,0 +1,206 @@ +;;; Sly +;;; Copyright (C) 2014 David Thompson <davet@gnu.org> +;;; +;;; Sly 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. +;;; +;;; Sly 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/>. + +;;; Commentary: +;; +;; Manages the OpenGL state machine. +;; +;;; Code: + +(define-module (sly render) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 match) + #:use-module (ice-9 q) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-42) + #:use-module (gl) + #:use-module (gl enums) + #:use-module (gl low-level) + #:use-module (sly wrappers gl) + #:use-module (sly math transform) + #:use-module (sly render shader) + #:use-module (sly render texture) + #:use-module (sly render utils) + #:use-module (sly render mesh) + #:use-module (sly render framebuffer) + #:use-module (sly render camera) + #:export (make-graphics + graphics? + graphics-blend-mode + set-graphics-blend-mode! + graphics-depth-test? + set-graphics-depth-test! + graphics-texture + set-graphics-texture! + graphics-shader + set-graphics-shader! + graphics-mesh + set-graphics-mesh! + graphics-framebuffer + set-graphics-framebuffer! + graphics-viewport + set-graphics-viewport! + graphics-transform + graphics-transform-mul! + graphics-transform-identity! + with-graphics + with-transform-excursion + with-graphics-excursion)) + +;;; +;;; Transformation matrix stack. +;;; + +(define (make-null-transform) + (make-transform 0 0 0 0 + 0 0 0 0 + 0 0 0 0 + 0 0 0 0)) + +(define (make-transform-stack size) + (let ((stack (make-q))) + (do-ec (: i size) (q-push! stack (make-null-transform))) + stack)) + +(define (copy-transform! src dest) + (bytevector-copy! (transform-matrix src) 0 + (transform-matrix dest) 0 + 64)) + +(define (call-with-transform-excursion stack thunk) + (let ((t (q-pop! stack))) + (dynamic-wind + (lambda () + (copy-transform! t (q-front stack))) + thunk + (lambda () + (q-push! stack t))))) + +(define (stack-transform-mul! stack t) + (let ((dest (q-front stack))) + (call-with-transform-excursion stack + (lambda () + (transform*! dest (q-front stack) t))))) + +(define (stack-transform-identity! stack) + (copy-transform! identity-transform (q-front stack))) + +;;; +;;; Graphics context. +;;; + +(define-record-type <graphics> + (%make-graphics blend-mode depth-test? texture shader + mesh framebuffer viewport projection model-view) + graphics? + (blend-mode graphics-blend-mode %set-graphics-blend-mode!) + (depth-test? graphics-depth-test? %set-graphics-depth-test!) + (texture graphics-texture %set-graphics-texture!) + (shader graphics-shader %set-graphics-shader!) + (mesh graphics-mesh %set-graphics-mesh!) + (framebuffer graphics-framebuffer %set-graphics-framebuffer!) + (viewport graphics-viewport %set-graphics-viewport!) + (projection graphics-projection) + (model-view graphics-model-view)) + +(define (make-context-switcher getter setter switch) + (lambda* (gfx x #:optional force) + (when (or force (not (equal? (getter gfx) x))) + (setter gfx x) + (switch x)))) + +(define set-graphics-blend-mode! + (make-context-switcher graphics-blend-mode + %set-graphics-blend-mode! + apply-blend-mode)) + +(define set-graphics-depth-test! + (make-context-switcher graphics-depth-test? + %set-graphics-depth-test! + apply-depth-test)) + +(define set-graphics-texture! + (make-context-switcher graphics-texture + %set-graphics-texture! + apply-texture)) + +(define set-graphics-shader! + (make-context-switcher graphics-shader + %set-graphics-shader! + apply-shader-program)) + +(define set-graphics-mesh! + (make-context-switcher graphics-mesh + %set-graphics-mesh! + apply-mesh)) + +(define set-graphics-framebuffer! + (make-context-switcher graphics-framebuffer + %set-graphics-framebuffer! + apply-framebuffer)) + +(define set-graphics-viewport! + (make-context-switcher graphics-viewport + %set-graphics-viewport! + apply-viewport)) + +(define* (make-graphics #:optional (transform-stack-size 32)) + (%make-graphics #f #f #f #f #f #f #f + (make-transform-stack transform-stack-size) + (make-transform-stack transform-stack-size))) + +(define (graphics-reset! gfx) + (set-graphics-blend-mode! gfx #f) + (set-graphics-depth-test! gfx #f) + (set-graphics-texture! gfx null-texture) + (set-graphics-shader! gfx null-shader-program) + (set-graphics-mesh! gfx null-mesh) + (set-graphics-framebuffer! gfx null-framebuffer) + (set-graphics-viewport! gfx null-viewport) + (stack-transform-identity! (graphics-projection gfx)) + (stack-transform-identity! (graphics-model-view gfx))) + +(define-syntax-rule (with-graphics gfx body ...) + (begin (graphics-reset! gfx) body ...)) + +(define (graphics-transform gfx) + (q-front (graphics-model-view gfx))) + +(define (graphics-transform-mul! gfx t) + (stack-transform-mul! (graphics-model-view gfx) t)) + +(define (graphics-transform-identity! gfx) + (stack-transform-identity! (graphics-model-view gfx))) + +;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1) +(define-syntax-rule (with-transform-excursion gfx body ...) + (call-with-transform-excursion (graphics-model-view gfx) + (lambda () + body ...))) + +(define-syntax-rule (with-graphics-excursion gfx body ...) + (match gfx + (($ <graphics> blend-mode depth-test? texture shader mesh + viewport framebuffer _ _) + body ... + (set-graphics-blend-mode! gfx blend-mode) + (set-graphics-depth-test! gfx depth-test?) + (set-graphics-texture! gfx texture) + (set-graphics-shader! gfx shader) + (set-graphics-mesh! gfx mesh) + (set-graphics-framebuffer! gfx framebuffer) + (set-graphics-viewport! gfx viewport)))) diff --git a/sly/render/context.scm b/sly/render/context.scm deleted file mode 100644 index a83b612..0000000 --- a/sly/render/context.scm +++ /dev/null @@ -1,199 +0,0 @@ -;;; Sly -;;; Copyright (C) 2014 David Thompson <davet@gnu.org> -;;; -;;; Sly 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. -;;; -;;; Sly 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/>. - -;;; Commentary: -;; -;; Manages OpenGL state and reduces state changes. -;; -;;; Code: - -(define-module (sly render context) - #:use-module (rnrs bytevectors) - #:use-module (ice-9 match) - #:use-module (ice-9 q) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-42) - #:use-module (gl) - #:use-module (gl enums) - #:use-module (gl low-level) - #:use-module (sly wrappers gl) - #:use-module (sly math transform) - #:use-module (sly render shader) - #:use-module (sly render texture) - #:use-module (sly render utils) - #:use-module (sly render mesh) - #:use-module (sly render framebuffer) - #:use-module (sly render camera) - #:export (make-render-context - render-context? - with-render-context - render-context-blend-mode set-render-context-blend-mode! - render-context-depth-test? set-render-context-depth-test?! - render-context-texture set-render-context-texture! - render-context-shader set-render-context-shader! - render-context-mesh set-render-context-mesh! - render-context-framebuffer set-render-context-framebuffer! - render-context-viewport set-render-context-viewport! - render-context-transform render-context-transform*! - render-context-transform-identity! - with-transform-excursion - with-render-context-excursion)) - -(define-record-type <gl-parameter> - (%make-gl-parameter default bind value) - gl-parameter? - (default gl-parameter-default) - (bind gl-parameter-bind) - (value gl-parameter-ref %gl-parameter-set!)) - -(define (make-gl-parameter default bind) - (%make-gl-parameter default bind default)) - -(define* (gl-parameter-set! parameter value #:optional force?) - (unless (and (not force?) (equal? (gl-parameter-ref parameter) value)) - (%gl-parameter-set! parameter value) - ((gl-parameter-bind parameter) value))) - -(define (gl-parameter-reset! parameter) - (gl-parameter-set! parameter (gl-parameter-default parameter) #t)) - -(define-record-type <render-context> - (%make-render-context blend-mode depth-test? texture shader - mesh framebuffer viewport transform-stack) - render-context? - (blend-mode render-context-blend-mode) - (depth-test? render-context-depth-test?) - (texture render-context-texture) - (shader render-context-shader) - (mesh render-context-mesh) - (framebuffer render-context-framebuffer) - (viewport render-context-viewport) - (transform-stack render-context-transform-stack)) - -(define (make-null-transform) - (make-transform 0 0 0 0 - 0 0 0 0 - 0 0 0 0 - 0 0 0 0)) - -(define (make-transform-stack size) - (let ((stack (make-q))) - (do-ec (: i 128) (q-push! stack (make-null-transform))) - stack)) - -(define* (make-render-context #:optional (transform-stack-size 32)) - (%make-render-context (make-gl-parameter #f apply-blend-mode) - (make-gl-parameter #t apply-depth-test) - (make-gl-parameter null-texture apply-texture) - (make-gl-parameter null-shader-program - apply-shader-program) - (make-gl-parameter null-mesh apply-mesh) - (make-gl-parameter null-framebuffer apply-framebuffer) - (make-gl-parameter null-viewport apply-viewport) - (make-transform-stack transform-stack-size))) - -(define (render-context-reset! context) - (gl-parameter-reset! (render-context-blend-mode context)) - (gl-parameter-reset! (render-context-depth-test? context)) - (gl-parameter-reset! (render-context-texture context)) - (gl-parameter-reset! (render-context-shader context)) - (gl-parameter-reset! (render-context-mesh context)) - (gl-parameter-reset! (render-context-framebuffer context)) - (gl-parameter-reset! (render-context-viewport context)) - (render-context-transform-identity! context)) - -(define-syntax-rule (with-render-context context body ...) - (begin (render-context-reset! context) - body ... - (render-context-reset! context))) - -(define-syntax-rule (define-context-setter name accessor) - (define (name context value) - (gl-parameter-set! (accessor context) value))) - -(define-context-setter set-render-context-blend-mode! - render-context-blend-mode) - -(define-context-setter set-render-context-depth-test?! - render-context-depth-test?) - -(define-context-setter set-render-context-texture! - render-context-texture) - -(define-context-setter set-render-context-shader! - render-context-shader) - -(define-context-setter set-render-context-mesh! - render-context-mesh) - -(define-context-setter set-render-context-framebuffer! - render-context-framebuffer) - -(define-context-setter set-render-context-viewport! - render-context-viewport) - -(define (render-context-transform context) - (q-front (render-context-transform-stack context))) - -(define (render-context-push-transform! context t) - (q-push! (render-context-transform-stack context) t)) - -(define render-context-pop-transform! - (compose q-pop! render-context-transform-stack)) - -(define (copy-transform! src dest) - (bytevector-copy! (transform-matrix src) 0 - (transform-matrix dest) 0 - 64)) - -;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1) -(define-syntax-rule (with-transform-excursion context body ...) - (let ((t (render-context-pop-transform! context))) - (dynamic-wind - (lambda () - (copy-transform! t (render-context-transform context))) - (lambda () body ...) - (lambda () - (render-context-push-transform! context t))))) - -(define (render-context-transform*! context t) - (let ((dest (render-context-transform context))) - (with-transform-excursion context - (transform*! dest (render-context-transform context) t)))) - -(define (render-context-transform-identity! context) - (copy-transform! identity-transform (render-context-transform context))) - -(define-syntax-rule (with-render-context-excursion context body ...) - (match context - (($ <render-context> blend-mode depth-test? texture shader mesh - viewport framebuffer _) - (let ((prev-blend-mode (gl-parameter-ref blend-mode)) - (prev-depth-test? (gl-parameter-ref depth-test?)) - (prev-texture (gl-parameter-ref texture)) - (prev-shader (gl-parameter-ref shader)) - (prev-mesh (gl-parameter-ref mesh)) - (prev-framebuffer (gl-parameter-ref framebuffer)) - (prev-viewport (gl-parameter-ref viewport))) - body ... - (gl-parameter-set! blend-mode prev-blend-mode) - (gl-parameter-set! depth-test? prev-depth-test?) - (gl-parameter-set! texture prev-texture) - (gl-parameter-set! shader prev-shader) - (gl-parameter-set! mesh prev-mesh) - (gl-parameter-set! framebuffer prev-framebuffer) - (gl-parameter-set! viewport prev-viewport))))) diff --git a/sly/render/model.scm b/sly/render/model.scm index 3cc310a..77c550e 100644 --- a/sly/render/model.scm +++ b/sly/render/model.scm @@ -31,12 +31,12 @@ #:use-module (sly math transform) #:use-module (sly math vector) #:use-module (sly math rect) + #:use-module (sly render) #:use-module (sly render shader) #:use-module (sly render texture) #:use-module (sly render utils) #:use-module (sly render camera) #:use-module (sly render color) - #:use-module (sly render context) #:use-module (sly render mesh) #:export (make-model model @@ -139,10 +139,9 @@ changing the fields specified in KWARGS." (define draw-sub-scene (delay (module-ref (resolve-interface '(sly render scene)) 'draw-scene))) -(define (draw-model model view context) +(define (draw-model model view gfx) "Render MODEL by applying its transform (multiplied by VIEW), texture, -shader, vertex array, uniforms, blend mode, etc. to the render -CONTEXT." +shader, vertex array, uniforms, blend mode, etc. using GFX." (match model ((? model-null? _) *unspecified*) @@ -150,20 +149,20 @@ CONTEXT." depth-test? sub-scene children) (when sub-scene - (with-render-context-excursion context - ((force draw-sub-scene) sub-scene context))) - - (with-transform-excursion context - (render-context-transform*! context local-transform) - (with-transform-excursion context - (render-context-transform*! context view) - (set-render-context-depth-test?! context depth-test?) - (set-render-context-blend-mode! context blend-mode) - (set-render-context-shader! context shader) - (set-render-context-mesh! context mesh) - (set-render-context-texture! context texture) + (with-graphics-excursion gfx + ((force draw-sub-scene) sub-scene gfx))) + + (with-transform-excursion gfx + (graphics-transform-mul! gfx local-transform) + (with-transform-excursion gfx + (graphics-transform-mul! gfx view) + (set-graphics-depth-test! gfx depth-test?) + (set-graphics-blend-mode! gfx blend-mode) + (set-graphics-shader! gfx shader) + (set-graphics-mesh! gfx mesh) + (set-graphics-texture! gfx texture) ;; TODO: Support user-defined uniforms. - (uniform-set! shader "mvp" (render-context-transform context)) + (uniform-set! shader "mvp" (graphics-transform gfx)) (uniform-set! shader "color" color) (uniform-set! shader "use_texture" (not (texture-null? texture))) (glDrawElements (begin-mode triangles) @@ -171,7 +170,7 @@ CONTEXT." (data-type unsigned-int) %null-pointer)) (for-each (lambda (child) - (draw-model child view context)) + (draw-model child view gfx)) children))))) ;;; diff --git a/sly/render/scene.scm b/sly/render/scene.scm index 9f66902..48e8af7 100644 --- a/sly/render/scene.scm +++ b/sly/render/scene.scm @@ -25,8 +25,8 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-9) #:use-module (sly math transform) + #:use-module (sly render) #:use-module (sly render camera) - #:use-module (sly render context) #:use-module (sly render framebuffer) #:use-module (sly render model) #:use-module (sly render sprite) @@ -54,22 +54,22 @@ scene is drawn to directly to the OpenGL window." (define scene make-scene) -(define (draw-scene scene context) - "Render SCENE with the given rendering CONTEXT." +(define (draw-scene scene gfx) + "Render SCENE with the given rendering GFX." (match scene (($ <scene> camera model framebuffer) - (with-transform-excursion context - (render-context-transform-identity! context) - (let ((view (render-context-transform context))) + (with-transform-excursion gfx + (graphics-transform-identity! gfx) + (let ((view (graphics-transform gfx))) (transform*! view (camera-location camera) (camera-projection camera)) - (with-transform-excursion context - (render-context-transform-identity! context) - (set-render-context-framebuffer! context framebuffer) - (set-render-context-viewport! context (camera-viewport camera)) + (with-transform-excursion gfx + (graphics-transform-identity! gfx) + (set-graphics-framebuffer! gfx framebuffer) + (set-graphics-viewport! gfx (camera-viewport camera)) (clear-viewport (camera-viewport camera)) - (draw-model model view context))))))) + (draw-model model view gfx))))))) (define* (scene->sprite scene #:key (anchor 'center)) "Create a sprite that renders the framebuffer texture for SCENE." |