外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
:clispでレムニスケートを描く
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1-%d 中心点を指示してください
REM #2%d Ｘ軸上の点を指示してください
REM #e
#!この次の行からプログラムを書いてください
;ユーザ定義関数
( ;べき乗( x ^ y )計算をして倍精度実数値を返す
defun pow (x y)
(setq x (expt x y))
(if (complexp x) (to_f (realpart x)) x)
)
( ;文字列 "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" を 整数に変換
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 f (a p)
(* a (cos p) (sqrt (- 1d0 (* 0.5d0 (pow (sin p) 2)))))
)
(
defun g (a p)
(* (/ a (sqrt 2d0)) (sin p) (cos p))
)
(
defun hypot (x y)
(sqrt (+ (pow x 2) (pow y 2)))
)
(
defun h (n pt1 pt2 f)
(setq x1 (to_f (car pt1)))
(setq y1 (to_f (cadr pt1)))
(setq x2 (to_f (car pt2)))
(setq y2 (to_f (cadr pt2)))
(setq d (+ (atan (- y2 y1) (- x2 x1)) (/ pi 2)))
(setq si (sin d))
(setq co (cos d))
(setq a (hypot (- x2 x1) (- y2 y1)))
(setq p (* 2d0 (/ pi n)))
(setq x (f a 0d0))
(setq y (g a 0d0))
(setq xa (+ (* x si) (* y co) x1))
(setq ya (+ (- (* x co)) (* y si) y1))
(setq out "")
(loop for i from 1 to n
do
(setq x (f a (* i p)))
(setq y (g a (* i p)))
(setq xb (+ (* x si) (* y co) x1))
(setq yb (+ (- (* x co)) (* y si) y1))
;(setq out (concatenate 'string out (format nil "~{ ~a~}~%" (to_s (list xa ya xb yb)))))
(format f "~{ ~a~}~%" (to_s (list xa ya xb yb)) )
(setq xa xb)
(setq ya yb)
)
out
)
;本文
( ;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 "^hp1" line) (setq hp1 (cdr a)))
(if (regexp:match "^hp2" line) (setq hp2 (cdr a)))
)
)
( ;jwc_temp.txt へ 出力
with-open-file (f "jwc_temp.txt" :direction :output)
;(write-line (h 10 hp1 hp2) f)
(h 100 hp1 hp2 f)
)
