如何使这个代码更简单,更清晰,“更多lispy”?

时间:2011-01-26 07:01:29

标签: common-lisp

我想解析Wavefront OBJ file中的文本行。目前我只对“V”和“F”类型感兴趣。 我的算法如下:

  1. 检查行是否为零(否则步骤2将失败)
  2. 在“#”后删除评论并修剪空格
  3. 删除前缀“v”或“f”
  4. 将字符串拆分为每个元素所在的元素列表
      如果
    1. 符号为| 34/76/23 |
    2. ,则将其拆分为列表
    3. 从列表转换:我只采用一个元素,默认情况下是第一个元素
    4. 如果已经是原子序数,则
    5. 或强制转换为给定类型。
  5. 以下是代码:

    (defun parse-line (line prefix &key (type 'single-float))
      (declare (optimize (debug 3)))
      (labels ((rfs (what)
                 (read-from-string (concatenate 'string "(" what ")")))
               (unpack (str &key (char #\/) (n 0))
                 (let ((*readtable* (copy-readtable))) 
                   (when char ;; we make the given char a delimiter (space)
                     (set-syntax-from-char char #\Space))
                   (typecase str
                     ;; string -> list of possibly symbols.
                     ;; all elements are preserved by (map). nil's are dropped
                     (string (delete-if #'null
                                        (map 'list
                                             #'unpack
                                             (rfs str))))
                     ;; symbol -> list of values
                     (symbol (unpack (rfs (symbol-name str))))
                     ;; list -> value (only the requested one)
                     (list (unpack (nth n str)))
                     ;; value -> just coerce to type
                     (number (coerce str type))))))
        (and line
             (setf line (string-trim '(#\Space #\Tab)
                                     (subseq line 0 (position #\# line))))
             (< (length prefix) (length line))
             (string= line prefix :end1 (length prefix) :end2 (length prefix))
             (setf line (subseq line (length prefix)))
             (let ((value (unpack line :char nil))) 
               (case (length value)
                   (3 value)
                   (4 (values (subseq value 0 3) ;; split quad 0-1-2-3 on tri 0-1-2 + tri 0-2-3
                              (list (nth 0 value)
                                    (nth 2 value)
                                    (nth 3 value)))))))))
    

    第四步(标签“unpack”)是一种递归。它是一个功能,可以自己调用三次。

    无论如何,这个解决方案似乎很笨重。

    我的问题是:如何用更短更清晰的代码解决这个问题?

1 个答案:

答案 0 :(得分:5)

我会以更有条理的方式处理这个问题。

您想要将obj文件解析为某种数据结构:

(defun parse-obj-file (filespec)
  ;; todo
  )

您需要考虑返回的数据结构应该如何。现在,让我们返回两个列表的列表,其中一个顶点,一个面。解析器将遍历每一行,确定它是顶点还是面,然后将其收集到适当的列表中:

(defun parse-obj-file (filespec)
  (with-open-file (in-stream filespec
                             :direction :input)
    (loop for line = (read-line in-stream nil)
          while line
          when (cl-ppcre:scan "^v " line)
          collect (parse-vertex line) into vertices
          when (cl-ppcre:scan "^f " line)
          collect (parse-face line) into faces
          finally (return (list vertices faces)))))

我在这里使用了cl-ppcre库,但您也可以使用mismatchsearch。然后,您需要定义parse-vertexparse-facecl-ppcre:split应该非常方便。

为顶点和面定义类可能也很有用。

更新:这就是我接近顶点的方法:

(defclass vertex ()
  ((x :accessor x :initarg :x)
   (y :accessor y :initarg :y)
   (z :accessor z :initarg :z)
   (w :accessor w :initarg :w)))

(defun parse-vertex (line)
  (destructuring-bind (label x y z &optional w)
      (cl-ppcre:split "\\s+" (remove-comment line))
    (declare (ignorable label))
    (make-instance 'vertex
                   :x (parse-number x)
                   :y (parse-number y)
                   :z (parse-number z)
                   :w (parse-number w))))

Parse-number来自parse-number库。它比使用read更好。

更新2:(很抱歉这是一个连续剧故事;我必须交织一些工作。)一张脸由一系列面孔点组成。

(defclass face-point ()
  ((vertex-index :accessor vertex-index :initarg :vertex-index)
   (texture-coordinate :accessor texture-coordinate
                       :initarg :texture-coordinate)
   (normal :accessor normal :initarg :normal)))

(defun parse-face (line)
  (destructuring-bind (label &rest face-points)
      (cl-ppcre:split "\\s+" (remove-comment line))
    (declare (ignorable label))
    (mapcar #'parse-face-point face-points)))

(defun parse-face-point (string)
  (destructuring-bind (vertex-index &optional texture-coordinate normal)
      (cl-ppcre:split "/" string)
    (make-instance 'face-point
                   :vertex-index vertex-index
                   :texture-coordinate texture-coordinate
                   :normal normal)))

Remove-comment只会在第一个#之后抛弃所有内容:

(defun remove-comment (line)
  (subseq line 0 (position #\# line)))