100 lines
1.8 KiB
Forth
Executable File
100 lines
1.8 KiB
Forth
Executable File
\ mccirc.fs - Minecraft circle block calculator
|
|
|
|
variable lr
|
|
|
|
cr .( Reading mccirc.fs ... )
|
|
|
|
: box ( -- ) ." []" ;
|
|
|
|
: boxes ( u -- ) 0 u+do box loop ;
|
|
|
|
: prline ( u -- ) cr dup 2 .r space boxes ;
|
|
: prline2 ( u1 u2 -- ) cr dup 2 * 2 .r space dup rot swap - 2 * spaces dup boxes ." |" boxes ;
|
|
|
|
: haxise ( uw ur -- , Print horizontal axis for edge-centered circle
|
|
uw: centering field width
|
|
ur: circle radius )
|
|
cr
|
|
tuck 2 * 3 + - 2 / spaces
|
|
2 * 1+ dup
|
|
0 u+do [char] - emit loop
|
|
[char] + emit
|
|
0 u+do [char] - emit loop
|
|
;
|
|
|
|
: haxisb ( uw ur -- , Print horizontal axis for block-centered circle
|
|
uw: centering field width
|
|
ur: circle radius )
|
|
cr
|
|
tuck 4 * 1+ - 2 / spaces [char] - emit
|
|
1- dup
|
|
0 u+do ." [-" loop
|
|
." [+]"
|
|
0 u+do ." -]" loop
|
|
[char] - emit
|
|
;
|
|
|
|
: proline ( u -- ) cr dup 2 .r space ." +]" 1- boxes ;
|
|
|
|
\ mccirce -- Blocks in edge-centered circle with radius ur blocks
|
|
: mccirce { ur -- }
|
|
ur 0 u+do
|
|
0 lr !
|
|
ur 0 u+do
|
|
\ j dup * i dup * +
|
|
\ s>d d>f fsqrt
|
|
j 10 * 5 + dup * i 10 * 5 + dup * +
|
|
s>d d>f 1e2 f/ fsqrt
|
|
f>d d>s ur < if
|
|
1 lr +!
|
|
then
|
|
loop
|
|
ur lr @ prline2
|
|
loop
|
|
cr
|
|
;
|
|
|
|
: mccircei { ur -- }
|
|
ur 0 u+do
|
|
0 lr !
|
|
ur 0 u+do
|
|
ur j - 10 * 5 - dup * i 10 * 5 + dup * +
|
|
s>d d>f 1e2 f/ fsqrt
|
|
f>d d>s ur < if
|
|
1 lr +!
|
|
then
|
|
loop
|
|
lr @
|
|
dup ur swap prline2
|
|
loop
|
|
haxise
|
|
ur 0 u+do
|
|
ur swap prline2
|
|
loop
|
|
;
|
|
|
|
\ mccircb -- Blocks in block-centered circle with radius ur blocks
|
|
: mccircb { ur -- }
|
|
ur 0 u+do
|
|
0 lr !
|
|
ur 0 u+do
|
|
j 10 * 5 + dup * i 10 * 5 + dup * +
|
|
s>d d>f 1e2 f/ fsqrt
|
|
f>d d>s ur 1+ < if
|
|
1 lr +!
|
|
then
|
|
loop
|
|
lr @ i if prline else proline then
|
|
loop
|
|
cr
|
|
;
|
|
|
|
\ mccirc -- Blocks in circle with diameter ud blocks
|
|
: mccirc { ud -- }
|
|
ud 2 mod if
|
|
ud 2 / 1+ mccircb
|
|
else
|
|
ud 2 / mccirce
|
|
then
|
|
;
|