(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Surface
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Friday, December 19, 2003 1:51 PM, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -frsurf "ÄÄÄ Surface projection  Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Draw surface.
*)
ENDDOC

16e FVALUE cc	-- color multiplier, enormous effect.
		--  16e TO cc  ' func1 TO func FRSURF
		-- 128e TO cc  ' func2 TO func FRSURF

:INLINE FREMAINDER ( F: r1 -- r2 ) FDUP F>D D>F F- ;

: FUNC1 ( F: x1 y1 -- z )
		FSWAP FDUP 0.5e F>= IF 1e FROT  F- FSWAP ENDIF FSWAP
		      FDUP 0.5e F>= IF 1e FSWAP F- FSWAP ENDIF
		FMIN ;

: FUNC2	( F: x1 y1 -- z )
		PI F* FCOS  FSWAP PI F* FSIN  F* ;

DEFER FUNC ( F: x1 y1 -- z ) ' FUNC1 IS FUNC

: PLOT8 ( ii jj color -- )
		LOCALS| color jj ii |
		ii 	  jj		Xmax 2/ Ymax 2/ V+ color SET-DOT
		ii NEGATE jj 		Xmax 2/ Ymax 2/ V+ color SET-DOT
		ii NEGATE jj NEGATE	Xmax 2/ Ymax 2/ V+ color SET-DOT
		ii 	  jj NEGATE	Xmax 2/ Ymax 2/ V+ color SET-DOT
		jj 	  ii		Xmax 2/ Ymax 2/ V+ color SET-DOT
		jj NEGATE ii 		Xmax 2/ Ymax 2/ V+ color SET-DOT
		jj NEGATE ii NEGATE	Xmax 2/ Ymax 2/ V+ color SET-DOT
		jj 	  ii NEGATE	Xmax 2/ Ymax 2/ V+ color SET-DOT ;P


: FRSURF	0e 0e 0e FLOCALS| zz yy xx | 
		6 Xmax Ymax MIN 2/ LOCALS| N m |
		TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		N 0 ?DO I 0 ?DO J S>F N S>F F/ TO xx  
				I S>F N S>F F/ TO yy
				1e xx F- TO zz
				m 0 DO  I 2^x S>F xx F* FREMAINDER ( x1)
					I 2^x S>F yy F* FREMAINDER ( y1)
					FUNC 0.5e I S>F F** F* +TO zz
				  LOOP
				J I  zz cc F* F>S STDCOLOR  PLOT8
			   LOOP 
		   LOOP 
		TEXT ;

:ABOUT		CR ." Try: FRSURF" 
		CR
		CR ." Example1:   16e TO cc  ' func1 IS func  FRSURF " 
		CR ." Example2:  128e TO cc  ' func2 IS func  FRSURF " ;

		.ABOUT -frsurf CR
		DEPRIVE

				(* End of Source *)