--- /dev/null
+#!/usr/bin/env guile
+!#
+
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(use-modules (assimp assimp)
+ (figl gl)
+ (figl gl low-level)
+ (figl glu)
+ (figl glut))
+
+
+(define main-window #f)
+
+;;; the global Assimp scene object
+(define scene #f)
+(define scene-list 0)
+(define scene-min #f)
+(define scene-max #f)
+(define scene-center #f)
+
+;;; current rotation angle
+(define rotation angle 0.0)
+
+
+(define (reshape width height)
+ (let ((aspect-ratio (/ width height))
+ (field-of-view 45))
+ (set-gl-matrix-mode (matrix-mode projection))
+ (gl-load-identity)
+ (glu-perspective field-of-view aspect-ratio 1 1000)
+ (gl-viewport 0 0 width height)))
+
+
+(define (get-bounding-box-for-node nd, vmin, vmax, trafo)
+ (let ((new-trafo
+ (ai-multiply-matrix4 trafo
+ (ai-node-transformation nd))))
+
+ (let meshes-loop ((meshes (ai-node-meshes nd)))
+ (cond ((not (null? meshes))
+ (let vertices-loop ((vertices (ai-mesh-vertices (list-ref (ai-scene-meshes scene) (car meshes)))))
+ (cond ((not (null? vertices))
+ (let ((tmp (map cdr
+ (ai-vector3d-contents
+ (ai-transform-vec-by-matrix4 (car vertices) new-trafo)))))
+ (set! vmin (map min vmin tmp))
+ (set! vmax (map max vmax tmp)))
+ (vertices-loop (cdr vertices)))))
+ (meshes-loop (cdr meshes)))))
+
+ (let nodes-loop ((nodes (ai-node-children nd)))
+ (cond ((not (null? nodes))
+ (let ((res (get-bounding-box-for-node (car nodes) vmin vmax new-trafo)))
+ (set! vmin (car res))
+ (set! vmax (cadr res)))
+ (nodes-loop (cdr nodes)))))
+
+ (list vmin vmax)))
+
+
+(define (get-bounding-box)
+ (let ((trafo (ai-identity-matrix4))
+ (vmin '(1e10 1e10 1e10))
+ (vmax '(-1e10 -1e10 -1e10)))
+ (get-bounding-box-for-node (ai-scene-root-node scene) vmin vmax trafo)))
+
+
+(define (color4-to-float4 c)
+ (let ((tmp (ai-color4d-contents c)))
+ (list (assoc-ref tmp 'r)
+ (assoc-ref tmp 'g)
+ (assoc-ref tmp 'b)
+ (assoc-ref tmp 'a))))
+
+
+(define (get-material-color material color-type default-color)
+ (make-c-struct
+ (make-list 4 float)
+ (let ((color (ai-get-material-color material color-type)))
+ (cond ((ai-color4d? color)
+ (color4-to-float4 color))
+ (else
+ default-color)))))
+
+
+(define (apply-material mtl)
+ (glMaterialfv (material-face front-and-back)
+ (material-parameter diffuse)
+ (get-material-color mtl (ai-material-key color-diffuse) '(0.8 0.8 0.8 1.0)))
+ (glMaterialfv (material-face front-and-back)
+ (material-parameter specular)
+ (get-material-color mtl (ai-material-key color-specular) '(0.0 0.0 0.0 1.0)))
+ (glMaterialfv (material-face front-and-back)
+ (material-parameter ambient)
+ (get-material-color mtl (ai-material-key color-ambient) '(0.2 0.2 0.2 1.0)))
+ (glMaterialfv (material-face front-and-back)
+ (material-parameter emission)
+ (get-material-color mtl (ai-material-key color-emissive) '(0.0 0.0 0.0 1.0)))
+
+ (let ((shininess (ai-get-material-float-array mtl (ai-material-key shininess) 1)))
+ (cond ((list? shininess)
+ (let ((strength (ai-get-material-float-array mtl (ai-material-key shininess-strength) 1)))
+ (cond ((list? strength)
+ (glMaterialf (material-face front-and-back)
+ (material-parameter shininess)
+ (* (car shininess) (car strength))))
+ (else
+ (glMaterialf (material-face front-and-back)
+ (material-parameter shininess)
+ (car shininess))))))
+ (else
+ (glMaterialf (material-face front-and-back)
+ (material-parameter shininess)
+ 0.0)
+ (glMaterialfv (material-face front-and-back)
+ (material-parameter specular)
+ '(0.0 0.0 0.0 0.0)))))
+
+ (glPolygonMode (material-face front-and-back)
+ (let ((wireframe (ai-get-material-integer-array mtl (ai-material-key enable-wireframe) 1)))
+ (cond ((list? wireframe)
+ (if (> (car wireframe) 0)
+ (mesh-mode-2 line)
+ (mesh-mode-2 fill)))
+ (else
+ (mesh-mode-2 fill)))))
+
+ ((let ((two-sided (ai-get-material-integer-array mtl (ai-material-key twosided) 1)))
+ (if (and (list? two-sided) (> (car two-sided) 0))
+ gl-disable
+ gl-enable))
+ (enable-cap cull-face)))
+
+
+(define (recursive-render sc nd)
+ (let ((m (ai-transpose-matrix4 (ai-node-transformation nd))))
+ (with-gl-push-matrix
+ ; update transform
+ (gl-multiply-matrix (list->array 1 (map cdr (ai-matrix4x4-contents m))))
+
+ ; draw all meshes assigned to this node
+ (for-each
+ (lambda (mesh-index)
+ (let ((mesh (list-ref (ai-scene-meshes sc) mesh-index)))
+ (apply-material (list-ref (ai-scene-materials sc) (ai-mesh-material-index mesh)))
+ ((if (null? (ai-mesh-normals mesh))
+ gl-disable
+ gl-enable)
+ (enable-cap lighting))
+
+ (for-each
+ (lambda (face)
+ (gl-begin
+ (let ((num-indices (length (ai-face-indices face))))
+ (cond ((= num-indices 1) (begin-mode points))
+ ((= num-indices 2) (begin-mode lines))
+ ((= num-indices 3) (begin-mode triangles))
+ (else (begin-mode polygon))))
+ (for-each
+ (lambda (index)
+ (if (not (null? (car (ai-mesh-colors mesh))))
+ (glColor4fv
+ (make-c-struct
+ (make-list 4 float)
+ (color4-to-float4
+ (list-ref (car (ai-mesh-colors mesh)) index)))))
+ (if (not (null? (ai-mesh-normals mesh)))
+ (glNormal3fv (ai-vector3d-x (list-ref (ai-mesh-normals mesh) index))))
+ (glVertex3fv (ai-vector3d-x (list-ref (ai-mesh-vertices mesh) index))))
+ (ai-face-indices face))))
+ (ai-mesh-faces mesh))))
+ (ai-node-meshes nd))
+
+ ; draw all children
+ (for-each
+ (lambda (node) (recursive-render sc node))
+ (ai-node-children nd)))))
+
+
+(define-glut-state get-elapsed-time elapsed-time)
+
+(define do-motion
+ (let ((prev-time 0)
+ (prev_fps_time 0)
+ (frames 0))
+ (lambda ()
+ (let ((time (get-elapsed-time)))
+ (set! rotation-angle (+ rotation-angle (* 0.01 (- time prev-time))))
+ (set! prev-time time)
+ (set! frames (1+ frames))
+
+ (cond ((> (- time prev-fps-time) 1000)
+ (format #t "~a fps~%" (/ (* frames 1000) (- time prev-fps-time)))
+ (set! frames 0)
+ (set! prev-fps-time time)))
+
+ (post-redisplay)))))
+
+
+(define (display)
+ (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+
+ (set-gl-matrix-mode (matrix-mode modelview))
+ (gl-load-identity)
+ (glu-look-at 0 0 3 0 0 -5 0 1 0)
+
+ ; rotate it around the y axis
+ (gl-rotate rotation-angle 0 1 0)
+
+ ; scale the whole asset to fit into our view frustum
+ (let ((tmp (apply max (map - scene-max scene-min))))
+ (gl-scale tmp tmp tmp))
+
+ ; center the model
+ (apply gl-translate (map - scene-center))
+
+ ; if the display list has not been made yet, create a new one and
+ ; fill it with scene contents
+ (cond ((= scene-list 0)
+ (set! scene-list (glGenLists 1))
+ (glNewList scene-list (list-mode compile))
+ ; now begin at the root node of the imported data and traverse
+ ; the scenegraph by multiplying subsequent local transforms
+ ; together on GL's matrix stack.
+ (recursive-render scene (ai-scene-root-node scene))
+ (glEndList)))
+
+ (glCallList scene-list)
+
+ (swap-buffers)
+
+ (do-motion))
+
+
+(define (load-asset path)
+ ; we are taking one of the postprocessing presets to avoid
+ ; spelling out 20+ single postprocessing flags here.
+ (set! scene (ai-import-file path ai-process-preset-target-realtime-max-quality))
+
+ (let ((box (get_bounding_box)))
+ (set! scene-min (car box))
+ (set! scene-max (cadr box))
+ (set! scene-center
+ (map (lambda (vmin vmax)
+ (/ (+ vmin vmax) 2.0))
+ scene-min
+ scene-max))))
+
+
+(define (main args)
+ (let ((args
+ (initialize-glut args
+ #:window-size '(900 . 600)
+ #:window-position '(100 . 100)
+ #:display-mode (display-mode rgb double depth))))
+ (set! main-window (make-window "Assimp - Very simple OpenGL sample"))
+ (set-display-callback (lambda () (on-display)))
+ (set-reshape-callback (lambda (w h) (on-reshape w h)))
+ (glut-main-loop)))
+
+
+(when (batch-mode?)
+ (exit (main (program-arguments))))
projects / guile-assimp.git / commitdiff