Pbr

app.scm

@@ -6,20 +6,20 @@
 ;;   (export run))
 (import (chezscheme)
 	(vulkan)
-	(matchable))
+	(matchable)
+	(prelude))
+
 
 ;; (define run
 ;;   (lambda ()))
 (let ((state (setup-vulkan))
       (shaders (make-shaders "shaders/shader.vert" "shaders/shader.frag")))
-  (match-let* (((vertex-input-metadata . pipeline)
-		(create-pipeline state
-				 shaders
-				 "models/sampleroom.dae"))
-	       ((uniform-buffers . command-buffers) (create-buffers state
-								    vertex-input-metadata
-								    pipeline)))
-    (run-draw-loop state uniform-buffers command-buffers)))
+  (displayln "creating pipeline")
+  (match-let* (((pipeline vertex-input-metadata render-pass)
+		(create-pipeline state shaders "models/sampleroom.dae"))	       
+	       ((command-buffers uniform-buffers camera-matrix)
+		(create-buffers state pipeline vertex-input-metadata render-pass)))
+    (run-draw-loop state uniform-buffers command-buffers camera-matrix)))
 
 ;; (parameterize ([optimize-level 3]
 ;; 	       [debug-level 0])

assimp.scm

@@ -1,4 +1,3 @@
-;;
 ;; ffi bindings for assimp
 ;;
 
@@ -106,10 +105,10 @@
 
 (define-ftype aabb
   (struct (min vector3)
-	  (max vector3)))
+    (max vector3)))
 
 ;; // -------------------------------------------------------------------------------
-;; /** 
+;; /**
 ;; * A node in the imported hierarchy.
 ;; *
 ;; * Each node has name, a parent node (except for the root node),
@@ -201,8 +200,9 @@
 
 
 ;; load library
-
-(define o (load-shared-object "libassimp.so.5.0.0"))
+(define o (load-shared-library (make-library-detail #f 
+                                                    "libassimp.so.5.0.0" 
+                                                    "phoenix-libs/assimp-vc142-mtd.dll")))
 
 ;; define native functions
 
@@ -223,47 +223,47 @@
 (define (mesh-ptr->vertex-buffer-data mesh-ptr)
   (let* ((num-vertices (mesh-num-vertices mesh-ptr))
 
-	 (vertices
-	  (map flip-vertices
-	       (vector3-array-ptr->list (make-array-pointer num-vertices
-							    (mesh-vertices mesh-ptr)
-							    'vector3))))
-	 (normals
-	  (vector3-array-ptr->list (make-array-pointer num-vertices
-						       (mesh-normals mesh-ptr)
-						       'vector3)))
-
-	 ;; Texture coordinates may have multiple channels, we only use the first we find
-	 (texture-coords-channel
-	  (find (lambda (ptr)
-		  (not (ftype-pointer-null? ptr))) (mesh-texture-coords mesh-ptr)))
-	 
-	 (texture-coords
-	  (map (lambda (uv-coords)
-		 (cond
-		  ((list? uv-coords) (list (car uv-coords) (cadr uv-coords)))
-		  (else (error "uv channels are missing"  mesh-ptr))))
-	       (vector3-array-ptr->list (make-array-pointer num-vertices
-							    texture-coords-channel
-							    'vector3)))))
+         (vertices
+          (map flip-vertices
+               (vector3-array-ptr->list (make-array-pointer num-vertices
+                                         (mesh-vertices mesh-ptr)
+                                         'vector3))))
+         (normals
+          (vector3-array-ptr->list (make-array-pointer num-vertices
+                                    (mesh-normals mesh-ptr)
+                                    'vector3)))
+
+   ;; Texture coordinates may have multiple channels, we only use the first we find
+         (texture-coords-channel
+          (find (lambda (ptr)
+                 (not (ftype-pointer-null? ptr))) (mesh-texture-coords mesh-ptr)))
+
+         (texture-coords
+          (map (lambda (uv-coords)
+                (cond
+                 ((list? uv-coords) (list (car uv-coords) (cadr uv-coords)))
+                 (else (error "uv channels are missing"  mesh-ptr))))
+               (vector3-array-ptr->list (make-array-pointer num-vertices
+                                         texture-coords-channel
+                                         'vector3)))))
     (displayln "vertices are number: " num-vertices)
     (make-vertex-buffer-data vertices normals texture-coords #f)))
 
 (define concatenate (lambda (xs) (apply append xs)))
 
 ;; data for index buffer
 (define mesh-ptr->indices
-  (lambda (mesh-ptr vertex-offset)     
+  (lambda (mesh-ptr vertex-offset)
     (displayln "num of faces is " (mesh-num-faces mesh-ptr))
     (concatenate (face-pointer-map
-		  (lambda (face-ptr)
-		    (unsigned-pointer-map (lambda (x) (+ vertex-offset (read-unsigned x)))
-					  (make-array-pointer (face-num-indices face-ptr)
-							      (face-indices face-ptr)
-							      'unsigned)))
-		  (make-array-pointer (mesh-num-faces mesh-ptr)
-				      (mesh-faces mesh-ptr)
-				      'face)))))
+                  (lambda (face-ptr)
+                    (unsigned-pointer-map (lambda (x) (+ vertex-offset (read-unsigned x)))
+                        (make-array-pointer (face-num-indices face-ptr)
+                                (face-indices face-ptr)
+                                'unsigned)))
+                  (make-array-pointer (mesh-num-faces mesh-ptr)
+                          (mesh-faces mesh-ptr)
+                          'face)))))
 
 
 ;; record to collect the data required from assimp
@@ -287,55 +287,55 @@
 
     (define mesh-ptr->model-data
       (lambda (mesh-ptr vertex-offset)
-	(let ((vertex-data (mesh-ptr->vertex-buffer-data mesh-ptr))
-	      (indices (mesh-ptr->indices mesh-ptr vertex-offset)))
-	  (make-model-data vertex-data indices))))
+       (let ((vertex-data (mesh-ptr->vertex-buffer-data mesh-ptr))
+             (indices (mesh-ptr->indices mesh-ptr vertex-offset)))
+         (make-model-data vertex-data indices))))
 
     (define mesh-indices->model-data
       (lambda (mesh-indices mesh-list vertex-offset)
-	(unsigned-pointer-map (lambda (mesh-index)
-				(mesh-ptr->model-data (list-ref mesh-list
-								(read-unsigned mesh-index))
-						      vertex-offset))
-			      mesh-indices)))
+       (unsigned-pointer-map (lambda (mesh-index)
+                              (mesh-ptr->model-data (list-ref mesh-list
+                                                     (read-unsigned mesh-index))
+                                        vertex-offset))
+                 mesh-indices)))
 
     (define process-node
       (lambda (node-ptr meshes-list collected-mesh-data)
-	(let* ((num-meshes (node-num-meshes node-ptr))
-	       (mesh-indices (make-array-pointer num-meshes (node-meshes node-ptr) 'unsigned))
-	       (num-children (node-num-children node-ptr))
-	       (child-nodes (double-pointer->list (node-children node-ptr)
-						  node
-						  num-children))
-	       (vertex-offset (fold-left (lambda (offset model-data)
-					   (+ offset
-					      (length (vertex-buffer-data-vertices
-						       (model-data-vertex-data model-data)))))
-					 0
-					 collected-mesh-data)))
-	  (let ((current-mesh-data (mesh-indices->model-data mesh-indices
-							     meshes-list
-							     vertex-offset)))
-	    (fold-left (lambda (data child-node-ptr)
-			 (process-node child-node-ptr meshes-list data))
-		       (append collected-mesh-data current-mesh-data)
-		       child-nodes)))))
-    
+       (let* ((num-meshes (node-num-meshes node-ptr))
+              (mesh-indices (make-array-pointer num-meshes (node-meshes node-ptr) 'unsigned))
+              (num-children (node-num-children node-ptr))
+              (child-nodes (double-pointer->list (node-children node-ptr)
+                            node
+                            num-children))
+              (vertex-offset (fold-left (lambda (offset model-data)
+                                         (+ offset
+                                            (length (vertex-buffer-data-vertices
+                                                     (model-data-vertex-data model-data)))))
+                              0
+                              collected-mesh-data)))
+         (let ((current-mesh-data (mesh-indices->model-data mesh-indices
+                                   meshes-list
+                                   vertex-offset)))
+           (fold-left (lambda (data child-node-ptr)
+                       (process-node child-node-ptr meshes-list data))
+                (append collected-mesh-data current-mesh-data)
+                child-nodes)))))
+
     (let* ((scene-ptr (import_file model
-				   (bitwise-ior pretransform-vertices
-						triangulate
-						gen-normals)))
-	   (meshes-list (double-pointer->list (scene-meshes scene-ptr)
-					      mesh
-					      (scene-num-meshes scene-ptr))))
+                       (bitwise-ior pretransform-vertices
+                        triangulate
+                        gen-normals)))
+           (meshes-list (double-pointer->list (scene-meshes scene-ptr)
+                         mesh
+                         (scene-num-meshes scene-ptr))))
       (displayln "scene meshes " (scene-num-meshes scene-ptr))
       (process-node (scene-root-node scene-ptr) meshes-list (list)))))
 
 ;; Example usage:
 
 ;; > (load "assimp.scm")
 ;; > (import (assimp))
-(define model-file "models/sampleroom.dae")
+(define model-file "models/cube.dae")
 (define model-data-obj (import-model model-file))
 ;; (define model-data-obj (import-model "models/cube.obj"))
 ;; (define model-data-obj (import-model "models/Sponza-master/sponza.obj"))

assimp.sls

@@ -11,7 +11,7 @@
 	  model-data-vertex-data
 	  model-data-indices)
   (import (chezscheme)
-	  (ffi)
-	  (prelude))
+		  (ffi)
+		  (prelude))
 
   (include "assimp.scm"))

camera.scm

@@ -32,7 +32,8 @@
   (define vector->list
     (lambda (vector)
       (match vector
-	(($ vector4 x y z w) (list x y z w)))))
+	(($ vector4 x y z w) (list x y z w))
+	(($ vector3 x y z)   (list x y z)))))
 
   (define matrix->list
     (lambda (matrix)
@@ -149,15 +150,15 @@
 		    (make-vector4 0.0 0.0 1.0 0.0)
 		    (make-vector4 0.0 0.0 0.0 1.0))))
 
-  (define test-matrix  (make-matrix4 (make-vector4 1 2 3 4)
-  				     (make-vector4 1 2 3 4)
-  				     (make-vector4 1 2 3 4)
-  				     (make-vector4 1 2 3 4)))
+  (define test-matrix  (make-matrix4 (make-vector4 1.0 2.0 3.0 4.0)
+  				     (make-vector4 1.0 2.0 3.0 4.0)
+  				     (make-vector4 1.0 2.0 3.0 4.0)
+  				     (make-vector4 1.0 2.0 3.0 4.0)))
 
-  ;; (define matrix4-identity (make-matrix4 (make-vector4 1 0 0 0)
-  ;; 					 (make-vector4 0 1 0 0)
-  ;; 					 (make-vector4 0 0 1 0)
-  ;; 					 (make-vector4 0 0 0 1)))
+  (define matrix4-identity (make-matrix4 (make-vector4 1 0 0 0)
+  					 (make-vector4 0 1 0 0)
+  					 (make-vector4 0 0 1 0)
+  					 (make-vector4 0 0 0 1)))
 
   ;; (display-matrix test-matrix)
 
@@ -293,8 +294,9 @@
   (define mvp-matrix->list
     (lambda (mvp-matrix-obj)
       (match mvp-matrix-obj
-	(($ mvp-matrix model view projection)
-	 (apply append (map matrix->list (list model view projection)))))))
+	(($ mvp-matrix model view projection eye)
+	 (append (apply append (map matrix->list (list model view projection)))
+		 (vector->list eye))))))
 
   (define up (make-vector3 0.0 1.0 0.0))
 
@@ -369,13 +371,10 @@
 
       (match current-matrix
 	(($ mvp-matrix model view projection eye center)
-	 (let ((eye (car (update-eye-center eye-position center))))
-	   (let ((view (update-view-matrix eye camera-rotation)))
-	     (cons (make-mvp-matrix model
-				    view
-				    projection
-				    eye
-				    center) eye))))))))
+	 (let* ((eye (car (update-eye-center eye-position center)))
+		(view (update-view-matrix eye camera-rotation)))
+	   (cons (make-mvp-matrix model view projection eye center)
+		 eye)))))))
 
 
 #|

ffi.scm

@@ -27,16 +27,17 @@
 	  array-pointer-raw-ptr
 	  array-pointer-empty?
 	  array-pointer?
+	  new-array-pointer
 	  with-new-array-pointer
 	  pointer-ref-value
 	  pointer-ref-ftype
 
 	  double-pointer->list)
 
   (import (chezscheme)
-	  (prelude))
+	  	  (prelude))
 
-  (define libc (load-shared-object "libc.so.6"))
+  (define libc (load-shared-library (make-library-detail #f "libc.so.6" "msvcrt.dll")))
 
   (define memcpy
     (foreign-procedure "memcpy" (uptr uptr size_t) void))
@@ -150,7 +151,11 @@
 			   strs)))))))))
 
 
-  (define strdup (foreign-procedure "strdup" (string) string))
+  (define strdup 
+	(let ((proc-name (cond 
+					 	((foreign-entry? "strdup") "strdup")
+						((foreign-entry? "_strdup") "_strdup"))))
+	  (foreign-procedure proc-name (string) string)))
 
   (define-syntax write-cstring
     (syntax-rules ()
@@ -177,8 +182,11 @@
 
   (define-syntax make-foreign-array
     (syntax-rules ()
-      ((_ struct size) (make-ftype-pointer struct (unbox (malloc (* size
-								    (ftype-sizeof struct))))))))
+      ((_ struct size) (make-ftype-pointer struct
+					   (if (equal? size 0)
+					       0
+					       (unbox (malloc (* size
+								 (ftype-sizeof struct)))))))))
 
   (define-syntax pointer-ref-value
     (syntax-rules ()
@@ -234,6 +242,15 @@
 
   (define-record-type array-pointer (fields length raw-ptr type) (nongenerative))
 
+
+  (define-syntax new-array-pointer
+    (syntax-rules ()
+      ((_ pointer-type count)
+       (make-array-pointer count
+			   (make-foreign-array pointer-type count)
+			   pointer-type))))
+
+  ;; notice: this should not be here belongs somewhere inside vulkan library
   ;; this function covers a general pattern for vulkan functions to return an array
   ;; the f provided will be called two times:
   ;; once for the value of count and then
@@ -282,10 +299,10 @@
 
 		      (else (lp (fx+ 1 i)
 				(cons (and (array-pointer-raw-ptr arr-ptr)
-					 (f (ftype-&ref pointer-type
-							()
-							(array-pointer-raw-ptr arr-ptr)
-							i)))
+					   (f (ftype-&ref pointer-type
+							  ()
+							  (array-pointer-raw-ptr arr-ptr)
+							  i)))
 				      xs)))))))
 
 	       (define find-lambda