4 ;;; guile-assimp, foreign interface to libassimp
5 ;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
7 ;;; This program is free software: you can redistribute it and/or modify
8 ;;; it under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation, either version 3 of the License, or
10 ;;; (at your option) any later version.
12 ;;; This program is distributed in the hope that it will be useful,
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
30 (define main-window #f)
32 ;;; the global Assimp scene object
37 (define scene-center #f)
39 ;;; current rotation angle
40 (define rotation-angle 0.0)
43 (define (on-reshape width height)
44 (let ((aspect-ratio (/ width height))
46 (set-gl-matrix-mode (matrix-mode projection))
48 (glu-perspective field-of-view aspect-ratio 1 1000)
49 (gl-viewport 0 0 width height)))
52 (define (get-bounding-box-for-node nd vmin vmax trafo)
54 (ai-multiply-matrix4 trafo
55 (ai-node-transformation nd))))
57 (let meshes-loop ((meshes (ai-node-meshes nd)))
58 (cond ((not (null? meshes))
59 (let vertices-loop ((vertices (ai-mesh-vertices (list-ref (ai-scene-meshes scene) (car meshes)))))
60 (cond ((not (null? vertices))
63 (ai-transform-vec-by-matrix4 (car vertices) new-trafo)))))
64 (set! vmin (map min vmin tmp))
65 (set! vmax (map max vmax tmp)))
66 (vertices-loop (cdr vertices)))))
67 (meshes-loop (cdr meshes)))))
69 (let nodes-loop ((nodes (ai-node-children nd)))
70 (cond ((not (null? nodes))
71 (let ((res (get-bounding-box-for-node (car nodes) vmin vmax new-trafo)))
73 (set! vmax (cadr res)))
74 (nodes-loop (cdr nodes)))))
79 (define (get-bounding-box)
80 (let ((trafo (ai-identity-matrix4))
81 (vmin '(1e10 1e10 1e10))
82 (vmax '(-1e10 -1e10 -1e10)))
83 (get-bounding-box-for-node (ai-scene-root-node scene) vmin vmax trafo)))
86 (define (color4-to-float4 c)
87 (let ((tmp (ai-color4d-contents c)))
88 (list (assoc-ref tmp 'r)
94 (define (get-material-color material color-type default-color)
97 (let ((color (ai-get-material-color material color-type)))
98 (cond ((ai-color4d? color)
99 (color4-to-float4 color))
104 (define (apply-material mtl)
105 (glMaterialfv (material-face front-and-back)
106 (material-parameter diffuse)
107 (get-material-color mtl (ai-material-key color-diffuse) '(0.8 0.8 0.8 1.0)))
108 (glMaterialfv (material-face front-and-back)
109 (material-parameter specular)
110 (get-material-color mtl (ai-material-key color-specular) '(0.0 0.0 0.0 1.0)))
111 (glMaterialfv (material-face front-and-back)
112 (material-parameter ambient)
113 (get-material-color mtl (ai-material-key color-ambient) '(0.2 0.2 0.2 1.0)))
114 (glMaterialfv (material-face front-and-back)
115 (material-parameter emission)
116 (get-material-color mtl (ai-material-key color-emissive) '(0.0 0.0 0.0 1.0)))
118 (let ((shininess (ai-get-material-float-array mtl (ai-material-key shininess) 1)))
119 (cond ((list? shininess)
120 (let ((strength (ai-get-material-float-array mtl (ai-material-key shininess-strength) 1)))
121 (cond ((list? strength)
122 (glMaterialf (material-face front-and-back)
123 (material-parameter shininess)
124 (* (car shininess) (car strength))))
126 (glMaterialf (material-face front-and-back)
127 (material-parameter shininess)
130 (glMaterialf (material-face front-and-back)
131 (material-parameter shininess)
133 (glMaterialfv (material-face front-and-back)
134 (material-parameter specular)
135 '(0.0 0.0 0.0 0.0)))))
137 (glPolygonMode (material-face front-and-back)
138 (let ((wireframe (ai-get-material-integer-array mtl (ai-material-key enable-wireframe) 1)))
139 (cond ((list? wireframe)
140 (if (> (car wireframe) 0)
144 (mesh-mode-2 fill)))))
146 ((let ((two-sided (ai-get-material-integer-array mtl (ai-material-key twosided) 1)))
147 (if (and (list? two-sided) (> (car two-sided) 0))
150 (enable-cap cull-face)))
153 (define (recursive-render sc nd)
154 (let ((m (ai-transpose-matrix4 (ai-node-transformation nd))))
157 (glMultMatrixf (bytevector->pointer (list->f32vector (map cdr (ai-matrix4x4-contents m)))))
159 ; draw all meshes assigned to this node
162 (let* ((mesh (list-ref (ai-scene-meshes sc) mesh-index))
163 (mesh-colors (ai-mesh-colors mesh))
164 (mesh-normals (ai-mesh-normals mesh))
165 (mesh-vertices (ai-mesh-vertices mesh)))
166 (apply-material (list-ref (ai-scene-materials sc) (ai-mesh-material-index mesh)))
167 ((if (null? (ai-mesh-normals mesh))
170 (enable-cap lighting))
175 (let ((num-indices (length (ai-face-indices face))))
176 (cond ((= num-indices 1) (begin-mode points))
177 ((= num-indices 2) (begin-mode lines))
178 ((= num-indices 3) (begin-mode triangles))
179 (else (begin-mode polygon))))
182 (if (not (null? (car mesh-colors)))
187 (list-ref (car mesh-colors) index))))))
188 (if (not (null? mesh-normals))
192 (map cdr (ai-vector3d-contents (list-ref mesh-normals index)))))))
196 (map cdr (ai-vector3d-contents (list-ref mesh-vertices index)))))))
197 (ai-face-indices face))))
198 (ai-mesh-faces mesh))))
203 (lambda (node) (recursive-render sc node))
204 (ai-node-children nd)))))
212 (let ((time (glutGet (glut-state elapsed-time))))
213 (set! rotation-angle (+ rotation-angle (* 0.01 (- time prev-time))))
214 (set! prev-time time)
215 (set! frames (1+ frames))
217 (cond ((> (- time prev-fps-time) 1000)
218 (format #t "~a fps~%" (/ (* frames 1000.0) (- time prev-fps-time)))
220 (set! prev-fps-time time)))
226 (gl-clear (clear-buffer-mask color-buffer depth-buffer))
228 (set-gl-matrix-mode (matrix-mode modelview))
230 (glu-look-at 0.0 0.0 3.0 0.0 0.0 -5.0 0.0 1.0 0.0)
232 ; rotate it around the y axis
233 (gl-rotate rotation-angle 0.0 1.0 0.0)
235 ; scale the whole asset to fit into our view frustum
236 (let ((tmp (/ 1.0 (apply max (map - scene-max scene-min)))))
237 (gl-scale tmp tmp tmp))
240 (apply gl-translate (map - scene-center))
242 ; if the display list has not been made yet, create a new one and
243 ; fill it with scene contents
244 (cond ((= scene-list 0)
245 (set! scene-list (glGenLists 1))
246 (glNewList scene-list (list-mode compile))
247 ; now begin at the root node of the imported data and traverse
248 ; the scenegraph by multiplying subsequent local transforms
249 ; together on GL's matrix stack.
250 (recursive-render scene (ai-scene-root-node scene))
253 (glCallList scene-list)
260 (define (load-asset path)
261 ; we are taking one of the postprocessing presets to avoid
262 ; spelling out 20+ single postprocessing flags here.
263 (set! scene (ai-import-file path ai-process-preset-target-realtime-max-quality))
265 (let ((box (get-bounding-box)))
266 (set! scene-min (car box))
267 (set! scene-max (cadr box))
269 (map (lambda (vmin vmax)
270 (/ (+ vmin vmax) 2.0))
277 (initialize-glut args
278 #:window-size '(900 . 600)
279 #:window-position '(100 . 100)
280 #:display-mode (display-mode rgb double depth))))
282 (set! main-window (make-window "Assimp - Very simple OpenGL sample"))
283 (set-display-callback (lambda () (on-display)))
284 (set-reshape-callback (lambda (w h) (on-reshape w h)))
286 ; get a handle to the predefined STDOUT log stream and attach
287 ; it to the logging system. It remains active for all further
288 ; calls to aiImportFile(Ex) and aiApplyPostProcessing.
289 (ai-attach-predefined-log-stream (ai-default-log-stream stdout))
291 ; ... same procedure, but this stream now writes the
292 ; log messages to assimp_log.txt
293 (ai-attach-predefined-log-stream (ai-default-log-stream file) "assimp_log.txt")
295 ; the model name can be specified on the command line. If none
296 ; is specified, we try to locate one of the more expressive test
297 ; models from the repository (/models-nonbsd may be missing in
298 ; some distributions so we need a fallback from /models!).
299 (load-asset (cadr args))
301 (set-gl-clear-color 0.1 0.1 0.1 1.0)
303 (gl-enable (enable-cap lighting))
304 (gl-enable (enable-cap light0)) ; Uses default lighting parameters
306 (gl-enable (enable-cap depth-test))
308 (glLightModeli (light-model-parameter light-model-two-side) (boolean true))
309 (gl-enable (enable-cap normalize))
311 ; XXX docs say all polygons are emitted CCW, but tests show that some aren't.
312 (cond ((getenv "MODEL_IS_BROKEN")
313 (glFrontFace (front-face-direction cw))))
315 (glColorMaterial (material-face front-and-back) (material-parameter diffuse))
317 (glutGet (glut-state elapsed-time))
320 ; cleanup - calling 'aiReleaseImport' is important, as the library
321 ; keeps internal resources until the scene is freed again. Not
322 ; doing so can cause severe resource leaking.
323 (ai-release-import scene)
325 ; We added a log stream to the library, it's our job to disable it
326 ; again. This will definitely release the last resources allocated
328 (ai-detach-all-log-streams)))
332 (exit (main (program-arguments))))