外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで線の複線を引く
:clispで線の複線を引く
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1ln 線を指示してください
REM #2 基準点を指示してください
REM #bz
REM #e
#!この次の行からプログラムを書いてください
;ユーザ定義関数
( ;文字列 "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)
)
)
( ;数値 xd0 (倍精度 double-float) を 文字列 "x" に変換
defun to_s (x)
(if (equal x nil) (setq x 0))
(if (listp x)
(mapcar #'to_s x)
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(if (search "d0" x)
(subseq x 0 (search "d" x))
(if (search "d" x)
(progn
(setq s (search "d" x))
(concatenate 'string (subseq x 0 s) "e" (subseq x (+ 1 s) (length x)))
)
x
)
)
) ;progn (listp x)
)
)
( ;線長を返す
; 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))))
)
( ;線角を返す
; x : (x1 y1 x2 y2)
defun lnslope (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)))
(atan (- y2 y1) (- x2 x1))
)
( ;線と点の最短距離を返す
; ln : (x1 y1 x2 y2)
; hp : (x y)
defun ln_hpdist (ln hp)
(setq x (append hp (subseq ln 0 2)))
(* (lnlength x) (sin (- (lnslope ln) (lnslope x))))
)
( ;線を直交距離 b だけ pmy の方向に平行移動する
; ln : (x1 y1 x2 y2)
defun lnmove (ln b &optional (pmy 1))
(setq d (lnslope ln))
(setq co (cos d))
(setq si (sin d))
(setq x1 (to_f (nth 0 ln)))
(setq y1 (to_f (nth 1 ln)))
(setq x2 (to_f (nth 2 ln)))
(setq y2 (to_f (nth 3 ln)))
(setq x1 (- x1 (* b si pmy)))
(setq y1 (+ y1 (* b co pmy)))
(setq x2 (- x2 (* b si pmy)))
(setq y2 (+ y2 (* b co pmy)))
(to_s (list x1 y1 x2 y2))
)
;本文
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.bak" :direction :output)
(write-line "bz" g)
( ;jwc_temp.txt から 入力
with-open-file (f "jwc_temp.txt" :direction :input)
(loop for line = (read-line f nil) while line do
(setq a (regexp:regexp-split "\\s\\+" line))
(if (regexp:match "^hp2" line) (setq hp2 (cdr a)))
(if (regexp:match "^\\s\\+" line)
(progn
(setq ln1 (subseq a 1))
(format g "~{ ~a~}~%" (lnmove ln1 (ln_hpdist ln1 hp2) 1))
)
)
)
)
)
(delete-file "jwc_temp.txt")
(rename-file "jwc_temp.bak" "jwc_temp.txt")
