cl-mesh/wavefront-obj.lisp at master · pull-request-perhaps/cl-mesh · GitHub

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
64
65
66
67
68
69
70
(in-package :cl-mesh)

(defparameter foo nil)

(defun separate-attribs (x)
  (let ((value (split-sequence #\/ x)))
    (case (length value)
      (1 (vector (1- (read-from-string (car value))) 0 0))
      (otherwise
       (destructuring-bind (vert uv normal) value
	 (vector (1- (read-from-string vert :eof-value 0))
		 (1- (read-from-string uv :eof-value 0))
		 (1- (read-from-string normal :eof-value 0))))))))

(defparameter nope (string #\Return))

(defun parse-wavefront-obj (filename)
  "Returns a hashtable with entries \"vertices\", \"normals\", and \"indices\" containing data"
  (let* ((lines
	  (iterate (for line in-file filename using #'read-line)
		   (let ((stripped-line (string-trim " \\t" line)))
		     (when (not (emptyp stripped-line))
		       (collect (delete-if (lambda (x) (or (string-equal x "")
							   (string-equal x nope)))
					   (split-sequence #\Space stripped-line))))))))
    (let* ((vertex-data
	    (mapcar #'(lambda (x)

			(map 'vector
			 #'(lambda (x)
			     (float (read-from-string x)))
			 (cdr x)))
		    (remove-if-not
		     (rcurry #'string-equal "v")
		     lines :key #'car)))
	   (normal-data
	    (mapcar #'(lambda (x)
			(map 'vector
			     #'(lambda (x) (float (read-from-string x)))
			     (cdr x)))
		    (remove-if-not
		     (rcurry #'string-equal "vn")
		     lines :key #'car)))
	   (uv-data
	    (mapcar #'(lambda (x)
			(map 'vector
			     #'(lambda (x) (float (read-from-string x)))
			     (cdr x)))
		    (remove-if-not
		     (rcurry #'string-equal "vt")
		     lines :key #'car)))
	   (index-data
	    (mapcar #'(lambda (x)
			(map 'vector
			 #'separate-attribs
			 (cdr x)))
		    (remove-if-not
		     (rcurry #'string-equal "f")
		     lines :key #'car)))
	   (ht (make-hash-table :test 'equal)))
      (setf (gethash "vertices" ht)
	    (make-array (length vertex-data) :initial-contents vertex-data))
      (setf (gethash "uv" ht)
	    (make-array (length uv-data) :initial-contents uv-data))
      (setf (gethash "indices" ht)
	    (make-array
	     (length index-data) :initial-contents index-data))
      (setf (gethash "normals" ht)
	    (make-array (length normal-data) :initial-contents normal-data))
      ht)))