]> git.jsancho.org Git - guile-irrlicht.git/blob - irrlicht/scene.scm
6c55a3d0cda9c2c7729a84484c216e851ed4d294
[guile-irrlicht.git] / irrlicht / scene.scm
1 ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
2 ;;; Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
3 ;;;
4 ;;; This file is part of guile-irrlicht.
5 ;;;
6 ;;; Guile-irrlicht is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation; either version 3 of the
9 ;;; License, or (at your option) any later version.
10 ;;;
11 ;;; Guile-irrlicht is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 ;;; General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with guile-irrlicht.  If not, see
18 ;;; <http://www.gnu.org/licenses/>.
19
20
21 (define-module (irrlicht scene)
22   #:use-module (oop goops)
23   #:use-module (ice-9 optargs)
24   #:use-module (irrlicht base)
25   #:use-module (irrlicht foreign)
26   #:use-module (irrlicht io)
27   #:use-module (irrlicht irr)
28   #:use-module (irrlicht video))
29
30
31 ;; IMesh
32 (define-class <mesh> (<reference-counted>)
33   (irr-class #:init-value "IMesh"))
34
35 (export <mesh>)
36
37
38 ;; IAnimatedMesh
39 (define-class <animated-mesh> (<mesh>)
40   (irr-class #:init-value "IAnimatedMesh"))
41
42 (export <animated-mesh>)
43
44
45 ;; ISceneManager
46 (define-class <scene-manager> (<reference-counted>)
47   (irr-class #:init-value "ISceneManager"))
48
49 (define-method (add-animated-mesh-scene-node! (scene-manager <scene-manager>)
50                                               (mesh <animated-mesh>)
51                                               . rest)
52   (let-keywords rest #f
53         ((parent (make <scene-node>))
54          (id -1)
55          (position '(0 0 0))
56          (rotation '(0 0 0))
57          (scale '(1 1 1))
58          (also-add-if-mesh-pointer-zero #f))
59     (make <animated-mesh-scene-node>
60       #:irr-pointer
61       ((get-irrlicht-proc "addAnimatedMeshSceneNode" scene-manager parent)
62        scene-manager
63        mesh
64        parent
65        id
66        position
67        rotation
68        scale
69        also-add-if-mesh-pointer-zero))))
70
71 (define-method (add-camera-scene-node! (scene-manager <scene-manager>) . rest)
72   (let-keywords rest #f
73         ((parent (make <scene-node>))
74          (position '(0 0 0))
75          (lookat '(0 0 100))
76          (id -1)
77          (make-active #t))
78     (make <camera-scene-node>
79       #:irr-pointer
80       ((get-irrlicht-proc "addCameraSceneNode" scene-manager parent)
81        scene-manager
82        parent
83        position
84        lookat
85        id
86        make-active))))
87
88 (define-method (add-camera-scene-node-fps! (scene-manager <scene-manager>) . rest)
89   (let-keywords rest #f
90         ((parent (make <scene-node>))
91          (rotate-speed 100)
92          (move-speed 0.5)
93          (id -1)
94          (key-map-array (make <key-map>))
95          (key-map-size 0)
96          (no-vertical-movement #f)
97          (jump-speed 0)
98          (invert-mouse #f)
99          (make-active #t))
100     (let ((addCameraSceneNodeFPS (get-irrlicht-proc "addCameraSceneNodeFPS"
101                                                     scene-manager parent)))
102       (make <camera-scene-node>
103         #:irr-pointer
104         (addCameraSceneNodeFPS scene-manager #:parent parent #:rotate-speed rotate-speed
105                                #:move-speed move-speed #:id id #:key-map-array key-map-array
106                                #:key-map-size key-map-size
107                                #:no-vertical-movement no-vertical-movement
108                                #:jump-speed jump-speed #:invert-mouse invert-mouse
109                                #:make-active make-active)))))
110
111 (define-method (add-custom-scene-node! (scene-manager <scene-manager>) proc-render
112                                        proc-get-bounding-box  proc-get-material-count
113                                        proc-get-material . rest)
114   (let-keywords rest #f
115         ((parent (make <scene-node>))
116          (id -1)
117          (position '(0 0 0))
118          (rotation '(0 0 0))
119          (scale '(1 1 1)))
120     (let ((addCustomSceneNode (get-irrlicht-proc "addCustomSceneNode" scene-manager parent)))
121       (make <scene-node>
122         #:irr-pointer
123         (addCustomSceneNode scene-manager proc-render proc-get-bounding-box proc-get-material-count
124                             proc-get-material parent id position rotation scale)))))
125
126 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
127                                        (mesh <animated-mesh>)
128                                        . rest)
129   (let-keywords rest #f
130         ((parent (make <scene-node>))
131          (id -1)
132          (minimal-polys-per-node 512)
133          (also-add-if-mesh-pointer-zero #f))
134     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))
135       (make <mesh-scene-node>
136         #:irr-pointer
137         (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
138                             also-add-if-mesh-pointer-zero)))))
139
140 (define-method (add-octree-scene-node! (scene-manager <scene-manager>)
141                                        (mesh <mesh>)
142                                        . rest)
143   (let-keywords rest #f
144         ((parent (make <scene-node>))
145          (id -1)
146          (minimal-polys-per-node 256)
147          (also-add-if-mesh-pointer-zero #f))
148     (let ((addOctreeSceneNode (get-irrlicht-proc "addOctreeSceneNode" scene-manager parent mesh)))
149       (make <mesh-scene-node>
150         #:irr-pointer
151         (addOctreeSceneNode scene-manager mesh parent id minimal-polys-per-node
152                             also-add-if-mesh-pointer-zero)))))
153
154 (define-method (draw-all (scene-manager <scene-manager>))
155   ((get-irrlicht-proc "drawAll" scene-manager)
156    scene-manager))
157
158 (define-method (get-mesh (scene-manager <scene-manager>) filename)
159   (make <animated-mesh>
160     #:irr-pointer
161     ((get-irrlicht-proc "getMesh" scene-manager)
162      scene-manager
163      filename)))
164
165 (define-method (get-root-scene-node (scene-manager <scene-manager>))
166   (let ((getRootSceneNode (get-irrlicht-proc "getRootSceneNode" scene-manager)))
167     (make <scene-node> #:irr-pointer (getRootSceneNode scene-manager))))
168
169 (export <scene-manager> add-animated-mesh-scene-node! add-camera-scene-node!
170         add-camera-scene-node-fps! add-custom-scene-node! add-octree-scene-node! draw-all
171         get-root-scene-node get-mesh)
172
173
174 ;; ISceneNode
175 (define-class <scene-node> (<attribute-exchanging-object>)
176   (irr-class #:init-value "ISceneNode"))
177
178 (define-method (set-material-flag! (node <scene-node>) flag new-value)
179   ((get-irrlicht-proc "setMaterialFlag" node)
180    node
181    flag
182    new-value))
183
184 (define-method (set-material-texture! (node <scene-node>) texture-layer (texture <texture>))
185   ((get-irrlicht-proc "setMaterialTexture" node)
186    node
187    texture-layer
188    texture))
189
190 (define-method (set-position! (node <scene-node>) new-pos)
191   (let ((setPosition (get-irrlicht-proc "setPosition" node)))
192     (setPosition node new-pos)))
193
194 (export <scene-node> set-material-flag! set-material-texture! set-position!)
195
196
197 ;; IAnimatedMeshSceneNode
198 (define-class <animated-mesh-scene-node> (<scene-node>)
199   (irr-class #:init-value "IAnimatedMeshSceneNode"))
200
201 (define-method (set-md2-animation! (node <animated-mesh-scene-node>) anim)
202   ((get-irrlicht-proc "setMD2Animation" node)
203    node
204    anim))
205
206 (export <animated-mesh-scene-node> set-md2-animation!)
207
208
209 ;; ICameraSceneNode
210 (define-class <camera-scene-node> (<scene-node>)
211   (irr-class #:init-value "ICameraSceneNode"))
212
213 (export <camera-scene-node>)
214
215
216 ;; IMeshSceneNode
217 (define-class <mesh-scene-node> (<scene-node>)
218   (irr-class #:init-value "IMeshSceneNode"))
219
220 (export <mesh-scene-node>)