/
mtl.lisp
63 lines (60 loc) · 1.55 KB
/
mtl.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
(in-package #:globjule)
(defstruct material
ns
ka
kd
ks
ni
d
illum
map-ka
map-kd
map-ks)
(defun read-mtl (pathname materials-hash-table)
(declare (optimize space speed))
(with-open-file (stream pathname)
(loop with material = (make-material)
while (peek-char nil stream nil nil)
do (case (intern (string-upcase (read-string-token stream)) :keyword)
(:|#| (read-line stream))
(:newmtl
(setf material (make-material)
(gethash (string-upcase (read-line stream)) materials-hash-table)
material))
(:ns
(setf (material-ns material)
(read-line stream)))
(:ka
(setf (material-ka material)
(read-vec stream)))
(:kd
(setf (material-kd material)
(read-vec stream)))
(:ks
(setf (material-ks material)
(read-vec stream)))
(:ni
(setf (material-ni material)
(read-line stream)))
(:d
(setf (material-d material)
(read-line stream)))
(:illum
(setf (material-illum material)
(case (read-line stream)
(0 :none)
(1 :no-specular)
(2 :full))))
(:map_ka
(setf (material-map-ka material)
(load-texture pathname (read-line stream))))
(:map_kd
(setf (material-map-kd material)
(load-texture pathname (read-line stream))))
(:map_ks
(setf (material-map-ka material)
(load-texture pathname (read-line stream))))
(t
;; FIXME: Currently catches spurious newlines, should probbly fix
;; this by using the read functions better
)))))