examples/sample-figl/sample-figl.scm

   1 #!/usr/bin/env guile
   2 !#
   3
   4 ;;; guile-assimp, foreign interface to libassimp
   5 ;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
   6 ;;;
   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.
  11 ;;;
  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.
  16 ;;;
  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/>.
  19
  20
  21 (use-modules (assimp)
  22              (figl gl)
  23              (figl gl low-level)
  24              (figl glu)
  25              (figl glut)
  26              (figl glut low-level)
  27              (system foreign))
  28
  29
  30 (define main-window #f)
  31
  32 ;;; the global Assimp scene object
  33 (define scene #f)
  34 (define scene-list 0)
  35 (define scene-min #f)
  36 (define scene-max #f)
  37 (define scene-center #f)
  38
  39 ;;; current rotation angle
  40 (define rotation-angle 0.0)
  41
  42
  43 (define (on-reshape width height)
  44   (let ((aspect-ratio (/ width height))
  45         (field-of-view 45))
  46     (set-gl-matrix-mode (matrix-mode projection))
  47     (gl-load-identity)
  48     (glu-perspective field-of-view aspect-ratio 1 1000)
  49     (gl-viewport 0 0 width height)))
  50
  51
  52 (define (get-bounding-box-for-node nd vmin vmax trafo)
  53   (let ((new-trafo
  54          (ai-multiply-matrix4 trafo
  55                               (ai-node-transformation nd))))
  56
  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))
  61                       (let ((tmp (map cdr
  62                                       (ai-vector3d-contents
  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)))))
  68
  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)))
  72                (set! vmin (car res))
  73                (set! vmax (cadr res)))
  74              (nodes-loop (cdr nodes)))))
  75
  76     (list vmin vmax)))
  77
  78
  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)))
  84
  85
  86 (define (color4-to-float4 c)
  87   (let ((tmp (ai-color4d-contents c)))
  88     (list (assoc-ref tmp 'r)
  89           (assoc-ref tmp 'g)
  90           (assoc-ref tmp 'b)
  91           (assoc-ref tmp 'a))))
  92
  93
  94 (define (get-material-color material color-type default-color)
  95   (bytevector->pointer
  96    (list->f32vector
  97     (let ((color (ai-get-material-color material color-type)))
  98       (cond ((ai-color4d? color)
  99              (color4-to-float4 color))
 100             (else
 101              default-color))))))
 102
 103
 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)))
 117
 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))))
 125                    (else
 126                     (glMaterialf (material-face front-and-back)
 127                                  (material-parameter shininess)
 128                                  (car shininess))))))
 129           (else
 130            (glMaterialf (material-face front-and-back)
 131                         (material-parameter shininess)
 132                         0.0)
 133            (glMaterialfv (material-face front-and-back)
 134                          (material-parameter specular)
 135                          '(0.0 0.0 0.0 0.0)))))
 136
 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)
 141                               (mesh-mode-2 line)
 142                               (mesh-mode-2 fill)))
 143                          (else
 144                           (mesh-mode-2 fill)))))
 145
 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))
 148          gl-disable
 149          gl-enable))
 150    (enable-cap cull-face)))
 151
 152
 153 (define (recursive-render sc nd)
 154   (let ((m (ai-transpose-matrix4 (ai-node-transformation nd))))
 155     (with-gl-push-matrix
 156      ; update transform
 157      (glMultMatrixf (bytevector->pointer (list->f32vector (map cdr (ai-matrix4x4-contents m)))))
 158
 159      ; draw all meshes assigned to this node
 160      (for-each
 161       (lambda (mesh-index)
 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))
 168                gl-disable
 169                gl-enable)
 170            (enable-cap lighting))
 171
 172           (for-each
 173            (lambda (face)
 174              (gl-begin
 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))))
 180               (for-each
 181                (lambda (index)
 182                  (if (not (null? (car mesh-colors)))
 183                      (glColor4fv
 184                       (bytevector->pointer
 185                        (list->f32vector
 186                         (color4-to-float4
 187                          (list-ref (car mesh-colors) index))))))
 188                  (if (not (null? mesh-normals))
 189                      (glNormal3fv
 190                       (bytevector->pointer
 191                        (list->f32vector
 192                         (map cdr (ai-vector3d-contents (list-ref mesh-normals index)))))))
 193                  (glVertex3fv
 194                   (bytevector->pointer
 195                    (list->f32vector
 196                     (map cdr (ai-vector3d-contents (list-ref mesh-vertices index)))))))
 197                (ai-face-indices face))))
 198            (ai-mesh-faces mesh))))
 199       (ai-node-meshes nd))
 200
 201      ; draw all children
 202      (for-each
 203       (lambda (node) (recursive-render sc node))
 204       (ai-node-children nd)))))
 205
 206
 207 (define do-motion
 208   (let ((prev-time 0)
 209         (prev-fps-time 0)
 210         (frames 0))
 211     (lambda ()
 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))
 216
 217         (cond ((> (- time prev-fps-time) 1000)
 218                (format #t "~a fps~%" (/ (* frames 1000.0) (- time prev-fps-time)))
 219                (set! frames 0)
 220                (set! prev-fps-time time)))
 221
 222         (post-redisplay)))))
 223
 224
 225 (define (on-display)
 226   (gl-clear (clear-buffer-mask color-buffer depth-buffer))
 227
 228   (set-gl-matrix-mode (matrix-mode modelview))
 229   (gl-load-identity)
 230   (glu-look-at 0.0 0.0 3.0 0.0 0.0 -5.0 0.0 1.0 0.0)
 231
 232   ; rotate it around the y axis
 233   (gl-rotate rotation-angle 0.0 1.0 0.0)
 234
 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))
 238
 239   ; center the model
 240   (apply gl-translate (map - scene-center))
 241
 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))
 251          (glEndList)))
 252
 253   (glCallList scene-list)
 254
 255   (swap-buffers)
 256
 257   (do-motion))
 258
 259
 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))
 264
 265   (let ((box (get-bounding-box)))
 266     (set! scene-min (car box))
 267     (set! scene-max (cadr box))
 268     (set! scene-center
 269           (map (lambda (vmin vmax)
 270                  (/ (+ vmin vmax) 2.0))
 271                scene-min
 272                scene-max))))
 273
 274
 275 (define (main args)
 276   (let ((args
 277          (initialize-glut args
 278                           #:window-size '(900 . 600)
 279                           #:window-position '(100 . 100)
 280                           #:display-mode (display-mode rgb double depth))))
 281
 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)))
 285
 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))
 290
 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")
 294
 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))
 300
 301     (set-gl-clear-color 0.1 0.1 0.1 1.0)
 302
 303     (gl-enable (enable-cap lighting))
 304     (gl-enable (enable-cap light0))     ; Uses default lighting parameters
 305
 306     (gl-enable (enable-cap depth-test))
 307
 308     (glLightModeli (light-model-parameter light-model-two-side) (boolean true))
 309     (gl-enable (enable-cap normalize))
 310
 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))))
 314
 315     (glColorMaterial (material-face front-and-back) (material-parameter diffuse))
 316
 317     (glutGet (glut-state elapsed-time))
 318     (glut-main-loop)
 319
 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)
 324
 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
 327     ; by Assimp.
 328     (ai-detach-all-log-streams)))
 329
 330
 331 (when (batch-mode?)
 332       (exit (main (program-arguments))))