]> git.jsancho.org Git - guile-irrlicht.git/blob - irrlicht/scene.scm
Set material for video driver
[guile-irrlicht.git] / irrlicht / scene.scm
1 ;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
2 ;;; Copyright (C) 2019 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 (ice-9 match)
23   #:use-module (system foreign)
24   #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
25   #:use-module ((irrlicht bindings scene) #:prefix ffi-scene:)
26   #:use-module ((irrlicht bindings video) #:prefix ffi-video:)
27   #:use-module (irrlicht util)
28   #:export (add-animated-mesh-scene-node
29             add-animator!
30             add-camera-scene-node!
31             add-camera-scene-node-fps!
32             add-custom-scene-node!
33             add-octree-scene-node
34             create-rotation-animator
35             get-mesh
36             get-root-scene-node
37             scene-draw-all
38             set-material-flag!
39             set-material-texture!
40             set-md2-animation!
41             set-position!))
42
43 (define* (add-animated-mesh-scene-node scene-manager mesh
44                                        #:key
45                                        (parent %null-pointer)
46                                        (id -1)
47                                        (position '(0 0 0))
48                                        (rotation '(0 0 0))
49                                        (scale '(1 1 1))
50                                        (also-add-if-mesh-pointer-zero #f))
51   (let ((node (ffi-scene:add-animated-mesh-scene-node
52                scene-manager
53                mesh
54                parent
55                id
56                (ffi-core:vector3df->pointer position)
57                (ffi-core:vector3df->pointer rotation)
58                (ffi-core:vector3df->pointer scale)
59                (bool->integer also-add-if-mesh-pointer-zero))))
60     (if (null-pointer? node) #f node)))
61
62 (define (add-animator! node animator)
63   (ffi-scene:add-animator node animator))
64
65 (define* (add-camera-scene-node! scene-manager
66                                  #:key
67                                  (parent %null-pointer)
68                                  (position '(0 0 0))
69                                  (lookat '(0 0 100))
70                                  (id -1)
71                                  (make-active #t))
72   (let ((camera (ffi-scene:add-camera-scene-node
73                  scene-manager
74                  parent
75                  (ffi-core:vector3df->pointer position)
76                  (ffi-core:vector3df->pointer lookat)
77                  id
78                  (bool->integer make-active))))
79     (if (null-pointer? camera) #f camera)))
80
81 (define* (add-camera-scene-node-fps! scene-manager
82                                      #:key
83                                      (parent %null-pointer)
84                                      (rotate-speed 100.0)
85                                      (move-speed 0.5)
86                                      (id -1)
87                                      (key-map-array %null-pointer)
88                                      (key-map-size 0)
89                                      (no-vertical-movement #f)
90                                      (jump-speed 0.0)
91                                      (invert-mouse #f)
92                                      (make-active #t))
93   (ffi-scene:add-camera-scene-node-fps
94    scene-manager
95    parent
96    rotate-speed
97    move-speed
98    id
99    key-map-array
100    key-map-size
101    (bool->integer no-vertical-movement)
102    jump-speed
103    (bool->integer invert-mouse)
104    (bool->integer make-active)))
105
106 (define* (add-custom-scene-node! scene-manager
107                                  render
108                                  get-bounding-box
109                                  get-material-count
110                                  get-material
111                                  #:key
112                                  (parent %null-pointer)
113                                  (id -1)
114                                  (position '(0 0 0))
115                                  (rotation '(0 0 0))
116                                  (scale '(1 1 1)))
117   (let ((c-get-bounding-box
118          (lambda ()
119            (ffi-core:aabbox3df->pointer (get-bounding-box))))
120         (c-get-material
121          (lambda (i)
122            (ffi-video:smaterial->pointer (get-material i)))))
123     (ffi-scene:add-custom-scene-node
124      scene-manager
125      parent
126      id
127      (ffi-core:vector3df->pointer position)
128      (ffi-core:vector3df->pointer rotation)
129      (ffi-core:vector3df->pointer scale)
130      (procedure->pointer void render '())
131      (procedure->pointer '* c-get-bounding-box '())
132      (procedure->pointer uint32 get-material-count '())
133      (procedure->pointer '* c-get-material (list uint32)))))
134
135 (define* (add-octree-scene-node scene-manager mesh
136                                 #:key
137                                 (parent %null-pointer)
138                                 (id -1)
139                                 (minimal-polys-per-node 512)
140                                 (also-add-if-mesh-pointer-zero #f))
141   (ffi-scene:add-octree-scene-node
142    scene-manager
143    mesh
144    parent
145    id
146    minimal-polys-per-node
147    (bool->integer also-add-if-mesh-pointer-zero)))
148
149 (define (create-rotation-animator scene-manager rotation-speed)
150   (let ((animator (ffi-scene:create-rotation-animator
151                    scene-manager
152                    (ffi-core:vector3df->pointer rotation-speed))))
153     (if (null-pointer? animator) #f animator)))
154
155 (define (get-mesh scene-manager filename)
156   (let ((mesh (ffi-scene:get-mesh scene-manager (string->pointer filename))))
157     (if (null-pointer? mesh) #f mesh)))
158
159 (define (get-root-scene-node scene-manager)
160   (ffi-scene:get-root-scene-node scene-manager))
161
162 (define (scene-draw-all scene-manager)
163   (ffi-scene:draw-all scene-manager))
164
165 (define (set-material-flag! node flag newvalue)
166   (let ((material-flag
167          (match flag
168                 ('wireframe ffi-video:EMF_WIREFRAME)
169                 ('pointcloud ffi-video:EMF_POINTCLOUD)
170                 ('gouraud-shading ffi-video:EMF_GOURAUD_SHADING)
171                 ('lighting ffi-video:EMF_LIGHTING)
172                 ('zbuffer ffi-video:EMF_ZBUFFER)
173                 ('zwrite-enable ffi-video:EMF_ZWRITE_ENABLE)
174                 ('back-face-culling ffi-video:EMF_BACK_FACE_CULLING)
175                 ('front-face-culling ffi-video:EMF_FRONT_FACE_CULLING)
176                 ('bilinear-filter ffi-video:EMF_BILINEAR_FILTER)
177                 ('trilinear-filter ffi-video:EMF_TRILINEAR_FILTER)
178                 ('anisotropic-filter ffi-video:EMF_ANISOTROPIC_FILTER)
179                 ('fog-enable ffi-video:EMF_FOG_ENABLE)
180                 ('normalize-normals ffi-video:EMF_NORMALIZE_NORMALS)
181                 ('texture-wrap ffi-video:EMF_TEXTURE_WRAP)
182                 ('anti-aliasing ffi-video:EMF_ANTI_ALIASING)
183                 ('color-mask ffi-video:EMF_COLOR_MASK)
184                 ('color-material ffi-video:EMF_COLOR_MATERIAL)
185                 ('use-mip-maps ffi-video:EMF_USE_MIP_MAPS)
186                 ('blend-operation ffi-video:EMF_BLEND_OPERATION)
187                 ('polygon-offset ffi-video:EMF_POLYGON_OFFSET))))
188     (ffi-scene:set-material-flag
189      node
190      material-flag
191      (bool->integer newvalue))))
192
193 (define (set-material-texture! node texture-layer texture)
194   (ffi-scene:set-material-texture node texture-layer texture))
195
196 (define (set-md2-animation! node anim)
197   (let ((animation-type
198          (match anim
199                 ('stand ffi-scene:EMAT_STAND)
200                 ('run ffi-scene:EMAT_RUN)
201                 ('attack ffi-scene:EMAT_ATTACK)
202                 ('pain-a ffi-scene:EMAT_PAIN_A)
203                 ('pain-b ffi-scene:EMAT_PAIN_B)
204                 ('pain-c ffi-scene:EMAT_PAIN_C)
205                 ('jump ffi-scene:EMAT_JUMP)
206                 ('flip ffi-scene:EMAT_FLIP)
207                 ('salute ffi-scene:EMAT_SALUTE)
208                 ('fallback ffi-scene:EMAT_FALLBACK)
209                 ('wave ffi-scene:EMAT_WAVE)
210                 ('point ffi-scene:EMAT_POINT)
211                 ('crouch-stand ffi-scene:EMAT_CROUCH_STAND)
212                 ('crouch-walk ffi-scene:EMAT_CROUCH_WALK)
213                 ('crouch-attack ffi-scene:EMAT_CROUCH_ATTACK)
214                 ('crouch-pain ffi-scene:EMAT_CROUCH_PAIN)
215                 ('crouch-death ffi-scene:EMAT_CROUCH_DEATH)
216                 ('death-fallback ffi-scene:EMAT_DEATH_FALLBACK)
217                 ('death-fallforward ffi-scene:EMAT_DEATH_FALLFORWARD)
218                 ('death-fallbackslow ffi-scene:EMAT_DEATH_FALLBACKSLOW)
219                 ('boom ffi-scene:EMAT_BOOM)
220                 ('count ffi-scene:EMAT_COUNT))))
221     (ffi-scene:set-md2-animation
222      node
223      animation-type)))
224
225 (define (set-position! node newpos)
226   (ffi-scene:set-position
227    node
228    (ffi-core:vector3df->pointer newpos)))