|##########|
|#MAGIC   #|BNDLOMHL
|#PROJECT #|"Fraktalus"
|#PATHS   #|"StdProject"
|#FLAGS   #|xx---x--x---x-x-----------------
|#USERSW  #|--------------------------------
|#USERMASK#|--------------------------------
|#SWITCHES#|x----x----------
|##########|
MODULE Fraktalus;

(* $A- $S- $R- $V- $N- *)

FROM System     IMPORT LONGSET;
FROM GfxScreen  IMPORT Screen,OpenScreen,CloseScreen,Palette,SetPalette,
                       ScreenHeight;
FROM GfxDraw    IMPORT SetAPen,SetBPen,ClearScreen,AreaMove,AreaDraw,AreaEnd,
                       AreaRectangle;
FROM GfxInput   IMPORT MousePressed,GetMousePos,UserActions,UserAct,CheckUser,
                       GetKey,WaitUser,MouseClick;
FROM Resources  IMPORT New;
FROM Hardware   IMPORT Custom;

TYPE
$$IF MC68881 THEN
  FFP=REAL;
$$END
  Fractal = RECORD
              data : POINTER TO ARRAY [0..128],[0..128] OF FFP;
              step : INTEGER;
              rnd  : FFP;
            END;
   Vector3= ARRAY [0..2] OF FFP;

VAR Seed  : ARRAY [0..5] OF LONGINT;
    Light : Vector3;
    Scr   : Screen;

PROCEDURE RND():FFP;
IMPORT Random;
BEGIN
  RETURN FFP(Random.RND(65536))/65536.0;
END RND;

PROCEDURE StepIn(VAR Fract : Fractal;smooth : FFP);
VAR x,y,
    step,
    hstep  : INTEGER;
    rnd,
    high,
    middle : FFP;

  (* $W- *)
  PROCEDURE CalcNew(p1 IN 2,p2 IN 3 : FFP):FFP;
  BEGIN
    RETURN (p1+p2)*0.5+rnd*(2*RND()-1.);
  END CalcNew;

BEGIN
  step:=Fract.step;
  rnd:=Fract.rnd;
  hstep:=step DIV 2;

  WITH Fract.data^ AS fd DO
    x:=0;
    REPEAT
      y:=0;
      REPEAT
        fd[x+hstep,y+hstep]:=(fd[x,y+step]+fd[x,y]+fd[x+step,y]+fd[x+step,y+step])*0.25;
        INC(y,step);
      UNTIL y>=128;
      INC(x,step);
    UNTIL x>=128;
    x:=step;
    WHILE x<128 DO
      y:=hstep;
      REPEAT
        fd[x,y]:=(fd[x-hstep,y]+fd[x+hstep,y]+fd[x,y-hstep]+fd[x,y+hstep])*0.25+rnd*(2*RND()-1);
        INC(y,step);
      UNTIL y>=128;
      INC(x,step);
    END;
    x:=hstep;
    REPEAT
      y:=step;
      WHILE y<128 DO
        fd[x,y]:=(fd[x-hstep,y]+fd[x+hstep,y]+fd[x,y-hstep]+fd[x,y+hstep])*0.25+rnd*(2*RND()-1);
        INC(y,step);
      END;
      INC(x,step);
    UNTIL x>=128;
    x:=0;
    REPEAT
      y:=0;
      REPEAT
        (* $W- *)
        WITH fd[x+hstep,y+hstep] AS ff DO
          ff:=ff+rnd*(2*RND()-1);
        END;
        INC(y,step);
      UNTIL y>=128;
      INC(x,step);
    UNTIL x>=128;
  END;
  Fract.step:=hstep;
  Fract.rnd:=rnd*smooth;
END StepIn;

PROCEDURE NormLight;
VAR r : FFP;
BEGIN
  r:=SQRT(Light[0]*Light[0]+Light[1]*Light[1]+Light[2]*Light[2]);
  Light[0]:=Light[0]/r;
  Light[1]:=Light[1]/r;
  Light[2]:=Light[2]/r;
END NormLight;

(* $W- $E- $L- *)
PROCEDURE LightOf(VAR v IN 8 : Vector3;max IN 3 : INTEGER):INTEGER;
VAR h IN 2 : FFP;
    d IN 4 : INTEGER;
BEGIN
  h:=SQRT(v[0]*v[0]+v[1]*v[1]+v[2]*v[2]);
  h:=(v[0]*Light[0]+v[1]*Light[1]+v[2]*Light[2])/h;
  d:=INTEGER(FFP(max)*h+0.5);
  IF d<0 THEN d:=0 OR_IF d>max THEN d:=max END;
  RETURN d
END LightOf;

PROCEDURE Draw(VAR Frac : Fractal);
VAR step,
    x,y   : INTEGER;
    rstep,
    qstep : FFP;
    vec   : Vector3;
    h1,h2,h3 : FFP;
BEGIN
  SetBPen(Scr,0);
  ClearScreen(Scr);
  SetAPen(Scr,16);
  AreaRectangle(Scr,0,128,319,ScreenHeight(Scr)-1);
  step:=Frac.step;
  rstep:=FFP(step);
  qstep:=rstep*rstep;
  y:=0;
  REPEAT
    x:=0;
    REPEAT
      h1:=Frac.data^[x,y];
      h2:=Frac.data^[x+step,y];
      h3:=Frac.data^[x,y+step];
      vec[0]:=-rstep*(h2-h1);
      vec[1]:=-rstep*(h3-h1);
      vec[2]:=qstep;
      IF h1>=-20. THEN
        IF h1>20. THEN
          SetAPen(Scr,LightOf(vec,14)+1);
        ELSE
          SetAPen(Scr,LightOf(vec,14)+17);
        END;
        AreaMove(Scr,LMUL(x     ,320) SHR 7,128+y         -INTEGER(h1));
        AreaDraw(Scr,LMUL(x+step,320) SHR 7,128+y         -INTEGER(h2));
        AreaDraw(Scr,LMUL(x     ,320) SHR 7,128+(y+step)  -INTEGER(h3));
        AreaEnd(Scr);
      END;
      h1:=Frac.data^[x+step,y+step];
      vec[0]:=rstep*(h3-h1);
      vec[1]:=rstep*(h2-h1);
      vec[2]:=qstep;
      IF h1>=-20. THEN
        IF h1>20. THEN
          SetAPen(Scr,LightOf(vec,14)+1);
        ELSE
          SetAPen(Scr,LightOf(vec,14)+17);
        END;
        AreaMove(Scr,LMUL(x+step,320) SHR 7,128+(y+step)  -INTEGER(h1));
        AreaDraw(Scr,LMUL(x+step,320) SHR 7,128+y         -INTEGER(h2));
        AreaDraw(Scr,LMUL(x     ,320) SHR 7,128+(y+step)  -INTEGER(h3));
        AreaEnd(Scr);
      END;
      INC(x,step);
    UNTIL x>=128;
    INC(y,step)
  UNTIL y>=128;
END Draw;

VAR Fract   : Fractal;
    xx,yy,i : INTEGER;
    Smooth  : FFP;
BEGIN
  Light[0]:=1.0;
  Light[1]:=1.5;
  Light[2]:=1.2;
  NormLight;
  OpenScreen(Scr,5,FALSE,FALSE);
  SetPalette(Scr,Palette:(( 0, 0, 0),( 1, 1, 1),( 2, 2, 2),( 3, 3, 3),
                          ( 4, 4, 4),( 5, 5, 5),( 6, 6, 6),( 7, 7, 7),
                          ( 8, 8, 8),( 9, 9, 9),(10,10,10),(11,11,11),
                          (12,12,12),(13,13,13),(14,14,14),(15,15,15),
                          ( 0, 0,10),( 1, 1, 0),( 2, 2, 0),( 3, 3, 0),
                          ( 4, 4, 0),( 5, 5, 0),( 6, 6, 0),( 7, 7, 0),
                          ( 8, 8, 0),( 9, 9, 0),(10,10, 0),(11,11, 0),
                          (12,12, 0),(13,13, 0),(14,14, 0),(15,15, 0)));

  Seed[1]:=CAST(LONGINT,Custom^.vposr);
  Seed[2]:=REG(15);
  Seed[3]:=$1AAAAA78;
  (* $V- *)
  Seed[2]:=CAST(LONGINT,Custom^.vposr SHL 16);
  (* $V= *)
  Seed[5]:=$10002378;

  Fract.step:=128;
  Fract.rnd:=180.;
  New(Fract.data);

  xx:=128;
  FOR i:=0 TO 128 DO
    Fract.data^[i,0]:=0;
    Fract.data^[i,xx]:=0;
    Fract.data^[0,i]:=0;
    Fract.data^[128,i]:=0;
  END;

  Smooth:=0.2+0.3*RND();

  REPEAT
    IF Fract.step<=16 THEN
      Draw(Fract);
    END;
    StepIn(Fract,Smooth);
  UNTIL Fract.step=1;
  Draw(Fract);
  MouseClick(Scr,xx,yy);
END Fraktalus.