diff options
| -rw-r--r-- | chickadee/render/model.scm | 143 |
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 |