Rewrite definition types using new C parsers

[guile-assimp.git] / src / assimp.scm

diff --git a/src/assimp.scm b/src/assimp.scm
index 874330ff630fe4cee050e3398087596402098c9a..03c9b331517be8a07599ad9c1830451aeecf1a98 100644 (file)
--- a/src/assimp.scm
+++ b/src/assimp.scm
@@ -16,6 +16,8 @@
 
 
 (define-module (assimp assimp)
+  #:use-module (assimp low-level material)
+  #:use-module (assimp low-level mesh)
   #:use-module (assimp low-level scene)
   #:use-module (ice-9 iconv)
   #:use-module (rnrs bytevectors)
@@ -174,16 +176,22 @@
   (lambda (alist)
     (assoc-ref alist name)))
 
-(define (array size-tag root-tag)
+(define (get-element-address root-pointer offset)
+  (make-pointer (+ (pointer-address root-pointer) offset)))
+
+(define* (array size-tag root-tag #:key (element-size 4) (element-proc bv-uint-ref))
   (lambda (alist)
     (let ((size (assoc-ref alist size-tag))
          (root (assoc-ref alist root-tag)))
-      (let loop ((i 0))
-       (cond ((= i size)
-              '())
-             (else
-              (cons (bv-uint-ref root (* 4 i))
-                    (loop (+ i 1)))))))))
+      (cond ((= (pointer-address root) 0)
+            '())
+           (else
+            (let loop ((i 0))
+              (cond ((= i size)
+                     '())
+                    (else
+                     (cons (element-proc root (* element-size i))
+                           (loop (+ i 1)))))))))))
 
 (define (wrap proc wrap-proc)
   (define (make-wrap element)
@@ -268,39 +276,54 @@
 
 ;;; Meshes
 
-(define AI_MAX_NUMBER_OF_COLOR_SETS 8)
-
-(define-type mesh
-  (num-primitive-types (lambda (p) (bv-uint-ref p 0)))
-  (vertices (get-pointer-of-pointers 4 12))
-  (faces (get-structs-array 8 124 8 wrap-face))
-  (normals (lambda (p) (bv-uint-ref p 16)))
-  (tangents (lambda (p) (bv-uint-ref p 20)))
-  (bitangents (lambda (p) (bv-uint-ref p 24)))
-  (colors (lambda (p) (bv-uint-ref p 28))) ;AI_MAX_NUMBER_OF_COLOR_SETS
-  (texture-coords (lambda (p) (bv-uint-ref p 60))) ;AI_MAX_NUMBER_OF_TEXTURECOORDS
-  (num-uv-components (lambda (p) (bv-uint-ref p 92))) ;AI_MAX_NUMBER_OF_TEXTURECOORDS
-  (bones (get-pointer-of-pointers 128 132))
-  (material-index (lambda (p) (bv-uint-ref p 136))))
+(define-conversion-type parse-aiMesh -> mesh
+  (name (sized-string 'mName))
+  (primitive-types (field 'mPrimitiveTypes))
+  (vertices (array 'mNumVertices 'mVertices #:element-proc get-element-address))
+  (faces (wrap (array 'mNumFaces 'mFaces #:element-size 8 #:element-proc get-element-address) wrap-face))
+  (normals (array 'mNumVertices 'mNormals #:element-size 12 #:element-proc get-element-address))
+  (tangents (array 'mNumVertices 'mTangents #:element-size 12 #:element-proc get-element-address))
+  (bitangents (array 'mNumVertices 'mBitangents #:element-size 12 #:element-proc get-element-address))
+  (colors (field 'mColors))
+  (texture-coords (field 'mTextureCoords))
+  (num-uv-components (field 'mNumUVComponents))
+  (bones (array 'mNumBones 'mBones))
+  (material-index (field 'mMaterialIndex))
+)
 
 (export mesh?
-       mesh-contents)
+       mesh-contents
+       mesh-name
+       mesh-primitive-types
+       mesh-vertices
+       mesh-faces
+       mesh-normals
+       mesh-tangents
+       mesh-bitangents
+       mesh-colors
+       mesh-texture-coords
+       mesh-num-uv-components
+       mesh-bones
+       mesh-material-index)
 
 
 ;;; Materials
 
-(define-type material
-  (properties (get-pointer-of-pointers 4 0))
-  (allocated (lambda (p) (bv-uint-ref p 8))))
+(define-conversion-type parse-aiMaterial -> material
+  (properties (array 'mNumProperties 'mProperties))
+  (num-allocated (field 'mNumAllocated)))
 
 (export material?
-       material-contents)
+       material-contents
+       material-properties
+       material-num-allocated)
 
 
 ;;; Faces
 
-(define-type face
-  (indices (get-array 0 4 'u32)))
+(define-conversion-type parse-aiFace -> face
+  (indices (array 'mNumIndices 'mIndices)))
 
 (export face?
-       face-contents)
+       face-contents
+       face-indices)