(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia set with distance formula.
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Tuesday, December 30, 2003 1:40 PM, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -juldist "ÄÄÄ Julia set distance  Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Julia set with distance formula.
*)
ENDDOC

-- Parameters 
 0.11031e FVALUE Aa
 0.67037e FVALUE Bb
 1.4e     FVALUE delH 
 1.4e     FVALUE delV 
    0      VALUE pcol

-- Globals
       0. DVALUE @XY   PRIVATE


: COLORIZE ( F: s1 u v -- ) ( ix -- )
		0e 0e 0e FLOCALS| s4 s3 s2 vv uu s1 |
		s1 FLOG TO s2
		uu FSQR vv FSQR F+ FSQRT TO s3
		s2 ( ix -- ) 2^x S>F F/ FEXP TO s4
		s1 FSQRT s2 F*  s3 s4 F* F/ ( F: -- dist )
		delH  Xmax S>F F/ F< IF  @XY pcol SET-MDOT  ENDIF ;P

: INNERLOOP ( x y -- ) 
		2DUP TO @XY UNSCALE? DROP FLOCALS| yy xx |
		0e 0e 0e 0e 0e 1e FLOCALS| uu vv u1 v1 x1 y1 |
		#400 0 DO  xx FSQR yy FSQR F- Aa F+ TO x1
			   xx yy F* F2*       Bb F+ TO y1
			   uu xx F* vv yy F* F- F2* TO u1
			   uu yy F* vv xx F* F+ F2* TO v1
			   x1 TO xx  y1 TO yy  
			   u1 TO uu  v1 TO vv
			   xx FSQR yy FSQR F+ 1e-10 F+ 
			   FDUP 256e F> IF  uu vv I COLORIZE LEAVE
			   	      ELSE  FDROP 
				     ENDIF
		     LOOP ;P

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF  
		0 0 Xmax Ymax  delH FNEGATE delV FNEGATE delH delV  SET-GWINDOW
		GCLEAR pcol 0 = IF  Red TO pcol ENDIF
		RESET-MDOTS
		  Xmax 0 ?DO  Ymax 0 ?DO  J I INNERLOOP  LOOP  LOOP
		FLUSH-MDOTS
		R> IF  TEXT  ENDIF ;

:ABOUT		CR ." Type COMPUTE for a Julia fractal."
		CR
		CR ."  1.4e TO delH  1.4e TO delV -- zoom picture "
		CR
		CR ." Example parameters: "
		CR ." -1.754878e TO Aa  0e        TO Bb COMPUTE "
		CR ." -1.543689e TO Aa  0e        TO Bb COMPUTE " 
		CR ." 5e 4e F/   TO Aa  0e        TO Bb COMPUTE " 
		CR ." -1e        TO Aa  0e        TO Bb COMPUTE " 
		CR ." -0.75e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.3e      TO Aa  0e        TO Bb COMPUTE "
		CR ." -0.122561e TO Aa  0.744862e TO Bb COMPUTE "
		CR ." -0.101096e TO Aa  0.956287e TO Bb COMPUTE "
		CR ."  0.11e     TO Aa  0.67e     TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0.25e     TO Bb COMPUTE "
		CR ." -0.318472e TO Aa  0.041257e TO Bb COMPUTE " ;

                .ABOUT -juldist CR

		DEPRIVE

                              (* End of Source *)