xyzzy lisp

リージョンの文字コード変換

jisとeucの相互変換が出来ません。（関数がない）
元の文字コードの自動判別が出来ない。（関数が分からない）

• ソース

(defun set-region-encoding (from to)
  "リージョンの文字コード変換(jis, euc,sjis)"
  (interactive "*s元の文字コード(jis, euc, sjis): \ns変換先文字コード(jis, euc, sjis): ")
  (save-excursion
    (save-restriction
      (let ((cb (selected-buffer))(tmp))
	(widen)
	(narrow-to-region (point) (mark))
	(create-new-buffer " region-encoding-buffer")
	(goto-char (point-min))
	(set-buffer " region-encoding-buffer")
	(delete-region (point-min) (point-max))
	(set-buffer cb)
	(setq tmp (buffer-substring (point-min) (point-max)))
	(set-buffer " region-encoding-buffer")
	(insert (cond ((string= from "jis")
		       (cond ((string= to "jis") (message "同じです")(return))
			     ((string= to "euc") (message "出来ません")(return))
			    ((string= to "sjis") (map-jis-to-sjis tmp))
			     (t (message "文字コード不明です")(return))))
		      ((string= from "euc")
		       (cond ((string= to "jis") (message "出来ません")(return))
			     ((string= to "euc") (message "同じです")(return))
			     ((string= to "sjis") (map-euc-to-sjis tmp))
			     (t (message "文字コード不明です")(return))))
		      ((string= from "sjis")
		       (cond ((string= to "jis") (map-internal-to-jis tmp))
			     ((string= to "euc") (map-internal-to-euc tmp))
			     ((string= to "sjis") (message "おなじです")(return))
			     (t (message "文字コード不明です")(return))))
		      ))
	(set-buffer cb)
	(delete-region (point-min) (point-max))
	(set-buffer " region-encoding-buffer")
	(goto-char (point-min))
	(setq tmp (buffer-substring (point-min) (point-max)))
	(set-buffer cb)
	(insert tmp)
	(set-buffer " region-encoding-buffer")
	(delete-buffer " region-encoding-buffer")))))

lightwaveシーンファイル(lws)を解析する

• ソース

(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"))
		)
	      )))))))

• 結果

オブジェクト・レイヤ: Objects/Food/Apple.lwo
オブジェクト・レイヤ: Objects/Food/Banana.lwo
nullオブジェクト: lemon

lightwaveオブジェクトファイル(lwo)を解析する

とりあえずタグ名が分かることだけ出来る。
今はタグ名が分かればＯＫなので。

• ソース

(defun print-chunck-tag (in)
  (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 "tag: ~A\n" name))
	     (print-chunck-length in name)))))

(defun print-chunck-length (in name)
  (let ((ch)(val 0))
    (dotimes (cnt 4) (setq ch (read-char in nil))
      (if (= cnt 0) (setq val (char-code ch))
	(setq val (+ (* #x100 val) (char-code ch)))))
    (princ (format nil "\tlength: ~D\n" val))
    (if (string= name "FORM")
	(progn (skip-stream in 4)
	  (print-chunck-tag in))
      )
    (if (string= name "TAGS")
	(progn (print-tags-name in val)
	  (print-chunck-tag in))
      )
    (if (string= name "LAYR")
	(progn (skip-stream in 16)
	  (print-tags-name in (- val 18))
	  (skip-stream in 2)
	  (print-chunck-tag in))
      )
    (if (string= name "PNTS")
	(progn (skip-stream in val)
	  (print-chunck-tag in))
      )
    (if (string= name "BBOX")
	(progn (skip-stream in val)
	  (print-chunck-tag in))
      )
    (if (string= name "POLS")
	(progn (skip-stream in val)
	  (print-chunck-tag in))
      )
    (if (string= name "PTAG")
	(progn (skip-stream in val)
	  (print-chunck-tag in))
      )
    (if (string= name "SURF")
	(progn (skip-stream in val)
	  (print-chunck-tag in))
      )
    ))

(defun print-tags-name (in len)
  (let ((ch)(tmp ""))
    (dotimes (cnt len) (setq ch (read-char in nil))
      (if (= 0 (char-code ch))
	  (setq tmp (concat tmp "_"))
	(setq tmp (concat tmp (format nil "~C" ch)))))
    (princ (format nil "\ttagname: ~A\n" tmp))))

(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)))))

• 結果

tag: FORM
	length: 382
tag: TAGS
	length: 14
	tagname: DkBlu_Default_
tag: LAYR
	length: 18
	tagname: 
tag: PNTS
	length: 96
tag: BBOX
	length: 24
tag: POLS
	length: 64
tag: PTAG
	length: 28
tag: PTAG
	length: 28
tag: SURF
	length: 42