*

\ 羅盤

: p1 .30 .35 ;
: p2 .60 .50 ;

: 2pi 2 pi * ;
: atan2 atan2 2pi / 1 mod ;
: cos 2pi * cos ; : sin 2pi * sin ;

: orig ( X Y -- ) 1 ! 0 ! ;
: axis ( A -- ) 2 ! ;
: radius ( R -- ) 5 ! ; 1 5 !
: Halo_degree ( H -- ) 7 ! ; 149 7 !
\ : thickness ( T -- ) 2 / 6 ! ; .01 6 !

: ts t 99 / sin .5 * .5 + 1 + ;
\ : x x .5 - ts * 1 mod ;
\ : y y .5 - ts * 1 mod ;
: 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 * ;

( \ rolling colors
.5 .5 orig ts axis
x .0 >
y .0 >
r .4 <
a 4 * .5 + 1 mod .2 **
\ ) \ rolling colors

: 原點 ( X Y -- ) orig ;
: 軸向 ( A -- ) axis ;
: 半徑 ( R -- ) radius ;
\ : 線徑 ( T -- ) thickness ;
: 暈度 ( H -- ) Halo_degree ;
: 絕對值 ( n -- n的絕對值 ) abs ;
: 反圖 ( 圖 -- 反圖 ) 1 min 0 max 1 swap - ;
\ : 等值線 ( f y -- 線 ) - 絕對值 6 @ < ;
: 等值暈 ( f y -- 線 ) - 絕對值 反圖 7 @ ** ;

: 橫線 ( Y -- 線 ) y 等值暈 ;
: 垂線 ( X -- 線 ) x 等值暈 ;
:( R -- 圈 ) r 等值暈 ;
:( R -- 圓 ) r > ;
: 向線 ( R -- 向線 ) .02 橫線 x 0 > * * ;
: 垂向線 ( R -- 向線 ) .02 垂線 y 0 > * * ;
: 兩點線 ( X1 Y1 X2 Y2 -- 線段 )
>r >r ( X1 Y1 ) 原點
r> 0 @ - r> 1 @ - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑
swap atan2 軸向 0 橫線
;

: 羅盤 ( X Y R -- ) 半徑 原點 t 60 / negate
軸向 0 垂線 0 橫線 + 5 @ 1.2 ** t 10 /
軸向 5 @ 向線 + 5 @ 垂向線 + 5 @+
5 @ 圓 .1 * + ;

p1 .2 羅盤 5 @ .8 *dup >r .1 * + \
p2 .3 羅盤 5 @ .8 *dup >r .1 * + \
p1 p2 兩點線 r> r> + .3 * + \
0 0 原點 x y + * \

Based on: rolling compass - 陳爽


comments powered by Disqus