common/wavefront.lisp

   1 ;;; -*- mode: lisp; syntax: common-lisp; package: existenz; -*-
   2
   3 (in-package #:existenz)
   4 \f
   5 #+(or)
   6 (defun parse-wavefront-object-file (pathname function)
   7   (with-open-file (stream pathname)
   8     (let (name vertexes faces)
   9       (iterate
  10         (for line = (read-line stream NIL))
  11         (while line)
  12         (when (or (emptyp line) (char= #\# (char line 0)))
  13           (next-iteration))
  14         (multiple-value-bind (token end)
  15             (read-from-string line)
  16           (ecase token
  17             (mtllib)
  18             (o
  19              (when name
  20                (funcall function name vertexes faces)
  21                (setf vertexes NIL
  22                      faces NIL))
  23              (setf name (subseq line end)))
  24             (v (let (x values)
  25                  (iterate
  26                    (multiple-value-setq (x end)
  27                      (read-from-string line NIL NIL :start end))
  28                    (while x)
  29                    (push x values))
  30                  (push (nreverse values) vertexes)))
  31             (usemtl)
  32             (s)
  33             (f
  34              (let (x values)
  35                (iterate
  36                  (multiple-value-setq (x end)
  37                    (read-from-string line NIL NIL :start end))
  38                  (while x)
  39                  (push x values))
  40                (push (nreverse values) faces)))))
  41         (finally
  42          (when name
  43            (funcall function name vertexes faces)))))))
  44
  45 #+(or)
  46 (defun parse-wavefront-object-file (pathname object vertex face)
  47   (with-open-file (stream pathname)
  48     (iterate
  49       (for line = (read-line stream NIL))
  50       (while line)
  51       (when (or (emptyp line) (char= #\# (char line 0)))
  52         (next-iteration))
  53       (multiple-value-bind (token end)
  54           (read-from-string line)
  55         (ecase token
  56           (mtllib)
  57           (o (funcall object (subseq line end)))
  58           (v (let (x values)
  59                (iterate
  60                  (multiple-value-setq (x end)
  61                    (read-from-string line NIL NIL :start end))
  62                  (while x)
  63                  (push x values))
  64                (funcall vertex (nreverse values))))
  65           (usemtl)
  66           (s)
  67           (f (let (x values)
  68                (iterate
  69                  (multiple-value-setq (x end)
  70                    (read-from-string line NIL NIL :start end))
  71                  (while x)
  72                  (push x values))
  73                (funcall face (nreverse values)))))))))
  74
  75 ;; TODO: could be made more type static by using 0 instead of NIL for
  76 ;; missing values
  77 ;; TODO: use read-integer/read-number, split-sequence?, whitespacep
  78 ;; TODO: use stream or stream-designator
  79 ;; TODO: parse directly from stream, accept multiple directives per line, i.e. parse tokens
  80 ;; TODO: accept more, i.e. more coordinates/vertexes and less
  81 ;; TODO: also, type annotations?
  82 ;; TODO: use conditions and restarts to skip over bad data?  e.g. allow
  83 ;; to selectively skip a single line, or try to resync on the next known
  84 ;; token
  85 ;; TODO: what about encoding?
  86 (defun parse-wavefront-object-file (pathname object vertex face option)
  87   ;; FIXME: option is unused, but should handle usemtl, s, mtllib
  88   (with-open-file (stream pathname)
  89     (iterate
  90       (for count from 1)
  91       (for line = (read-line stream NIL))
  92       (while line)
  93       (let ((length (length line)))
  94         (when (eql 0 length)
  95           (next-iteration))
  96         (let ((char0  (char line 0)))
  97           (when (char= #\# char0)
  98             (next-iteration))
  99           (when (<= length 2)
 100             (warn "too short input on line ~D" count)
 101             (next-iteration))
 102           (if (eql length 1)
 103               (ecase char0
 104                 (#\o
 105                  (warn "missing object name on line ~D" count)
 106                  (funcall object ""))
 107                 (#\v
 108                  (warn "missing vertex data on line ~D" count)
 109                  (funcall vertex 0 0 0))
 110                 (#\f
 111                  (warn "missing face data on line ~D" count)
 112                  (funcall face 0 0 0 0)))
 113               ;; TODO: should be "any whitespace"
 114               (let ((char1 (char line 1)))
 115                 (if (char= char1 #\Space)
 116                     (ecase char0
 117                       (#\o
 118                        ;; TODO: discard other whitespace
 119                        (funcall object (subseq line 2)))
 120                       (#\v
 121                        (let ((x 0) (y 0) (z 0) end)
 122                          (multiple-value-setq (x end)
 123                            (read-from-string line NIL 0 :start 2))
 124                          (multiple-value-setq (y end)
 125                            (read-from-string line NIL 0 :start end))
 126                          (multiple-value-setq (z end)
 127                            (read-from-string line NIL 0 :start end))
 128                          (funcall vertex x y z)))
 129                       (#\f
 130                        (let ((a 0) (b 0) (c 0) (d 0) end)
 131                          (multiple-value-setq (a end)
 132                            (read-from-string line NIL 0 :start 2))
 133                          (multiple-value-setq (b end)
 134                            (read-from-string line NIL 0 :start end))
 135                          (multiple-value-setq (c end)
 136                            (read-from-string line NIL 0 :start end))
 137                          (multiple-value-setq (d end)
 138                            (read-from-string line NIL 0 :start end))
 139                          (funcall face a b c d)))
 140                       (#\s
 141                        (warn "ignoring directive ~A on line ~D" char0 count)))
 142                     ;; TODO: use optimized string-case
 143                     (if (starts-with-subseq "usemtl" line :test #'char-equal)
 144                         (funcall option 'usemtl (subseq line #.(length "usemtl ")))
 145                         (if (starts-with-subseq "mtllib" line :test #'char-equal)
 146                             (funcall option 'mtllib (subseq line #.(length "mtllib ")))
 147                             (warn "ignoring unknown data on line ~D" count)))))))))))
 148
 149 #|
 150 (defun parse-wavefront-material-file (pathname material option)
 151   (with-open-file (stream pathname)
 152     (iterate
 153       (for count from 1)
 154       (for line = (read-line stream NIL))
 155       (while line)
 156       (let ((length (length line)))
 157         (when (eql 0 length)
 158           (next-iteration))
 159         (let ((char0  (char line 0)))
 160           (when (char= #\# char0)
 161             (next-iteration))
 162           (when (<= length 2)
 163             (warn "too short input on line ~D" count)
 164             (next-iteration))
 165           (if (eql length 1)
 166               (ecase char0
 167                 (#\d
 168                  (warn "missing data on line ~D" count)
 169                  (funcall option 0)))
 170               ;; TODO: should be "any whitespace"
 171               (let ((char1 (char line 1)))
 172                 (if (char= char1 #\Space)
 173                     (ecase char0
 174                       (#\d
 175                        ;; TODO: discard other whitespace
 176                        (funcall option 'd (read-from-string line NIL 0 :start 2))))
 177                     (char= char1
 178                     ;; TODO: use optimized string-case
 179                     (if (starts-with-subseq "newmtl" line :test #'char-equal)
 180                         (funcall material (subseq line #.(length "newmtl ")))
 181                         (if (starts-with-subseq "illum" line :test #'char-equal)
 182                             (funcall option 'illum (read-from-string line NIL 0
 183                                                                      :start #.(length "illum ")))
 184                             (warn "ignoring unknown data on line ~D" count)))))))))))
 185 |#