(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Koch line after Lindenmayer
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 13, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -kochlind "ÄÄÄ Koch line           Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Draw the Koch line fractal as a Lindenmayer system. 
*)
ENDDOC

CREATE x  PRIVATE  #2048 CELLS DUP ALLOT	x SWAP ERASE  
CREATE y  PRIVATE  #2048 CELLS DUP ALLOT	y SWAP ERASE  

Green VALUE color

  5   VALUE GMAX  PRIVATE
  0   VALUE NR	  PRIVATE

: contract ( p -- )
		LOCAL ix
		0  y ix 1 + CELL[] !
		1  y ix 2 + CELL[] !
		0  y ix 3 + CELL[] !
		2  y ix 4 + CELL[] !
		0  y ix 5 + CELL[] !
		3  y ix 6 + CELL[] !
		0  y ix 7 + CELL[] ! ;P
      
: (INIT)	1 TO NR
		0 LOCAL p
		x CELL+ 0!
		GMAX 1+ 1 DO	CLEAR p
			 	NR 1+ 
				   1 DO  CASE  x I CELL[] @ 
					   0 OF  p contract  7 +TO p  	  ENDOF
					   1 OF  1 +TO p  1 y p CELL[] !  ENDOF
					   2 OF  1 +TO p  2 y p CELL[] !  ENDOF
					   3 OF  1 +TO p  3 y p CELL[] !  ENDOF
					 ENDCASE	
				   LOOP 
				p TO nr   y x  nr 1+ CELLS MOVE
		        LOOP ;P

: KOCHLIND ( n -- ) 
		5 UMIN TO GMAX ( system order )
		0e 0e FLOCALS| hh ff |
		(INIT)
		TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -0.1e -0.5e  1.1e 0.4e SET-GWINDOW
		 3e  GMAX NEGATE S>F  F** TO hh
		 0e TO ff  
		 0e TO PenX 0e TO PenY
		 NR 1+ 
		    1  DO  CASE x I CELL[] @
			   0 OF  ff FCOS hh F*  PenX F+
			         ff FSIN hh F*  PenY F+ 
				 color DRAW-SCALED-LINE ENDOF
			   1 OF  PI    3e F/ +TO ff   	ENDOF
			   2 OF  PI*2 -3e F/ +TO ff  	ENDOF
			   3 OF  PI    3e F/ +TO ff  	ENDOF
			  ENDCASE 	
		    LOOP
		TEXT ;

:ABOUT		CR ." Try: <+n> KOCHLIND -- n is the system order (n<6)" ;


		.ABOUT -kochlind CR
		DEPRIVE

				(* End of Source *)