;;; -*- mode: lisp; syntax: common-lisp; package: existenz; -*-

(in-package #:existenz)

#+(or)
(defun parse-wavefront-object-file (pathname function)
  (with-open-file (stream pathname)
    (let (name vertexes faces)
      (iterate
        (for line = (read-line stream NIL))
        (while line)
        (when (or (emptyp line) (char= #\# (char line 0)))
          (next-iteration))
        (multiple-value-bind (token end)
            (read-from-string line)
          (ecase token
            (mtllib)
            (o
             (when name
               (funcall function name vertexes faces)
               (setf vertexes NIL
                     faces NIL))
             (setf name (subseq line end)))
            (v (let (x values)
                 (iterate
                   (multiple-value-setq (x end)
                     (read-from-string line NIL NIL :start end))
                   (while x)
                   (push x values))
                 (push (nreverse values) vertexes)))
            (usemtl)
            (s)
            (f
             (let (x values)
               (iterate
                 (multiple-value-setq (x end)
                   (read-from-string line NIL NIL :start end))
                 (while x)
                 (push x values))
               (push (nreverse values) faces)))))
        (finally
         (when name
           (funcall function name vertexes faces)))))))

#+(or)
(defun parse-wavefront-object-file (pathname object vertex face)
  (with-open-file (stream pathname)
    (iterate
      (for line = (read-line stream NIL))
      (while line)
      (when (or (emptyp line) (char= #\# (char line 0)))
        (next-iteration))
      (multiple-value-bind (token end)
          (read-from-string line)
        (ecase token
          (mtllib)
          (o (funcall object (subseq line end)))
          (v (let (x values)
               (iterate
                 (multiple-value-setq (x end)
                   (read-from-string line NIL NIL :start end))
                 (while x)
                 (push x values))
               (funcall vertex (nreverse values))))
          (usemtl)
          (s)
          (f (let (x values)
               (iterate
                 (multiple-value-setq (x end)
                   (read-from-string line NIL NIL :start end))
                 (while x)
                 (push x values))
               (funcall face (nreverse values)))))))))

;; TODO: could be made more type static by using 0 instead of NIL for
;; missing values
;; TODO: use read-integer/read-number, split-sequence?, whitespacep
;; TODO: use stream or stream-designator
;; TODO: parse directly from stream, accept multiple directives per line, i.e. parse tokens
;; TODO: accept more, i.e. more coordinates/vertexes and less
;; TODO: also, type annotations?
;; TODO: use conditions and restarts to skip over bad data?  e.g. allow
;; to selectively skip a single line, or try to resync on the next known
;; token
;; TODO: what about encoding?
(defun parse-wavefront-object-file (pathname object vertex face option)
  ;; FIXME: option is unused, but should handle usemtl, s, mtllib
  (with-open-file (stream pathname)
    (iterate
      (for count from 1)
      (for line = (read-line stream NIL))
      (while line)
      (let ((length (length line)))
        (when (eql 0 length)
          (next-iteration))
        (let ((char0  (char line 0)))
          (when (char= #\# char0)
            (next-iteration))
          (when (<= length 2)
            (warn "too short input on line ~D" count)
            (next-iteration))
          (if (eql length 1)
              (ecase char0
                (#\o
                 (warn "missing object name on line ~D" count)
                 (funcall object ""))
                (#\v
                 (warn "missing vertex data on line ~D" count)
                 (funcall vertex 0 0 0))
                (#\f
                 (warn "missing face data on line ~D" count)
                 (funcall face 0 0 0 0)))
              ;; TODO: should be "any whitespace"
              (let ((char1 (char line 1)))
                (if (char= char1 #\Space)
                    (ecase char0
                      (#\o
                       ;; TODO: discard other whitespace
                       (funcall object (subseq line 2)))
                      (#\v
                       (let ((x 0) (y 0) (z 0) end)
                         (multiple-value-setq (x end)
                           (read-from-string line NIL 0 :start 2))
                         (multiple-value-setq (y end)
                           (read-from-string line NIL 0 :start end))
                         (multiple-value-setq (z end)
                           (read-from-string line NIL 0 :start end))
                         (funcall vertex x y z)))
                      (#\f
                       (let ((a 0) (b 0) (c 0) (d 0) end)
                         (multiple-value-setq (a end)
                           (read-from-string line NIL 0 :start 2))
                         (multiple-value-setq (b end)
                           (read-from-string line NIL 0 :start end))
                         (multiple-value-setq (c end)
                           (read-from-string line NIL 0 :start end))
                         (multiple-value-setq (d end)
                           (read-from-string line NIL 0 :start end))
                         (funcall face a b c d)))
                      (#\s
                       (warn "ignoring directive ~A on line ~D" char0 count)))
                    ;; TODO: use optimized string-case
                    (if (starts-with-subseq "usemtl" line :test #'char-equal)
                        (funcall option 'usemtl (subseq line #.(length "usemtl ")))
                        (if (starts-with-subseq "mtllib" line :test #'char-equal)
                            (funcall option 'mtllib (subseq line #.(length "mtllib ")))
                            (warn "ignoring unknown data on line ~D" count)))))))))))

#|
(defun parse-wavefront-material-file (pathname material option)
  (with-open-file (stream pathname)
    (iterate
      (for count from 1)
      (for line = (read-line stream NIL))
      (while line)
      (let ((length (length line)))
        (when (eql 0 length)
          (next-iteration))
        (let ((char0  (char line 0)))
          (when (char= #\# char0)
            (next-iteration))
          (when (<= length 2)
            (warn "too short input on line ~D" count)
            (next-iteration))
          (if (eql length 1)
              (ecase char0
                (#\d
                 (warn "missing data on line ~D" count)
                 (funcall option 0)))
              ;; TODO: should be "any whitespace"
              (let ((char1 (char line 1)))
                (if (char= char1 #\Space)
                    (ecase char0
                      (#\d
                       ;; TODO: discard other whitespace
                       (funcall option 'd (read-from-string line NIL 0 :start 2))))
                    (char= char1
                    ;; TODO: use optimized string-case
                    (if (starts-with-subseq "newmtl" line :test #'char-equal)
                        (funcall material (subseq line #.(length "newmtl ")))
                        (if (starts-with-subseq "illum" line :test #'char-equal)
                            (funcall option 'illum (read-from-string line NIL 0
                                                                     :start #.(length "illum ")))
                            (warn "ignoring unknown data on line ~D" count)))))))))))
|#