外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで階段を割り付ける
:clispで階段を割り付ける
@echo off
set n=%1
if defined n (
echo ^%1> %~dpn0.txt
) else (
if exist %~dpn0.txt (
for /f "tokens=*" %%a in (%~dpn0.txt) do set n=%%a
)
)
if not defined n set n=12
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 段数 =
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)
)
)
(defun to_s (x) ;数値 xd0 (倍精度 double-float) を 文字列 "x" に変換
(let (s)
(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)
)
)
)
)
)
;角度を deg から rad に変換する
(defun rad (x) (setq x (* x (/ pi 180))))
;点 x を 相対距離 y 移動する
(defun moveto (x y)
(if y
(loop for i in x
for j in y
collect (+ i j)
)
x
)
)
;線の dx, dy を返す
;dx pm=-1, dy pm=1 を返す
(defun lnspan (ln &optional (pm 0))
(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 dx (- x2 x1))
(setq dy (- y2 y1))
(case pm
( (0) (list dx dy))
( (-1) dx)
( (1) dy)
)
)
(defun ptspan (x y &optional (pm 0))
(lnspan (append x y) pm)
)
(defun rot (x &optional (d 0))
;回転による点の座標変換(部材系→全体系)
(setq si (sin d))
(setq co (cos d))
(setq n (length x))
(case n
( (2)(progn
(multiple-value-setq (x1 y1) (values-list (to_f x)))
(list (- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co)))
))
( (3)(progn
(multiple-value-setq (x1 y1 r) (values-list (to_f x)))
(list (- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co)) r)
))
( (4)(progn
(multiple-value-setq (x1 y1 x2 y2) (values-list (to_f x)))
(list (- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co))
(- (* x2 co) (* y2 si))
(+ (* x2 si) (* y2 co)))
))
( (5)(progn
(multiple-value-setq (x1 y1 u v w) (values-list (to_f x)))
(list (- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co)) u (+ v (* d (/ 180 pi))) w)
))
( (6)(progn
(multiple-value-setq (s x1 y1 lx ly str) (values-list (to_f x)))
(list s
(- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co))
(- (* lx co) (* ly si))
(+ (* lx si) (* ly co)) str)
))
( (7)(progn
(multiple-value-setq (x1 y1 r p1 p2 w d2) (values-list (to_f x)))
(list (- (* x1 co) (* y1 si))
(+ (* x1 si) (* y1 co)) r p1 p2 w (+ d2 (* d (/ 180 pi))))
))
)
)
(defun rot2 (x &optional (d 0))
;回転による点の座標変換(全体系→部材系)
(setq si (sin d))
(setq co (cos d))
(setq n (length x))
(case n
( (2)(progn
(multiple-value-setq (x1 y1) (values-list (to_f x)))
(list (+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si)))
))
( (3)(progn
(multiple-value-setq (x1 y1 r) (values-list (to_f x)))
(list (+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si)) r)
))
( (4)(progn
(multiple-value-setq (x1 y1 x2 y2) (values-list (to_f x)))
(list (+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si))
(+ (* x2 co) (* y2 si))
(- (* y2 co) (* x2 si)))
))
( (5)(progn
(multiple-value-setq (x1 y1 u v w) (values-list (to_f x)))
(list (+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si)) u (+ v (* d (/ 180 pi))) w)
))
( (6)(progn
(multiple-value-setq (s x1 y1 lx ly str) (values-list (to_f x)))
(list s
(+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si))
(+ (* lx co) (* ly si))
(- (* ly co) (* lx si)) str)
))
( (7)(progn
(multiple-value-setq (x1 y1 r p1 p2 w d2) (values-list (to_f x)))
(list (+ (* x1 co) (* y1 si))
(- (* y1 co) (* x1 si)) r p1 p2 w (+ d2 (* d (/ 180 pi))))
))
)
)
( ;階段を割り付ける
defun steps (g p1 p2 n hk &optional (c 1))
(setq d (rad hk))
(multiple-value-setq (ww hh) (values-list (rot2 (ptspan p1 p2) d)))
(setq aa (/ hh n))
(if (> n 1) (setq bb (/ ww (- n c))) (setq bb ww))
(setq p0 (rot (list bb aa) d))
(setq p2 (moveto p1 (rot (list 0 aa) d)))
(setq p3 (moveto p1 p0))
(loop for i from 1 to n
do
(format g "~{ ~a~}~{ ~a~}~%" (to_s p1) (to_s p2))
(format g "~{ ~a~}~{ ~a~}~%" (to_s p2) (to_s p3))
(multiple-value-setq (p1 p2 p3) (values-list (list p3 (moveto p2 p0) (moveto p3 p0))))
)
)
;本文
( ;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 hp1 (cdr a)))
(if (regexp:match "^hp2" line) (setq hp2 (cdr a)))
)
)
( ;準備計算
progn
(setq n (to_i (ext:getenv "n")))
(if (= n 0) (setq n 12))
(setq hk (to_f hk))
(setq hp1 (to_f hp1))
(setq hp2 (to_f hp2))
)
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.txt" :direction :output)
(steps g hp1 hp2 n hk)
)
