外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispでソリッド図形の円を描く
:clispでソリッド図形の円を描く
@echo off
set w=%1
if defined w (
echo ^%1> %~dpn0.txt
) else (
if exist %~dpn0.txt (
for /f "tokens=*" %%a in (%~dpn0.txt) do set w=%%a
)
)
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 #c 扁平率(0.1～10.0) w =
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)
(setq x (subseq x 0 (search "d" x)))
(if (search "d" x)
(progn
(setq s (search "d" x))
(setq x (concatenate 'string (subseq x 0 s) "e" (subseq x (+ 1 s) (length x))))
)
x
)
)
(if (search "L0" x)
(subseq x 0 (search "L" x))
(if (search "L" x)
(progn
(setq s (search "L" x))
(concatenate 'string (subseq x 0 s) "e" (subseq x (+ 1 s) (length x)))
)
x
)
)
) ;progn (listp x)
)
)
;本文
( ;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 "^hk" line) (setq hk (cadr a)))
(if (regexp:match "^hp1" line) (setq p1 (cdr a)) nil)
(if (regexp:match "^hp2" line) (setq p2 (cdr a)) nil)
)
)
( ;準備計算
progn
(setq x1 (to_f (car p1)))
(setq y1 (to_f (cadr p1)))
(setq x2 (to_f (car p2)))
(setq y2 (to_f (cadr p2)))
(setq r1 (sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1)))))
(multiple-value-setq (r g b) (values 0 128 128))
(setq w (to_f (ext:getenv "w")))
(setq d (* (to_f hk) (/ pi 180)))
)
( ;jwc_temp.txt へ 出力
with-open-file (f "jwc_temp.txt" :direction :output)
(format f "lc10 ~a~%" (+ r (* 256 g) (* 256 256 b)))
;(format f "sc~{ ~a~}~%" (append p1 (list (to_s r1) w d 0 (to_s (* 2 pi)) 100)))
(format f "sc~{ ~a~}~%" (append p1 (to_s (list r1 w d 0 (* 2 pi) 100))))
)
