render: model: Load diffuse, specular, bump textures in .mtl files.

1 files changed, 111 insertions, 32 deletions

diff --git a/chickadee/render/model.scm b/chickadee/render/model.scm
index cf8b917..ec2246b 100644
--- a/chickadee/render/model.scm
+++ b/chickadee/render/model.scm
@@ -168,18 +168,22 @@
   (%make-model name scenes default-scene render-state))
 
 (define (draw-model model model-matrix view-matrix)
-  ;; TODO: Support drawing non-default scenes.
-  (let ((state (model-render-state model)))
-    (render-state-reset! state)
-    (render-state-view-matrix-mult! state view-matrix)
-    (render-state-world-matrix-mult! state model-matrix)
-    (draw-scene-node (model-default-scene model) state)))
+  (with-depth-test #t
+    (let ((state (model-render-state model)))
+     (render-state-reset! state)
+     (render-state-view-matrix-mult! state view-matrix)
+     (render-state-world-matrix-mult! state model-matrix)
+     ;; TODO: Support drawing non-default scenes.
+     (draw-scene-node (model-default-scene model) state))))
 
 
 ;;;
 ;;; OBJ Format
 ;;;
 
+;; Reference documentation:
+;;   * http://paulbourke.net/dataformats/obj
+;;   * http://paulbourke.net/dataformats/mtl
 (define (load-obj file-name)
   (define (scope-file other-file)
     (string-append (dirname file-name) "/" other-file))
@@ -192,64 +196,139 @@
             (face-map (make-hash-table))
             (face-indices-map (make-hash-table))
             (material-map (make-hash-table)))
+        (define (parse-map-args args)
+          (define (map-option? str)
+            (string-prefix? "-" str))
+          (let loop ((args args)
+                     (opts '()))
+            (match args
+              (() opts)
+              (((? map-option? opt) arg . rest)
+               (loop rest
+                     (cons (cons (string->symbol
+                                  (substring opt 1))
+                                 arg)
+                           opts)))
+              ((file-name . rest)
+               (loop rest (cons (cons 'file-name file-name) opts))))))
         (define (load-mtl mtl-file-name)
+          (define (scope-file other-file)
+            (string-append (dirname mtl-file-name) "/" other-file))
           (call-with-input-file mtl-file-name
             (lambda (port)
-              (let loop ((name #f)
-                         (ambient #f)
-                         (diffuse #f)
-                         (specular #f)
-                         (shininess #f))
+              (let loop ((opts '()))
                 (define (maybe-add-material)
-                  (when name
-                    (hash-set! material-map
-                               name
-                               (make-phong-material
-                                #:name name
-                                #:ambient ambient
-                                #:diffuse diffuse
-                                #:specular specular
-                                #:shininess shininess))))
+                  (let ((name (assq-ref opts 'name)))
+                    (when name
+                      (hash-set! material-map
+                                 name
+                                 (make-phong-material
+                                  #:name name
+                                  #:ambient (assq-ref opts 'ambient)
+                                  #:diffuse (assq-ref opts 'diffuse)
+                                  #:diffuse-map (assq-ref opts 'diffuse-map)
+                                  #:use-diffuse-map
+                                  (assq-ref opts 'use-diffuse-map?)
+                                  #:specular (assq-ref opts 'specular)
+                                  #:specular-map (assq-ref opts 'specular-map)
+                                  #:use-specular-map
+                                  (assq-ref opts 'use-specular-map?)
+                                  #:shininess (assq-ref opts 'shininess)
+                                  #:bump-map (assq-ref opts 'bump-map)
+                                  #:use-bump-map
+                                  (assq-ref opts 'use-bump-map?))))))
                 (match (read-line port)
                   ((? eof-object?)
                    (maybe-add-material))
                   (line
                    (match (delete "" (string-split line char-set:whitespace))
                      ((or () ("#" . _)) ; ignore comments and blank lines
-                      (loop name ambient diffuse specular shininess))
+                      (loop opts))
                      (("Ka" r g b)
                       (let ((new-ambient (vec3 (string->number r)
                                                (string->number g)
                                                (string->number b))))
-                        (loop name new-ambient diffuse specular shininess)))
+                        (loop (cons (cons 'ambient new-ambient) opts))))
+                     (("Ka" r)
+                      (let ((new-ambient (vec3 (string->number r)
+                                               (string->number r)
+                                               (string->number r))))
+                        (loop (cons (cons 'ambient new-ambient) opts))))
                      (("Kd" r g b)
                       (let ((new-diffuse (vec3 (string->number r)
                                                (string->number g)
                                                (string->number b))))
-                        (loop name ambient new-diffuse specular shininess)))
+                        (loop (cons (cons 'diffuse new-diffuse) opts))))
+                     (("Kd" r)
+                      (let ((new-diffuse (vec3 (string->number r)
+                                               (string->number r)
+                                               (string->number r))))
+                        (loop (cons (cons 'diffuse new-diffuse) opts))))
                      (("Ks" r g b)
                       (let ((new-specular (vec3 (string->number r)
                                                 (string->number g)
                                                 (string->number b))))
-                        (loop name ambient diffuse new-specular shininess)))
+                        (loop (cons (cons 'specular new-specular) opts))))
+                     (("Ks" r)
+                      (let ((new-specular (vec3 (string->number r)
+                                                (string->number r)
+                                                (string->number r))))
+                        (loop (cons (cons 'specular new-specular) opts))))
                      (("Ns" n)
-                      (let ((new-exp (* (string->number n) 1.0))) ; force it to be a float
-                        (loop name ambient diffuse specular new-exp)))
+                      ;; Force specular exponent to be a float.
+                      (let ((new-shininess (* (string->number n) 1.0)))
+                        (loop (cons (cons 'shininess new-shininess) opts))))
+                     (("map_Kd" . args)
+                      (let* ((diffuse-opts (parse-map-args args))
+                             (file (scope-file (assq-ref diffuse-opts
+                                                         'file-name)))
+                             (texture (load-image file
+                                                  #:min-filter 'linear
+                                                  #:mag-filter 'linear)))
+                        (loop (cons* (cons 'diffuse-map texture)
+                                     (cons 'use-diffuse-map? #t)
+                                     opts))))
+                     (("map_Ks" . args)
+                      (let* ((specular-opts (parse-map-args args))
+                             (file (scope-file (assq-ref specular-opts
+                                                         'file-name)))
+                             (texture (load-image file
+                                                  #:min-filter 'linear
+                                                  #:mag-filter 'linear)))
+                        (loop (cons* (cons 'specular-map texture)
+                                     (cons 'use-specular-map? #t)
+                                     opts))))
+                     (("bump" . args)
+                      (let* ((bump-opts (parse-map-args args))
+                             (file (scope-file (assq-ref bump-opts
+                                                         'file-name)))
+                             (texture (load-image file
+                                                  #:min-filter 'linear
+                                                  #:mag-filter 'linear)))
+                        (loop (cons* (cons 'bump-map texture)
+                                     (cons 'use-bump-map? #t)
+                                     opts))))
                      (("newmtl" new-name)
                       ;; Begin new material
                       (maybe-add-material)
-                      (loop new-name
-                            (vec3 0.0 0.0 0.0)
-                            (vec3 0.0 0.0 0.0)
-                            (vec3 0.0 0.0 0.0)
-                            1.0))
+                      (loop `((name . ,new-name)
+                              (ambient . ,(vec3 0.0 0.0 0.0))
+                              (diffuse . ,(vec3 0.0 0.0 0.0))
+                              (diffuse-map . ,null-texture)
+                              (use-diffuse-map? . #f)
+                              (specular . ,(vec3 0.0 0.0 0.0))
+                              (specular-map . ,null-texture)
+                              (use-specular-map? . #f)
+                              (shininess . 1.0)
+                              (bump-map . ,null-texture)
+                              (use-bump-map? . #f))))
                      (data
                       (format (current-error-port)
                               "warning: ~a:~d: unsupported MTL data: ~s~%"
                               mtl-file-name
                               (port-line port)
                               data)
-                      (loop name ambient diffuse specular shininess)))))))))
+                      (loop opts)))))))))
         (define (parse-error message args)
           (apply error (format #f "OBJ parser error @ ~a:~d: ~a"
                          file-name