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/>.
21 (use-modules (assimp assimp)
28 (define main-window #f)
30 ;;; the global Assimp scene object
35 (define scene-center #f)
37 ;;; current rotation angle
38 (define rotation angle 0.0)
41 (define (reshape width height)
42 (let ((aspect-ratio (/ width height))
44 (set-gl-matrix-mode (matrix-mode projection))
46 (glu-perspective field-of-view aspect-ratio 1 1000)
47 (gl-viewport 0 0 width height)))
50 (define (get-bounding-box-for-node nd, vmin, vmax, trafo)
52 (ai-multiply-matrix4 trafo
53 (ai-node-transformation nd))))
55 (let meshes-loop ((meshes (ai-node-meshes nd)))
56 (cond ((not (null? meshes))
57 (let vertices-loop ((vertices (ai-mesh-vertices (list-ref (ai-scene-meshes scene) (car meshes)))))
58 (cond ((not (null? vertices))
61 (ai-transform-vec-by-matrix4 (car vertices) new-trafo)))))
62 (set! vmin (map min vmin tmp))
63 (set! vmax (map max vmax tmp)))
64 (vertices-loop (cdr vertices)))))
65 (meshes-loop (cdr meshes)))))
67 (let nodes-loop ((nodes (ai-node-children nd)))
68 (cond ((not (null? nodes))
69 (let ((res (get-bounding-box-for-node (car nodes) vmin vmax new-trafo)))
71 (set! vmax (cadr res)))
72 (nodes-loop (cdr nodes)))))
77 (define (get-bounding-box)
78 (let ((trafo (ai-identity-matrix4))
79 (vmin '(1e10 1e10 1e10))
80 (vmax '(-1e10 -1e10 -1e10)))
81 (get-bounding-box-for-node (ai-scene-root-node scene) vmin vmax trafo)))
84 (define (color4-to-float4 c)
85 (let ((tmp (ai-color4d-contents c)))
86 (list (assoc-ref tmp 'r)
92 (define (get-material-color material color-type default-color)
95 (let ((color (ai-get-material-color material color-type)))
96 (cond ((ai-color4d? color)
97 (color4-to-float4 color))
102 (define (apply-material mtl)
103 (glMaterialfv (material-face front-and-back)
104 (material-parameter diffuse)
105 (get-material-color mtl (ai-material-key color-diffuse) '(0.8 0.8 0.8 1.0)))
106 (glMaterialfv (material-face front-and-back)
107 (material-parameter specular)
108 (get-material-color mtl (ai-material-key color-specular) '(0.0 0.0 0.0 1.0)))
109 (glMaterialfv (material-face front-and-back)
110 (material-parameter ambient)
111 (get-material-color mtl (ai-material-key color-ambient) '(0.2 0.2 0.2 1.0)))
112 (glMaterialfv (material-face front-and-back)
113 (material-parameter emission)
114 (get-material-color mtl (ai-material-key color-emissive) '(0.0 0.0 0.0 1.0)))
116 (let ((shininess (ai-get-material-float-array mtl (ai-material-key shininess) 1)))
117 (cond ((list? shininess)
118 (let ((strength (ai-get-material-float-array mtl (ai-material-key shininess-strength) 1)))
119 (cond ((list? strength)
120 (glMaterialf (material-face front-and-back)
121 (material-parameter shininess)
122 (* (car shininess) (car strength))))
124 (glMaterialf (material-face front-and-back)
125 (material-parameter shininess)
128 (glMaterialf (material-face front-and-back)
129 (material-parameter shininess)
131 (glMaterialfv (material-face front-and-back)
132 (material-parameter specular)
133 '(0.0 0.0 0.0 0.0)))))
135 (glPolygonMode (material-face front-and-back)
136 (let ((wireframe (ai-get-material-integer-array mtl (ai-material-key enable-wireframe) 1)))
137 (cond ((list? wireframe)
138 (if (> (car wireframe) 0)
142 (mesh-mode-2 fill)))))
144 ((let ((two-sided (ai-get-material-integer-array mtl (ai-material-key twosided) 1)))
145 (if (and (list? two-sided) (> (car two-sided) 0))
148 (enable-cap cull-face)))
151 (define (recursive-render sc nd)
152 (let ((m (ai-transpose-matrix4 (ai-node-transformation nd))))
155 (gl-multiply-matrix (list->array 1 (map cdr (ai-matrix4x4-contents m))))
157 ; draw all meshes assigned to this node
160 (let ((mesh (list-ref (ai-scene-meshes sc) mesh-index)))
161 (apply-material (list-ref (ai-scene-materials sc) (ai-mesh-material-index mesh)))
162 ((if (null? (ai-mesh-normals mesh))
165 (enable-cap lighting))
170 (let ((num-indices (length (ai-face-indices face))))
171 (cond ((= num-indices 1) (begin-mode points))
172 ((= num-indices 2) (begin-mode lines))
173 ((= num-indices 3) (begin-mode triangles))
174 (else (begin-mode polygon))))
177 (if (not (null? (car (ai-mesh-colors mesh))))
182 (list-ref (car (ai-mesh-colors mesh)) index)))))
183 (if (not (null? (ai-mesh-normals mesh)))
184 (glNormal3fv (ai-vector3d-x (list-ref (ai-mesh-normals mesh) index))))
185 (glVertex3fv (ai-vector3d-x (list-ref (ai-mesh-vertices mesh) index))))
186 (ai-face-indices face))))
187 (ai-mesh-faces mesh))))
192 (lambda (node) (recursive-render sc node))
193 (ai-node-children nd)))))
196 (define-glut-state get-elapsed-time elapsed-time)
203 (let ((time (get-elapsed-time)))
204 (set! rotation-angle (+ rotation-angle (* 0.01 (- time prev-time))))
205 (set! prev-time time)
206 (set! frames (1+ frames))
208 (cond ((> (- time prev-fps-time) 1000)
209 (format #t "~a fps~%" (/ (* frames 1000) (- time prev-fps-time)))
211 (set! prev-fps-time time)))
217 (gl-clear (clear-buffer-mask color-buffer depth-buffer))
219 (set-gl-matrix-mode (matrix-mode modelview))
221 (glu-look-at 0 0 3 0 0 -5 0 1 0)
223 ; rotate it around the y axis
224 (gl-rotate rotation-angle 0 1 0)
226 ; scale the whole asset to fit into our view frustum
227 (let ((tmp (apply max (map - scene-max scene-min))))
228 (gl-scale tmp tmp tmp))
231 (apply gl-translate (map - scene-center))
233 ; if the display list has not been made yet, create a new one and
234 ; fill it with scene contents
235 (cond ((= scene-list 0)
236 (set! scene-list (glGenLists 1))
237 (glNewList scene-list (list-mode compile))
238 ; now begin at the root node of the imported data and traverse
239 ; the scenegraph by multiplying subsequent local transforms
240 ; together on GL's matrix stack.
241 (recursive-render scene (ai-scene-root-node scene))
244 (glCallList scene-list)
251 (define (load-asset path)
252 ; we are taking one of the postprocessing presets to avoid
253 ; spelling out 20+ single postprocessing flags here.
254 (set! scene (ai-import-file path ai-process-preset-target-realtime-max-quality))
256 (let ((box (get_bounding_box)))
257 (set! scene-min (car box))
258 (set! scene-max (cadr box))
260 (map (lambda (vmin vmax)
261 (/ (+ vmin vmax) 2.0))
268 (initialize-glut args
269 #:window-size '(900 . 600)
270 #:window-position '(100 . 100)
271 #:display-mode (display-mode rgb double depth))))
272 (set! main-window (make-window "Assimp - Very simple OpenGL sample"))
273 (set-display-callback (lambda () (on-display)))
274 (set-reshape-callback (lambda (w h) (on-reshape w h)))
279 (exit (main (program-arguments))))