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 assimp)
  22              (figl gl)
  23              (figl gl low-level)
  24              (figl glu)
  25              (figl glut))
  26
  27
  28 (define main-window #f)
  29
  30 ;;; the global Assimp scene object
  31 (define scene #f)
  32 (define scene-list 0)
  33 (define scene-min #f)
  34 (define scene-max #f)
  35 (define scene-center #f)
  36
  37 ;;; current rotation angle
  38 (define rotation angle 0.0)
  39
  40
  41 (define (reshape width height)
  42   (let ((aspect-ratio (/ width height))
  43         (field-of-view 45))
  44     (set-gl-matrix-mode (matrix-mode projection))
  45     (gl-load-identity)
  46     (glu-perspective field-of-view aspect-ratio 1 1000)
  47     (gl-viewport 0 0 width height)))
  48
  49
  50 (define (get-bounding-box-for-node nd, vmin, vmax, trafo)
  51   (let ((new-trafo
  52          (ai-multiply-matrix4 trafo
  53                               (ai-node-transformation nd))))
  54
  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))
  59                       (let ((tmp (map cdr
  60                                       (ai-vector3d-contents
  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)))))
  66
  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)))
  70                (set! vmin (car res))
  71                (set! vmax (cadr res)))
  72              (nodes-loop (cdr nodes)))))
  73
  74     (list vmin vmax)))
  75
  76
  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)))
  82
  83
  84 (define (color4-to-float4 c)
  85   (let ((tmp (ai-color4d-contents c)))
  86     (list (assoc-ref tmp 'r)
  87           (assoc-ref tmp 'g)
  88           (assoc-ref tmp 'b)
  89           (assoc-ref tmp 'a))))
  90
  91
  92 (define (get-material-color material color-type default-color)
  93   (make-c-struct
  94    (make-list 4 float)
  95    (let ((color (ai-get-material-color material color-type)))
  96      (cond ((ai-color4d? color)
  97             (color4-to-float4 color))
  98            (else
  99             default-color)))))
 100
 101
 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)))
 115
 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))))
 123                    (else
 124                     (glMaterialf (material-face front-and-back)
 125                                  (material-parameter shininess)
 126                                  (car shininess))))))
 127           (else
 128            (glMaterialf (material-face front-and-back)
 129                         (material-parameter shininess)
 130                         0.0)
 131            (glMaterialfv (material-face front-and-back)
 132                          (material-parameter specular)
 133                          '(0.0 0.0 0.0 0.0)))))
 134
 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)
 139                               (mesh-mode-2 line)
 140                               (mesh-mode-2 fill)))
 141                          (else
 142                           (mesh-mode-2 fill)))))
 143
 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))
 146          gl-disable
 147          gl-enable))
 148    (enable-cap cull-face)))
 149
 150
 151 (define (recursive-render sc nd)
 152   (let ((m (ai-transpose-matrix4 (ai-node-transformation nd))))
 153     (with-gl-push-matrix
 154      ; update transform
 155      (gl-multiply-matrix (list->array 1 (map cdr (ai-matrix4x4-contents m))))
 156
 157      ; draw all meshes assigned to this node
 158      (for-each
 159       (lambda (mesh-index)
 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))
 163                gl-disable
 164                gl-enable)
 165            (enable-cap lighting))
 166
 167           (for-each
 168            (lambda (face)
 169              (gl-begin
 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))))
 175               (for-each
 176                (lambda (index)
 177                  (if (not (null? (car (ai-mesh-colors mesh))))
 178                      (glColor4fv
 179                       (make-c-struct
 180                        (make-list 4 float)
 181                        (color4-to-float4
 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))))
 188       (ai-node-meshes nd))
 189
 190      ; draw all children
 191      (for-each
 192       (lambda (node) (recursive-render sc node))
 193       (ai-node-children nd)))))
 194
 195
 196 (define-glut-state get-elapsed-time elapsed-time)
 197
 198 (define do-motion
 199   (let ((prev-time 0)
 200         (prev_fps_time 0)
 201         (frames 0))
 202     (lambda ()
 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))
 207
 208         (cond ((> (- time prev-fps-time) 1000)
 209                (format #t "~a fps~%" (/ (* frames 1000) (- time prev-fps-time)))
 210                (set! frames 0)
 211                (set! prev-fps-time time)))
 212
 213         (post-redisplay)))))
 214
 215
 216 (define (display)
 217   (gl-clear (clear-buffer-mask color-buffer depth-buffer))
 218
 219   (set-gl-matrix-mode (matrix-mode modelview))
 220   (gl-load-identity)
 221   (glu-look-at 0 0 3 0 0 -5 0 1 0)
 222
 223   ; rotate it around the y axis
 224   (gl-rotate rotation-angle 0 1 0)
 225
 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))
 229
 230   ; center the model
 231   (apply gl-translate (map - scene-center))
 232
 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))
 242          (glEndList)))
 243
 244   (glCallList scene-list)
 245
 246   (swap-buffers)
 247
 248   (do-motion))
 249
 250
 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))
 255
 256   (let ((box (get_bounding_box)))
 257     (set! scene-min (car box))
 258     (set! scene-max (cadr box))
 259     (set! scene-center
 260           (map (lambda (vmin vmax)
 261                  (/ (+ vmin vmax) 2.0))
 262                scene-min
 263                scene-max))))
 264
 265
 266 (define (main args)
 267   (let ((args
 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)))
 275     (glut-main-loop)))
 276
 277
 278 (when (batch-mode?)
 279       (exit (main (program-arguments))))