外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで指示文字を確認する(ch)
:clispで指示文字を確認する(ch)
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
copy jwc_temp.txt myfiles > nul
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1%dch 文字を指示してください
REM #99#
REM #bz
REM #e
#!この次の行からプログラムを書いてください
;ユーザ定義関数
;文字列 str の old に一致する部分を new で置き換える
(defun gsub (old new str)
(let (s e)
(if (search old str)
(progn
(setq s (search old str))
(setq e (+ s (length old)))
(setq str (concatenate 'string (subseq str 0 s) new (subseq str e)))
(gsub old new str)
)
str
)
))
( ;文字列 "x" を 数値 xd0 (倍精度 double-float) に変換
defun to_f (x)
(if (equal x nil) (setq x "0"))
(if (listp x)
(mapcar #'to_f x)
(progn
(if (typep x 'double-float)
x
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(if (search "e" x)
(progn
(setq s (search "e" x))
(read-from-string
(concatenate 'string (subseq x 0 s) "d" (subseq x (+ 1 s) (length x)))
)
) ;progn (search "e" x)
(if (search "d" x)
x
(read-from-string
(concatenate 'string x "d0")
)
)
)
) ;progn (typep x 'double-float)
)
) ;progn (listp x)
)
)
(defun hp (i &optional j)
(if (equal j "x") (setq j 0))
(if (equal j "y") (setq j 1))
(if j (if (> (abs j) 1) (setq j nil)))
(if j (elt (elt hp i) j) (elt hp i))
)
(defun ch (i &optional j)
(if (equal j "c") (setq j 0))
(if (equal j "x") (setq j 1))
(if (equal j "y") (setq j 2))
(if (equal j "lx") (setq j 3))
(if (equal j "ly") (setq j 4))
(if (equal j "str") (setq j 5))
(if (or (equal j "val") (equal j "str-value")) (setq j -5))
(if j (if (> (abs j) 5) (setq j nil)))
(if j (if (= j -5) (to_f (elt (elt ch i) 5)) (elt (elt ch i) j)) (elt ch i))
)
(defun pow (x y) ;べき乗( x ^ y )計算をして倍精度実数値を返す
(setq x (expt x y))
(if (complexp x) (to_f (realpart x)) x)
)
(defun atan2 (y x) (if (and (= x 0) (= y 0)) 0 (atan y x)))
(defun hypot (x y) (sqrt (+ (pow x 2) (pow y 2))))
;本文
(setq hp '( (0 0)))
(setq hpn 0)
(setq ch '( ("" 0 0 0 0 "")))
(setq chn 0)
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.txt" :direction :output)
( ;myfiles から 入力
with-open-file (f "myfiles" :direction :input)
(loop for line = (read-line f nil) while line do
(setq a (regexp:regexp-split " \\+" line))
(if (regexp:match "^hq" line)
(write-line "bz" g)
)
;指示点データ
(if (regexp:match "^hp[1-9][0-9]\\?\\(ln\\|ci\\|ch\\)\\?-\\?" line)
(progn
(setq hpn (gsub "hp" "" (car a)))
(setq hpn (gsub "ln" "" hpn))
(setq hpn (gsub "ci" "" hpn))
(setq hpn (gsub "ch" "" hpn))
(setq hpn (gsub "#" "" hpn))
(setq hpn (parse-integer (gsub "-" "" hpn)))
(if (>= (- hpn (length hp)) 0)
(loop for i to (- hpn (length hp)) do
(setq hp (append hp '( (0 0))))
)
)
(setf (elt hp hpn) (cdr a))
)
)
;指示文字列データ
(if (regexp:match "^hhp[1-9][0-9]\\?ch" line)
(progn
(setq chn (gsub "hhp" "" (nth 0 a)))
(setq chn (gsub "ch" "" chn))
(setq chn (parse-integer chn))
)
)
(if (regexp:match "^c[hvsroptkz2]" line)
(progn
(setq s (search "\"" line))
(setq str (subseq line (+ s 1) (length line)))
(if (= chn 0) (setq chn (length ch)))
(if (>= (- chn (length ch)) 0)
(loop for i to (- chn (length ch)) do
(setq ch (append ch '( ("" 0 0 0 0 ""))))
)
)
(if (= chn (- (length ch) 1))
(progn
(setf (elt ch chn) (append (subseq a 0 5) (list str)))
)
(progn
(setq b (elt ch chn))
(setf (elt ch (- (length ch) 1)) b)
)
)
;指示文字列に下線を引く
(setq x1 (to_f (nth 1 (ch chn))))
(setq y1 (to_f (nth 2 (ch chn))))
(setq lx (to_f (nth 3 (ch chn))))
(setq ly (to_f (nth 4 (ch chn))))
(setq d (atan2 ly lx))
(setq l (hypot lx ly))
(setq x2 (+ x1 (* l (cos d))))
(setq y2 (+ y1 (* l (sin d))))
(format g "~f ~f ~f ~f~%" x1 y1 x2 y2)
(setq chn 0)
)
)
)
)
)
