*

\ 雙羅盤 ---------------------------------------------------
: 原點! ( X Y -- ) 1 ! 0 ! ; : 原點 ( -- X Y ) 0 @ 1 @ ;
: 橫標! ( -- X ) 0 ! ; : 橫標 ( -- X ) 0 @ ;
: 縱標! ( -- Y ) 1 ! ; : 縱標 ( -- Y ) 1 @ ;
: 軸向! ( A -- ) 2 ! ; : 軸向 ( -- A ) 2 @ ;
: 半徑! ( R -- ) 3 ! ; : 半徑 ( -- R ) 3 @ ; 1 半徑!
: 暈度! ( H -- ) 4 ! ; : 暈度 ( -- H ) 4 @ ; 150 暈度!
: 2pi 5 @ ; 2 pi * 5 !
: atan2 atan2 2pi / 1 mod ;
: cos 2pi * cos ; : sin 2pi * sin ;
: x x 0 @ - ; : y y 1 @ - ;
: r ( -- r ) y 2 ** x 2 ** + .5 ** ;
: a ( -- a ) y x atan2 2 @ - 1 mod ;
: x ( -- x ) r a cos * ;
: y ( -- y ) r a sin * ;
: 線半徑 .01 ;
:x abs 線半徑 < ;
: 暈度 39 ;
:x abs 1 swap - 暈度 ** ;
: 絕對值 ( n -- n的絕對值 ) abs ;
: 取大 ( n1 n2 -- n ) max ;
: 取小 ( n1 n2 -- n ) min ;
: 對調 ( n1 n2 -- n2 n1 ) swap ;
: 入疊 ( n -- ) >r ;
: 出疊 ( -- n ) r> ;
: 疊頂 ( -- n ) r@ ;
: 複製 ( n -- n n ) dup ;
: 負值 ( n -- -n ) negate ;
: 反圖 ( 圖 -- 反圖 ) 1 取小 0 取大 1 對調 - ;
: 等高線 ( f y -- 線 ) - 絕對值 反圖 暈度 ** ;
: 橫線 ( Y -- 線 ) y 等高線 ;
: 垂線 ( X -- 線 ) x 等高線 ;
:( R -- 圈 ) r 等高線 ;
:( R -- 圓 ) r > ;
: 兩點線 ( X1 Y1 X2 Y2 -- 線段 )
入疊 入疊 ( X1 Y1 ) 原點!
出疊 橫標 - 出疊 縱標 - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑!
對調 atan2 軸向! 0 橫線 ;
: 羅盤 ( X Y R -- ) 半徑! 原點! t 60 / 負值
軸向! 0 垂線 0 橫線 + 半徑 1.2 ** 半徑 圈 + t 10 /
軸向! 半徑 .55 * 入疊
疊頂 橫線 x 疊頂 > * 疊頂 垂線 y 出疊 > * 軸向 .125 + 軸向! 0 橫線 x 0 > * + + r 反圖 2 ** *
半徑 * +
半徑 圓 .1 * + ;
: p1 .30 .35 ; : p2 .60 .50 ; \ 羅盤中心點 分別在 P1 與 P2
p1 .2 羅盤 半徑 .8 * 圓 複製 入疊 .1 * + \
p2 .3 羅盤 半徑 .8 * 圓 複製 入疊 .1 * + \
p1 p2 兩點線 出疊 出疊 + .5 * + \
0 0 原點! x y + * \

Based on: rolling compass 2 - 陳爽


comments powered by Disqus