summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/model.scm143
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