blob: a06efd94cb1546fe21fa05a4e04977d89a004660 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; 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:
;;
;; Scene graph
;;
;;; Code:
(define-module (sly scene)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (sly camera)
#:use-module (sly mesh)
#:use-module (sly quaternion)
#:use-module (sly signal)
#:use-module (sly texture)
#:use-module (sly transform)
#:use-module (sly transition)
#:use-module (sly math vector)
#:export (scene-node
make-scene-node
scene-node?
scene-node-transform scene-node-texture
scene-node-uniforms scene-node-children
update-scene-node draw-scene-node
make-scene
scene?
scene-root
update-scene draw-scene))
(define-record-type <scene-node>
(%make-scene-node transform texture uniforms children)
scene-node?
(transform scene-node-transform)
(texture scene-node-texture)
(uniforms scene-node-uniforms)
(children scene-node-children))
(define* (make-scene-node #:optional #:key
(transform identity-transform)
(texture #f)
(uniforms '())
(children '())
#:allow-other-keys)
(match children
((or (children ...)
(= list children))
(%make-scene-node transform texture uniforms children))))
(define-syntax-rule (scene-node (field val) ...)
(apply make-scene-node
(append (list (symbol->keyword 'field) val) ...)))
(define-syntax-rule (with-texture-maybe texture body ...)
(if (texture? texture)
(with-texture texture body ...)
(begin body ...)))
(define* (draw-scene-node node alpha transform #:optional (uniforms '()))
(signal-let ((node node))
(if (mesh? node)
(draw-mesh node `(("mvp" ,transform)
,@uniforms))
(signal-let ((children (scene-node-children node))
(local-transform (scene-node-transform node))
(texture (scene-node-texture node)))
(with-texture-maybe texture
(let ((transform (transform* transform local-transform))
;; FIXME: properly merge uniform alists together.
(uniforms (append uniforms (scene-node-uniforms node))))
(for-each (cut draw-scene-node <> alpha transform uniforms)
children)))))))
;;;
;;; Scene
;;;
(define-record-type <scene>
(make-scene root cameras)
scene?
(root scene-root)
(cameras scene-cameras))
(define (update-scene scene)
"Update the nodes within SCENE."
(update-scene-node (scene-root scene)))
(define (draw-scene scene alpha)
"Draw SCENE from the perspective of CAMERA with interpolation factor
ALPHA."
(for-each (lambda (camera)
(call-with-camera camera
(lambda (projection location)
(draw-scene-node (scene-root scene)
alpha
(transform* projection location)))))
(scene-cameras scene)))
|
