116 lines
3.0 KiB
Forth
Executable File
116 lines
3.0 KiB
Forth
Executable File
\ mccirc.fs - Minecraft circle block calculator
|
|
|
|
variable UD \ Plotting circle diameter in blocks
|
|
variable UR \ Plotting circle radius in blocks
|
|
variable FB \ Plotting circle block-centered flag (FALSE => edge-centered)
|
|
variable UW \ Centering field width in characters
|
|
variable USC \ Current semi-chord length in blocks
|
|
|
|
\ Graphic elements
|
|
create C-BOX \ [] box
|
|
2 c, 91 c, 93 c,
|
|
create C-ORGB \ [+] origin (box-centered)
|
|
3 c, 91 c, 43 c, 93 c,
|
|
create C-AXVB \ [|] vert. axis (box-centered)
|
|
3 c, 91 c, 124 c, 93 c,
|
|
create C-AXHLB \ [- horiz. axis left (box-centered)
|
|
2 c, 91 c, 45 c,
|
|
create C-AXHRB \ -] horiz. axis right (box-centered)
|
|
2 c, 45 c, 93 c,
|
|
create C-ORGE \ + origin (edge-centered)
|
|
1 c, 43 c,
|
|
create C-AXVE \ | vert. axis (edge-centered)
|
|
1 c, 124 c,
|
|
create C-AXHE \ -- horiz. axis (edge-centered)
|
|
2 c, 45 c, 45 c,
|
|
|
|
: cstype ( c-elem -- , type counted string C-ELEM )
|
|
count type ;
|
|
|
|
: multype ( u c-elem -- , type counted string C-ELEM U times )
|
|
count rot
|
|
1 u+do 2dup type loop
|
|
type
|
|
;
|
|
|
|
: b>c ( ub -- uc , Convert blocks UB to char. width UC )
|
|
2* ;
|
|
|
|
: chrdblk ( usc -- ub : Calculate blocks in chord UB with semi-chord length USC )
|
|
2* FB @ if 1+ then ;
|
|
|
|
: chord ( uw usc -- : Print horizontal circle chord with length 2*USC centere in field UW chars )
|
|
tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( usc um )
|
|
tuck cr spaces ( um usc )
|
|
dup C-BOX multype
|
|
FB @ if C-AXVB else C-AXVE then cstype
|
|
dup C-BOX multype
|
|
swap 2 + spaces chrdblk .
|
|
;
|
|
|
|
: haxis ( uw ur -- : Print horizontal axis )
|
|
tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( ur um )
|
|
tuck cr spaces dup dup
|
|
FB @ if
|
|
C-AXHLB multype
|
|
C-ORGB cstype
|
|
C-AXHRB multype
|
|
else
|
|
C-AXHE multype
|
|
C-ORGE cstype
|
|
C-AXHE multype
|
|
then
|
|
FB @ if swap 2 + spaces chrdblk . else 2drop then
|
|
;
|
|
|
|
: fincircle ( uy ux -- f : Determine if block UX,UY is within circle - Global: UR )
|
|
10 * 5 + swap 10 * 5 +
|
|
dup * swap dup * +
|
|
s>d d>f 1e2 f/ fsqrt f>d d>s
|
|
UR @ <
|
|
;
|
|
|
|
: scircle ( ud -- : Plot semicircle with diameter UD blocks -- Globals: UD, UR, FB, UW, USC )
|
|
dup UD !
|
|
dup 2/ UR !
|
|
dup 2 mod FB !
|
|
b>c FB @ invert if 1+ then UW !
|
|
UW @ UR @ haxis
|
|
FB @ invert if UW @ UR @ chord then
|
|
UR @ 1 u+do
|
|
1 USC !
|
|
UR @ 1 u+do
|
|
j i fincircle if 1 USC +! then
|
|
loop
|
|
UW @ USC @ chord
|
|
loop
|
|
;
|
|
|
|
: circle ( ud -- : Plot circle with diameter UD blocks -- Globals: UD, UR, FB, UW, USC )
|
|
dup UD !
|
|
dup 2/ UR !
|
|
dup 2 mod FB !
|
|
b>c 1+ UW !
|
|
UR @ 1 u+do
|
|
1 USC !
|
|
UR @ 1 u+do
|
|
UR @ j - i fincircle if 1 USC +! then
|
|
loop
|
|
USC @
|
|
dup UW @ swap chord
|
|
loop
|
|
FB @ invert if UW @ UR @ chord then
|
|
UW @ UR @ haxis
|
|
FB @ invert if UW @ UR @ chord then
|
|
UR @ 1 u+do UW @ swap chord loop
|
|
;
|
|
|
|
: hsphere ( ud -- , plot layers of hemisphere with block diameter UD )
|
|
|
|
;
|
|
|
|
: ellipse ( umaj umin -- , plot ellipse with major axis UMAJ blocks and minor axis UMIN blocks )
|
|
|
|
;
|
|
|