1 ;;; -*- mode: lisp; syntax: common-lisp; package: existenz; -*-
3 (in-package #:existenz)
6 (defun parse-wavefront-object-file (pathname function)
7 (with-open-file (stream pathname)
8 (let (name vertexes faces)
10 (for line = (read-line stream NIL))
12 (when (or (emptyp line) (char= #\# (char line 0)))
14 (multiple-value-bind (token end)
15 (read-from-string line)
20 (funcall function name vertexes faces)
23 (setf name (subseq line end)))
26 (multiple-value-setq (x end)
27 (read-from-string line NIL NIL :start end))
30 (push (nreverse values) vertexes)))
36 (multiple-value-setq (x end)
37 (read-from-string line NIL NIL :start end))
40 (push (nreverse values) faces)))))
43 (funcall function name vertexes faces)))))))
46 (defun parse-wavefront-object-file (pathname object vertex face)
47 (with-open-file (stream pathname)
49 (for line = (read-line stream NIL))
51 (when (or (emptyp line) (char= #\# (char line 0)))
53 (multiple-value-bind (token end)
54 (read-from-string line)
57 (o (funcall object (subseq line end)))
60 (multiple-value-setq (x end)
61 (read-from-string line NIL NIL :start end))
64 (funcall vertex (nreverse values))))
69 (multiple-value-setq (x end)
70 (read-from-string line NIL NIL :start end))
73 (funcall face (nreverse values)))))))))
75 ;; TODO: could be made more type static by using 0 instead of NIL for
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
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)
91 (for line = (read-line stream NIL))
93 (let ((length (length line)))
96 (let ((char0 (char line 0)))
97 (when (char= #\# char0)
100 (warn "too short input on line ~D" count)
105 (warn "missing object name on line ~D" count)
108 (warn "missing vertex data on line ~D" count)
109 (funcall vertex 0 0 0))
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)
118 ;; TODO: discard other whitespace
119 (funcall object (subseq line 2)))
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)))
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)))
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)))))))))))
150 (defun parse-wavefront-material-file (pathname material option)
151 (with-open-file (stream pathname)
154 (for line = (read-line stream NIL))
156 (let ((length (length line)))
159 (let ((char0 (char line 0)))
160 (when (char= #\# char0)
163 (warn "too short input on line ~D" count)
168 (warn "missing data on line ~D" count)
170 ;; TODO: should be "any whitespace"
171 (let ((char1 (char line 1)))
172 (if (char= char1 #\Space)
175 ;; TODO: discard other whitespace
176 (funcall option 'd (read-from-string line NIL 0 :start 2))))
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)))))))))))