blob: 7928775e71688b7798362849f84e7644ecf7fadf (
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
|
;;; 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 (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (sly mesh)
#:use-module (sly signal)
#:use-module (sly transform)
#:use-module (sly transition)
#:export (scene-node
make-scene-node
scene-root
scene-node?
scene-node-position scene-node-scale scene-node-rotation
scene-node-mesh scene-node-uniforms scene-node-children
update-scene-node draw-scene-node))
(define-record-type <scene-node>
(%make-scene-node position scale rotation mesh uniforms children)
scene-node?
(position %scene-node-position)
(scale %scene-node-scale)
(rotation %scene-node-rotation)
(prev-position scene-node-prev-position set-scene-node-prev-position!)
(prev-scale scene-node-prev-scale set-scene-node-prev-scale!)
(prev-rotation scene-node-prev-rotation set-scene-node-prev-rotation!)
(mesh %scene-node-mesh)
(uniforms %scene-node-uniforms)
(children %scene-node-children))
(define-syntax-rule (define/signal-ref name proc)
(define name (compose signal-ref-maybe proc)))
(define/signal-ref scene-node-position %scene-node-position)
(define/signal-ref scene-node-scale %scene-node-scale)
(define/signal-ref scene-node-rotation %scene-node-rotation)
(define/signal-ref scene-node-mesh %scene-node-mesh)
(define/signal-ref scene-node-uniforms %scene-node-uniforms)
(define/signal-ref scene-node-children %scene-node-children)
(define* (make-scene-node #:optional #:key
(position #(0 0))
(scale 1)
(rotation 0)
(mesh #f)
(uniforms '())
(children '())
#:allow-other-keys)
(%make-scene-node position scale rotation mesh uniforms children))
(define scene-node make-scene-node)
(define (scene-root . children)
(scene-node #:children children))
(define (update-scene-node node)
(let ((node (signal-ref-maybe node)))
(let ((position (scene-node-position node))
(scale (scene-node-scale node))
(rotation (scene-node-rotation node)))
(set-scene-node-prev-position! node position)
(set-scene-node-prev-scale! node scale)
(set-scene-node-prev-rotation! node rotation))
(for-each update-scene-node (scene-node-children node))))
(define (interpolate current prev alpha)
(if (or (not prev)
(equal? current prev))
current
(vector-interpolate prev current alpha)))
(define (draw-scene-node node alpha transform)
(let* ((node (signal-ref-maybe node))
(transform (transform*
transform
(translate
(interpolate (scene-node-position node)
(scene-node-prev-position node)
alpha))
(rotate-z (scene-node-rotation node))
(scale (scene-node-scale node))))
(mesh (scene-node-mesh node)))
(when mesh
(draw-mesh mesh (cons (list "mvp" transform)
(scene-node-uniforms node))))
(for-each (cut draw-scene-node <> alpha transform)
(scene-node-children node))))
|
