外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで指示線を確認する(ln)
:clispで指示線を確認する(ln)
@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%dln 線を指示してください
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)
)
)
( ;文字列 "x" を 整数に変換
defun to_i (x)
(if (numberp x)
(* (signum x) (floor (abs x)))
(progn
(if (equal x nil) (setq x "0"))
(if (listp x)
(mapcar #'to_i x)
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(parse-integer 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 ln (i &optional j)
(if (equal j "x1") (setq j 0))
(if (equal j "y1") (setq j 1))
(if (equal j "x2") (setq j 2))
(if (equal j "y2") (setq j 3))
(if j (if (> (abs j) 3) (setq j nil)))
(if j (elt (elt ln i) j) (elt ln i))
)
( ;線長を返す
; x : (x1 y1 x2 y2)
defun lnlength (x)
(setq x1 (to_f (nth 0 x)))
(setq y1 (to_f (nth 1 x)))
(setq x2 (to_f (nth 2 x)))
(setq y2 (to_f (nth 3 x)))
(sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1))))
)
;本文
(setq hp '( (0 0)))
(setq hpn 0)
(setq ln '( (0 0 0 0)))
(setq lnn 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]\\?ln" line)
(progn
(setq lnn (gsub "hhp" "" (nth 0 a)))
(setq lnn (gsub "ln" "" lnn))
(setq lnn (parse-integer lnn))
)
)
(if (regexp:match "^\\s\\+" line)
(progn
(if (>= (- lnn (length ln)) 0)
(loop for i to (- lnn (length ln)) do
(setq ln (append ln '( (0 0 0 0))))
)
)
(setf (elt ln lnn) (cdr a))
;指示点 (x y) に 半径 10mm の円を描く
(setq x (nth 0 (hp lnn)))
(setq y (nth 1 (hp lnn)))
(format g "ci ~f ~f ~f~%" x y 5)
;指示線 (x1 y1 x2 y2) を直径とする円を描く
(setq r (/ (lnlength (ln lnn)) 2))
(setq x1 (to_f (nth 0 (ln lnn))))
(setq y1 (to_f (nth 1 (ln lnn))))
(setq x2 (to_f (nth 2 (ln lnn))))
(setq y2 (to_f (nth 3 (ln lnn))))
(format g "ci ~f ~f ~f~%" (/ (+ x1 x2) 2) (/ (+ y1 y2) 2) r)
)
)
)
)
)
○(ln 1 "x1") について
(setq x1 (to_f (ln 1 "x1")))
(setq y1 (to_f (ln lnn "y1")))
(setq x2 (to_f (ln lnn "x2")))
(setq y2 (to_f (ln lnn "y2")))
ruby なら
x1 = (ln 1).to_f.x1
…
○多重代入について
(multiple-value-setq (x1 y1 x2 y2) (values-list (to_f (ln 1))))
ruby なら
x1, y1, x2, y2 = (ln 1).to_f
○ライブラリ jw.lisp を使うと以下のようになります。
:clispで指示線を確認する(ln : -i jw.lisp)
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q -i \jww\Lite\pro\jw > nul
)
goto:eof
REM #jww
REM #1%dln 線を指示してください
REM #99#
REM #bz
REM #e
#!この次の行からプログラムを書いてください
(jw
(bz)
(loop for i from 1 to lnn
do
;指示点 (x y) に 半径 10mm の円を描く
(circle (hp i) 10)
;指示線 (x1 y1 x2 y2) を直径とする円を描く
(setq r (/ (lnlength i) 2))
(circle (lncenter (ln i)) r)
)
)
