外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで２線の交点に点を打つ
:clispで２線の交点に点を打つ
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1%dln 線を指示してください
REM #2%dln 線を指示してください
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)
)
)
( ;線と線の交点を返す
; ln1 : (x1 y1 x2 y2)
; ln2 : (x3 y3 x4 y4)
defun inters (ln1 ln2)
(setq x1 (to_f (nth 0 ln1)))
(setq y1 (to_f (nth 1 ln1)))
(setq x2 (to_f (nth 2 ln1)))
(setq y2 (to_f (nth 3 ln1)))
(setq dx1 (- x2 x1))
(setq dy1 (- y2 y1))
(setq m1 (if (= dx1 0d0) 1d20 (/ dy1 dx1)))
(setq x3 (to_f (nth 0 ln2)))
(setq y3 (to_f (nth 1 ln2)))
(setq x4 (to_f (nth 2 ln2)))
(setq y4 (to_f (nth 3 ln2)))
(setq dx2 (- x4 x3))
(setq dy2 (- y4 y3))
(setq m2 (if (= dx2 0d0) 1d20 (/ dy2 dx2)))
(setq aa (- m1 m2))
(if (= aa 0d0)
(list "he処理できません")
(progn
(setq u1 (- y1 (* m1 x1)))
(setq u2 (- y3 (* m2 x3)))
(list (to_s (/ (- u2 u1) aa)) (to_s (/ (- (* m1 u2) (* m2 u1)) aa)))
)
)
)
;本文
( ;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 "^hhp1ln" line) (setq n 1))
(if (regexp:match "^hhp2ln" line) (setq n 2))
(if (regexp:match "^\\s\\+" line)
(progn
(if (= n 1) (setq ln1 (cdr a)))
(if (= n 2) (setq ln2 (cdr a)))
)
)
)
)
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.txt" :direction :output)
(write-line "bz" g)
(setq pt (inters ln1 ln2))
(if (= (length pt) 2)
(format g "pt~{ ~a~}~%" pt)
)
)
