summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/render.scm44
-rw-r--r--sly/render/model.scm18
-rw-r--r--sly/render/scene.scm22
3 files changed, 49 insertions, 35 deletions
diff --git a/sly/render.scm b/sly/render.scm
index c1d19e3..6ff7bb9 100644
--- a/sly/render.scm
+++ b/sly/render.scm
@@ -54,11 +54,15 @@
set-graphics-framebuffer!
graphics-viewport
set-graphics-viewport!
- graphics-transform
- graphics-transform-mul!
- graphics-transform-identity!
+ graphics-model-view-transform
+ graphics-model-view-mul!
+ graphics-model-view-identity!
+ with-model-view-excursion
+ graphics-projection-transform
+ graphics-projection-mul!
+ graphics-projection-identity!
+ with-projection-excursion
with-graphics
- with-transform-excursion
with-graphics-excursion))
;;;
@@ -84,9 +88,10 @@
(define (call-with-transform-excursion stack thunk)
(let ((t (q-pop! stack)))
(dynamic-wind
+ (const #t)
(lambda ()
- (copy-transform! t (q-front stack)))
- thunk
+ (copy-transform! t (q-front stack))
+ (thunk))
(lambda ()
(q-push! stack t)))))
@@ -180,20 +185,33 @@
body ...
(graphics-reset! gfx)))
-(define (graphics-transform gfx)
+(define (graphics-model-view-transform gfx)
(q-front (graphics-model-view gfx)))
-(define (graphics-transform-mul! gfx t)
+(define (graphics-model-view-mul! gfx t)
(stack-transform-mul! (graphics-model-view gfx) t))
-(define (graphics-transform-identity! gfx)
+(define (graphics-model-view-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 ...)
+;; emacs: (put 'with-model-view-excursion 'scheme-indent-function 1)
+(define-syntax-rule (with-model-view-excursion gfx body ...)
(call-with-transform-excursion (graphics-model-view gfx)
- (lambda ()
- body ...)))
+ (lambda () body ...)))
+
+(define (graphics-projection-transform gfx)
+ (q-front (graphics-projection gfx)))
+
+(define (graphics-projection-mul! gfx t)
+ (stack-transform-mul! (graphics-projection gfx) t))
+
+(define (graphics-projection-identity! gfx)
+ (stack-transform-identity! (graphics-projection gfx)))
+
+;; emacs: (put 'with-projection-excursion 'scheme-indent-function 1)
+(define-syntax-rule (with-projection-excursion gfx body ...)
+ (call-with-transform-excursion (graphics-projection gfx)
+ (lambda () body ...)))
(define-syntax-rule (with-graphics-excursion gfx body ...)
(match gfx
diff --git a/sly/render/model.scm b/sly/render/model.scm
index 77c550e..d18ace5 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -139,8 +139,8 @@ 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 gfx)
- "Render MODEL by applying its transform (multiplied by VIEW), texture,
+(define (draw-model model gfx)
+ "Render MODEL by applying its transformation, texture,
shader, vertex array, uniforms, blend mode, etc. using GFX."
(match model
((? model-null? _)
@@ -152,26 +152,24 @@ shader, vertex array, uniforms, blend mode, etc. using GFX."
(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)
+ (with-model-view-excursion gfx
+ (graphics-model-view-mul! gfx local-transform)
+ (with-model-view-excursion gfx
+ (graphics-model-view-mul! gfx (graphics-projection-transform gfx))
(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" (graphics-transform gfx))
+ (uniform-set! shader "mvp" (graphics-model-view-transform gfx))
(uniform-set! shader "color" color)
(uniform-set! shader "use_texture" (not (texture-null? texture)))
(glDrawElements (begin-mode triangles)
(mesh-length mesh)
(data-type unsigned-int)
%null-pointer))
- (for-each (lambda (child)
- (draw-model child view gfx))
- children)))))
+ (for-each (lambda (child) (draw-model child gfx)) children)))))
;;;
;;; Utility Procedures
diff --git a/sly/render/scene.scm b/sly/render/scene.scm
index 48e8af7..b46baae 100644
--- a/sly/render/scene.scm
+++ b/sly/render/scene.scm
@@ -58,18 +58,16 @@ scene is drawn to directly to the OpenGL window."
"Render SCENE with the given rendering GFX."
(match scene
(($ <scene> camera model framebuffer)
- (with-transform-excursion gfx
- (graphics-transform-identity! gfx)
- (let ((view (graphics-transform gfx)))
- (transform*! view
- (camera-location camera)
- (camera-projection 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 gfx)))))))
+ (with-projection-excursion gfx
+ (graphics-projection-identity! gfx)
+ (graphics-projection-mul! gfx (camera-projection camera))
+ (with-model-view-excursion gfx
+ (graphics-model-view-identity! gfx)
+ (graphics-model-view-mul! gfx (camera-location camera))
+ (set-graphics-framebuffer! gfx framebuffer)
+ (set-graphics-viewport! gfx (camera-viewport camera))
+ (clear-viewport (camera-viewport camera))
+ (draw-model model gfx))))))
(define* (scene->sprite scene #:key (anchor 'center))
"Create a sprite that renders the framebuffer texture for SCENE."