\ 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
    3 c, 91 c, 46 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-AXHB 	      	    	\ [-]  horiz. axis (box-centered)
    3 c, 91 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)
    3 c, 45 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 )
    3 * ;

: 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-AXHB multype
	C-ORGB cstype
	C-AXHB 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 FB @ invert if 1+ then 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 )

;