xyzzy lisp
lightwave関連
- ソース
バイナリ（ライトウェーブはビッグエンディアン）からfloatにする方法が、新しく分かった。
print-f4関数あたり。
残りはサーフェースサブチャンク
;;; light wave のファイルを調べる関数群
;;;
;;; todo:
;;; サーフェイス サブチャンクの表示がない
;;;
(defun print-chunck-tag (in)
(let ((name (print-id4 in "tag")))
(print-chunck-length in name)))
(defun print-u2 (in name)
(let ((ch)(val 0))
(dotimes (cnt 2) (setq ch (read-char in nil))
(if (= cnt 0) (setq val (char-code ch))
(setq val (+ (* #x100 val) (char-code ch)))))
(princ (format nil "\t~A: ~D\n" name val))))
(defun print-f4 (in)
(let ((ch)(val ""))
(dotimes (cnt 4) (setq ch (read-char in nil))
(progn
(setq val (concat (format nil "~C" ch) val))))
(princ (format nil "~E, " (si::unpack-float (si::make-string-chunk val) 0)
))))
(defun print-vec12 (in)
(let ((ch)(val 0))
(princ "\t\t")
(print-f4 in)
(print-f4 in)
(print-f4 in)
(princ "\n")))
(defun print-id4 (in name2)
(let ((name "")(ch))
(dotimes (cnt 4) (setq ch (read-char in nil))
(if (not ch) (return))
(setq name (concat name (format nil "~C" ch))))
(if ch (progn (princ (format nil "~A: ~A\n" name2 name))))
(string name)))
(defun print-numvert-flags (in)
(let ((ch)(val 0))
(dotimes (cnt 2) (setq ch (read-char in nil))
(if (= cnt 0) (setq val (char-code ch))
(setq val (+ (* #x100 val) (char-code ch)))))
(princ (format nil "\tflags: ~D\n" (ash (logand val #b1111110000000000) -10)))
(princ (format nil "\tnumvert: ~D\n" (logand val #b1111111111)))
(logand val #b1111111111)))
(defun print-vx (in)
(let ((ch)(val 0)(by))
(setq ch (read-char in nil))
(if (= #xff (char-code ch))
(progn (dotimes (cnt 3) (setq ch (read-char in nil))
(if (= cnt 0) (setq val (char-code ch))
(setq val (+ (* #x100 val) (char-code ch)))))
(setq by 4))
(progn (setq val (+ (* #x100 val) (char-code ch)))
(setq ch (read-char in nil))
(setq val (+ (* #x100 val) (char-code ch)))
(setq by 2)))
(princ (format nil "~D" val))
by
))
(defun print-chunck-length (in name)
(let ((ch)(val 0))
(dotimes (cnt 4) (setq ch (read-char in nil))
(if (null ch) (return))
(if (= cnt 0) (setq val (char-code ch))
(setq val (+ (* #x100 val) (char-code ch)))))
(if ch (progn
(princ (format nil "\tlength: ~D\n" val))
(cond ((string= name "FORM")
(skip-stream in 4)
(print-chunck-tag in))
((string= name "TAGS")
(print-tags-name in val)
(print-chunck-tag in))
((string= name "LAYR")
(print-u2 in "number")
(print-u2 in "flags")
(princ "\tpivot:\n")
(print-vec12 in)
(print-tags-name in (- val 18))
(print-u2 in "parent")
(print-chunck-tag in))
((string= name "PNTS")
(princ "\tpoint-location:\n")
(dotimes (i (/ val 12))
(print-vec12 in))
(print-chunck-tag in))
((string= name "BBOX")
(princ "\tmin:\n")
(print-vec12 in)
(princ "\tmax:\n")
(print-vec12 in)
(print-chunck-tag in))
((string= name "POLS")
(print-id4 in "\ttype")
(setq val (- val 4))
(let ((vn))
(while (> val 0)
(setq vn (print-numvert-flags in))
(princ "\tvert:\n\t\t")
(dotimes (cnt vn)
(setq val (- val (print-vx in)))
(princ ", "))
(setq val (- val 2))
(princ "\n")))
(print-chunck-tag in))
((string= name "PTAG")
(print-id4 in "\ttype")
(setq val (- val 4))
(while (> val 0)
(princ "\tpoly: ")
(setq val (- val (print-vx in)))
(princ "\n")
(print-u2 in "tag")
(setq val (- val 2)))
(print-chunck-tag in))
((string= name "SURF")
(setq val (- val (print-s0 in "name")))
(setq val (- val (print-s0 in "source")))
(skip-stream in val)
(print-chunck-tag in))
(t (message "なんか分からないチャンクがありました"))
)))))
(defun print-tags-name (in len)
(let ((ch)(tmp "")(prech 1))
(dotimes (cnt len) (setq ch (read-char in nil))
(if (= 0 (char-code ch))
(if (/= prech 0)
(setq tmp (concat tmp "\n\t\t")))
(setq tmp (concat tmp (format nil "~C" ch))))
(setq prech (char-code ch)))
(princ (format nil "\ttagname: \n\t\t~A\n" tmp))))
(defun print-s0 (in name)
(let ((ch)(tmp "")(len 0))
(while (/= 0 (char-code (setq ch (read-char in nil))))
(setq tmp (concat tmp (format nil "~C" ch)))
(incf len))
(princ (format nil "\t~A: \n\t\t~A\n" name tmp))
len))
(defun skip-stream (in cnt)
(dotimes (x cnt) (read-char in nil)))
(defun scan-lwo (fn)
"lightwaveオブジェクトファイル解析"
(interactive "F")
(with-output-to-temp-buffer ("*lwo解析結果*")
(with-open-file (in fn :direction :input :encoding :binary)
(let ((ch)(stat 0)(cnt 0)(val 0)(tag "")(tmp))
(print-chunck-tag in)))))
(defun scan-lws (fn)
"lightwaveシーンファイルを解析する"
(interactive "F")
(with-output-to-temp-buffer ("*lws解析結果*")
(let ((sbuffer (buffer-stream-buffer *standard-output*)))
(save-excursion
(with-open-file (in fn :direction :input)
(let ((tmp "")(tmp2))
(while (setq tmp (read-line in nil))
(if (string-match "AddNullObject \\(.+\\)" tmp) ; null object
(princ (concat "nullオブジェクト: " (match-string 1) "\n"))
)
(if (string-match "LoadObjectLayer \\w+ \\(.+\\)" tmp) ; object layer
(princ (concat "オブジェクト・レイヤ: " (match-string 1) "\n"))
)
(if (string-match "LightName \\(.+\\)" tmp) ; light
(princ (concat "ライト: " (match-string 1) "\n"))
)
(if (string-match "CameraName \\(.+\\)" tmp) ; camera
(princ (concat "カメラ: " (match-string 1) "\n"))
)
(if (string-match "^FirstFrame \\(.+\\)" tmp) ; first frame
(princ (concat "開始フレーム: " (match-string 1) "\n"))
)
(if (string-match "^LastFrame \\(.+\\)" tmp) ; last frame
(princ (concat "終了フレーム: " (match-string 1) "\n"))
)
)))))))
(provide "lightwave")
- 結果
調子に乗ってクラインの壷を解析したら、うまく動いたが、２万行近い出力になった。
箱の解析結果で我慢する。
tag: FORM length: 382 tag: TAGS length: 14 tagname: DkBlu Default tag: LAYR length: 18 number: 0 flags: 0 pivot: 0.0, 0.0, 0.0, tagname: parent: 0 tag: PNTS length: 96 point-location: -0.95, -1.1, -1.05, -0.95, 0.95, -1.05, 0.95, 0.95, -1.05, 0.95, -1.1, -1.05, -0.95, -1.1, 0.0, -0.95, 0.95, 0.0, 0.95, 0.95, 0.0, 0.95, -1.1, 0.0, tag: BBOX length: 24 min: -0.95, -1.1, -1.05, max: 0.95, 0.95, 0.0, tag: POLS length: 64 type: FACE flags: 0 numvert: 4 vert: 0, 1, 2, 3, flags: 0 numvert: 4 vert: 0, 4, 5, 1, flags: 0 numvert: 4 vert: 1, 5, 6, 2, flags: 0 numvert: 4 vert: 3, 2, 6, 7, flags: 0 numvert: 4 vert: 0, 3, 7, 4, flags: 0 numvert: 4 vert: 4, 7, 6, 5, tag: PTAG length: 28 type: COLR poly: 0 tag: 0 poly: 1 tag: 0 poly: 2 tag: 0 poly: 3 tag: 0 poly: 4 tag: 0 poly: 5 tag: 0 tag: PTAG length: 28 type: SURF poly: 0 tag: 1 poly: 1 tag: 1 poly: 2 tag: 1 poly: 3 tag: 1 poly: 4 tag: 1 poly: 5 tag: 1 tag: SURF length: 42 name: Default source:
