X-Git-Url: https://git.jsancho.org/?p=guile-assimp.git;a=blobdiff_plain;f=src%2Fassimp.scm;fp=src%2Fassimp.scm;h=03c9b331517be8a07599ad9c1830451aeecf1a98;hp=874330ff630fe4cee050e3398087596402098c9a;hb=ebdf468033662662f62674baf9bfa915e6f6a262;hpb=ef3e935778bfa89faa1b597180e0ec5d2986784b

diff --git a/src/assimp.scm b/src/assimp.scm
index 874330f..03c9b33 100644
--- 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)