(*---------------------------------------------------------------------------
    :Program.    CloudsAGA.mod
    :Author.     Daniel Amor
    :Address.    Ludwigstr. 124, D-70197 Stuttgart
    :Shortcut.   [da]
    :Version.    2.0
    :Date.       01-Feb-94
    :Copyright.  PD
    :Language.   Oberon-2
    :Translator. Amiga Oberon 3.0
    :Imports.    Clouds [da].
    :Contents.   Erzeugt Fraktal-Wolken.
    :Remark.     Aufruf: Clouds
---------------------------------------------------------------------------*)

MODULE Clouds;

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)

IMPORT  e    : Exec,
        d    : Dos,
        I    : Intuition,
        gt   : GadTools,
        g    : Graphics,
        req  : Requests,
        GUI  : CloudsGUI,
        u    : Utility,
        r    : Random,
        y    : SYSTEM,
        pal  : Palette,
        str  : Strings,
               IFF,ASL;

CONST UntereFarbe   = 4;

VAR quit,open,gOK                 : BOOLEAN;
    msgptr,msgptr1,msgptr2        : I.IntuiMessagePtr;
    msg,msg1,msg2                 : I.IntuiMessage;
    item1,item2                   : I.MenuItemPtr;
    aktgad1,aktgad2               : I.GadgetPtr;
    vp                            : g.ViewPortPtr;
    nummer,farbe,na,fonty,size,version    : INTEGER;
    win                           : I.WindowPtr;
    depth,resx,resy               : LONGINT;
    key                           : CHAR;
    wx,wy,ObereFarbe,MittlereFarbe: INTEGER;
    VERSION                       : ARRAY 90 OF CHAR;
    Col                           : pal.colourRecord;

PROCEDURE FileReq(hail: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; win : I.WindowPtr): BOOLEAN;

VAR i,j       : INTEGER;
    Dirname   : ARRAY 256 OF CHAR;
    Filename  : ARRAY 356 OF CHAR;
    flags     : LONGINT;
    res       : BOOLEAN;
    fr        : ASL.FileRequesterPtr;
    pattern   : ARRAY 80 OF CHAR;

BEGIN
  j := SHORT(str.Length(name));
  WHILE (j>=0) & (name[j]#":") & (name[j]#"/") DO DEC(j) END;
  i := 0;
  WHILE i<=j DO Dirname[i] := name[i]; INC(i) END; Dirname[i] := 0X;
  j := 0;
  REPEAT Filename[j] := name[i]; INC(j); INC(i) UNTIL name[i-1]=0X;
  fr := ASL.AllocAslRequestTags(ASL.fileRequest, u.done);
  IF fr=NIL THEN HALT(20) END;
  flags := ASH(1,ASL.patGad);
  INC(flags,ASH(1,ASL.save));
  res := ASL.AslRequestTags(fr, ASL.hail,     y.ADR(hail),
                                ASL.file,     y.ADR(Filename),
                                ASL.dir,      y.ADR(Dirname),
                                ASL.window,   win,
                                ASL.pattern,  y.ADR(pattern),
                                ASL.funcFlags,flags,
                                u.done);
  COPY(fr.dir^,Dirname);
  COPY(fr.file^,Filename);

  i := SHORT(str.Length(Dirname));
  IF (i>0) & (Dirname[i-1]#"/") & (Dirname[i-1]#":") THEN
    Dirname[i] := "/"; INC(i);
    Dirname[i] := 0X;
  END;
  IF LEN(name)>i+str.Length(Filename) THEN
    COPY(Dirname,name);
    str.Append(name,Filename);
    RETURN TRUE;
  END;
  RETURN FALSE;
END FileReq;

PROCEDURE OpenWindow (left,top,width,height: LONGINT; VAR win: I.WindowPtr);

VAR quit: BOOLEAN;

BEGIN
  IF height<resy-GUI.FontY THEN top:=GUI.FontY+3 END;
  win := I.OpenWindowTagsA ( NIL,
                    I.waLeft,          left,
                    I.waTop,           top,
                    I.waWidth,         width,
                    I.waHeight,        height,
                    I.waIDCMP,         LONGSET {I.closeWindow,I.refreshWindow,I.vanillaKey,I.menuPick},
                    I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.activate,I.newLookMenus},
                    I.waTitle,         y.ADR ("Generating..."),
                    I.waScreenTitle,   y.ADR ("CloudsAGA 2.0 © Danny Amor in 1994"),
                    I.waPubScreen,     GUI.Scr,
                    I.waMinWidth,      67,
                    I.waMinHeight,     21,
                    I.waMaxWidth,      656,
                    I.waMaxHeight,     414, u.done);

  gt.RefreshWindow (win, NIL);
END OpenWindow;

PROCEDURE CloseWindow (VAR win: I.WindowPtr);

BEGIN
  IF win # NIL THEN
    I.CloseWindow (win);
    win := NIL;
  END;
END CloseWindow;

PROCEDURE TestF(VAR farbe: INTEGER);

BEGIN
  IF farbe>ObereFarbe  THEN farbe:=ObereFarbe;  END;
  IF farbe<UntereFarbe THEN farbe:=UntereFarbe; END;
END TestF;

PROCEDURE RandomFarbe(VAR Rp: g.RastPortPtr; Start: INTEGER; VAR mf: REAL; x,y: INTEGER);

VAR farbe: INTEGER;
    OK   : BOOLEAN;

BEGIN
  farbe:=SHORT(Start+SHORT(mf*(r.RND(1)*LONG(2)-1))+1);
  TestF(farbe);
  g.SetAPen(Rp,farbe);
  OK:=g.WritePixel(Rp,x+4,y+fonty);
END RandomFarbe;

PROCEDURE Cloud(numiter: INTEGER; mu: REAL; na: INTEGER);

TYPE Coord = ARRAY 11 OF INTEGER;

VAR i,j,k,l,x1,y1,x2,y2,x3,y3,smul1,smul2,p  : INTEGER;
    xy                                       : Coord;
    n,n1,farbe,nk,test,test2                 : INTEGER;
    farbe1,farbe2,farbe3,farbe4              : LONGINT;
    mf                                       : REAL;

  PROCEDURE BigPic(n,i: INTEGER; VAR n1,l: INTEGER);

  BEGIN
   n1:=n DIV 2;
   l:=y.LSH(LONG(1),i);
  END BigPic;

  PROCEDURE SetEdge(VAR Rp: g.RastPortPtr; x1,y1,x2,y2,x3,y3: INTEGER; VAR mf: REAL);

  BEGIN
    farbe1:=g.ReadPixel(Rp,x1+4,y1+fonty);
    farbe2:=g.ReadPixel(Rp,x2+4,y2+fonty);
    RandomFarbe(Rp,SHORT(farbe1+farbe2) DIV 2,mf,x3,y3);
  END SetEdge;

 PROCEDURE SetPoint(VAR Rp: g.RastPortPtr; VAR mf: REAL; VAR xy: Coord);

  VAR a: BOOLEAN;

  BEGIN
    farbe1:=g.ReadPixel(Rp,xy[1]+4,xy[2]+fonty);
    farbe2:=g.ReadPixel(Rp,xy[3]+4,xy[4]+fonty);
    farbe3:=g.ReadPixel(Rp,xy[5]+4,xy[6]+fonty);
    farbe4:=g.ReadPixel(Rp,xy[7]+4,xy[8]+fonty);
    farbe:=SHORT(((farbe1+farbe2+farbe3+farbe4) DIV 4)+SHORT(r.RND(2)*2*mf-mf));
    TestF(farbe);
    g.SetAPen(Rp,farbe);
    a:=g.WritePixel(Rp,xy[9]+4,xy[10]+fonty);
  END SetPoint;

BEGIN
  mf:=(numiter+1)*mu;
  RandomFarbe(win^.rPort,MittlereFarbe,mf,0,  0);
  RandomFarbe(win^.rPort,MittlereFarbe,mf,0, na);
  RandomFarbe(win^.rPort,MittlereFarbe,mf,na, 0);
  RandomFarbe(win^.rPort,MittlereFarbe,mf,na,na);
  n:=na;
  test:=1;
  FOR i:=0 TO numiter DO
    mf:=(numiter-i+1)*mu;
    BigPic(n,i,n1,l);
    FOR j:=1 TO l DO
      smul1:=(j-1)*n;
      smul2:=j*n;
      SetEdge(win^.rPort,smul1,0    ,smul2,0    ,smul2-n1,0       ,mf);
      SetEdge(win^.rPort,smul1,na   ,smul2,na   ,smul2-n1,na      ,mf);
      SetEdge(win^.rPort,0    ,smul1,0    ,smul2,0       ,smul2-n1,mf);
      SetEdge(win^.rPort,na   ,smul1,na   ,smul2,na      ,smul2-n1,mf);
    END;
    n:=n1;
  END;
  n:=na;
  FOR i:=0 TO numiter DO
    mf:=(numiter-i+1)*mu;
    BigPic(n,i,n1,l);
    FOR k:=1 TO l DO
      FOR j:=1 TO l DO
        smul1:=k*n;   smul2:=j*n;
        xy[1]:=smul2-n; xy[2]:=smul1-n; xy[3]:=smul2-n;
        xy[4]:=smul1  ; xy[5]:=smul2  ; xy[6]:=smul1-n;
        xy[7]:=smul2  ; xy[8]:=smul1  ; xy[9]:=smul2-n1;
        xy[10]:=smul1-n1;
        SetPoint(win^.rPort,mf,xy);
      END;
    END;
    nk:=0;
    FOR k:=1 TO test DO
      nk:=1-nk;
      test2:=y.LSH(LONG(1),i)-nk;
      FOR j:=1 TO test2 DO
        smul1:=j*n+nk*n1;   smul2:=k*n1;
        xy[1]:=smul1-n1; xy[2]:=smul2-n1; xy[3]:=smul1;
        xy[4]:=smul2   ; xy[5]:=smul1-n1; xy[6]:=smul2+n1;
        xy[7]:=smul1-n ; xy[8]:=smul2   ; xy[9]:=smul1-n1;
        xy[10]:=smul2;
        SetPoint(win^.rPort,mf,xy);
      END;
    END;
    n:=n1;
    test:=((test+1)*2)-1;
  END;
  I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 2.0 © Danny Amor in 1994"));
END Cloud;

PROCEDURE SizeOut(VAR na: INTEGER; faktor,size: INTEGER);

VAR numiter: INTEGER;
    mu     : REAL;

BEGIN
  numiter:=size+5;
  faktor:=size+2;
  na:=y.LSH(LONG(64),size);
  mu:=2.5-faktor/5;
  Cloud(numiter,mu,na);
END SizeOut;

PROCEDURE Smooth(VAR na: INTEGER);

VAR y1,x,farbe                 : INTEGER;
    a                          : BOOLEAN;
    farbe1,farbe2,farbe3,farbe4: LONGINT;

BEGIN
  I.SetWindowTitles(win,y.ADR("Smoothing..."),y.ADR("CloudsAGA 2.0 © Danny Amor in 1994"));
  FOR y1:=0 TO na-1 DO
    FOR x:=0 TO na-1 DO
      farbe1:=g.ReadPixel(win^.rPort,x+4,y1+fonty);
      farbe2:=g.ReadPixel(win^.rPort,x+5,y1+fonty);
      farbe3:=g.ReadPixel(win^.rPort,x+4,y1+1+fonty);
      farbe4:=g.ReadPixel(win^.rPort,x+5,y1+1+fonty);
      farbe :=SHORT(SHORT((farbe1+farbe2+farbe3+farbe4)/4));
      g.SetAPen(win^.rPort,farbe);
      a:=g.WritePixel(win^.rPort,x+4,y1+fonty);
    END;
  END;
  I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 2.0 © Danny Amor in 1994"));
END Smooth;

PROCEDURE SetColors(VAR vp: g.ViewPortPtr);

VAR i: INTEGER;

BEGIN
  g.SetRGB4(vp,0,10,10,10);
  g.SetRGB4(vp,1,0,0,0);
  g.SetRGB4(vp,2,15,15,15);
  g.SetRGB4(vp,3,6,8,11);
  IF version<39 THEN
    FOR i:= 4 TO 19 DO g.SetRGB4(vp,i,i-4,i-4,15); END;
    g.SetRGB4(vp,20,11,11,11);
    FOR i:=21 TO 31 DO g.SetRGB4(vp,i,(i DIV 2)-1,(i DIV 2)-1,(i DIV 2)); END;
  END;
END SetColors;

PROCEDURE ClickNull(VAR size: INTEGER);

BEGIN
  INC(size);
  IF size>5 THEN size:=0; END;
  gt.SetGadgetAttrs(GUI.CloudsGadgets[0]^,GUI.CloudsWnd,NIL,gt.cyActive,size);
END ClickNull;

PROCEDURE ClickOne(VAR x,y1: INTEGER);

BEGIN
  x:=y.LSH(LONG(64),size);
  y1:=x;
  x:=x+10;
  y1:=y1+fonty+4;
  OpenWindow(0,0,x,y1,win);
  open:=TRUE;
  I.WindowToFront(GUI.CloudsWnd);
  SizeOut(na,4,size);
END ClickOne;

PROCEDURE ClickFour(x,y1: INTEGER);

VAR Ok   : BOOLEAN;
    Name : ARRAY 80 OF CHAR;
    xm,ym: LONGINT;

BEGIN
  Name:="RAM:Clouds_1.IFF";
  Ok:=FileReq("Save Clouds as...",Name,win);
  IF Ok THEN
    I.SetWindowTitles(win,y.ADR("Saving..."),y.ADR("CloudsAGA 2.0 © Danny Amor in 1994"));
    I.WindowToBack(GUI.CloudsWnd);
    xm:=win^.leftEdge DIV 8+(x DIV 8)+1;
    ym:=win^.topEdge+y1;
    IF xm>resx THEN xm:=(x DIV 8)+1-(xm-resx); END;
    IF ym>resy THEN ym:=y1-(ym-resy); END;
    req.Assert(IFF.SaveClip(y.ADR(Name),win^.rPort.bitMap,win^.wScreen^.viewPort.colorMap.colorTable,1,win^.leftEdge DIV 8,win^.topEdge,xm,ym),"Couldn't save picture!");
    I.WindowToFront(GUI.CloudsWnd);
    I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 2.0 © Danny Amor in 1994"));
  END;
END ClickFour;

PROCEDURE DoColours;

BEGIN
  ObereFarbe:=y.LSH(LONG(1),depth)-1;
  MittlereFarbe:=(ObereFarbe DIV 2)+SHORT(depth);
END DoColours;

PROCEDURE ClickFive(VAR vp: g.ViewPortPtr);

VAR doit: BOOLEAN;

BEGIN
  doit:=TRUE;
  IF open THEN doit:=req.Request("Change Screenmode:","Do you want to restart with another\nresolution (this pic will be killed)?","OK","Cancel"); END;
  IF doit THEN
    CloseWindow(win);
    pal.ClosePaletteWindow;
    GUI.CloseCloudsWindow(GUI.CloudsWnd);
    GUI.CloseDownScreen(GUI.Scr);
    req.Assert(GUI.SetupScreen(depth,resx,resy)=0,"Unable to open screen!");
    Col.AGACol[0]:=NIL;
    DoColours;
    vp:=y.ADR(GUI.Scr^.viewPort);
    fonty:=GUI.FontY+3;
    SetColors(vp);
    size:=0;
    req.Assert(GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr)=0,"Unable to open window!");
    open      := FALSE;
    quit      := FALSE;
  END;
END ClickFive;

PROCEDURE WaitUntilClosedInfo;

VAR msg: I.IntuiMessagePtr;

BEGIN
  e.WaitPort(GUI.InfoReqWnd.userPort);
  msg:=e.GetMsg(GUI.InfoReqWnd.userPort);
  e.ReplyMsg(msg);
  GUI.CloseInfoReqWindow;
END WaitUntilClosedInfo;

PROCEDURE CheckKey(code: INTEGER);

VAR key: CHAR;

BEGIN
  key:=CAP(CHR(code));
  IF  key="Z"                 THEN ClickNull(size);   END;
  IF (key="C") AND (NOT open) THEN ClickOne(wx,wy);   END;
  IF  key="P"                 THEN pal.ShowPalette(GUI.Scr,Col,4); END;
  IF (key="M") AND open       THEN Smooth(na); END;
  IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
  IF  key="R"                 THEN ClickFive(vp);     END;
END CheckKey;

PROCEDURE ChangePalette(VAR Scr: I.ScreenPtr; Number: INTEGER);

VAR colours: ARRAY 386 OF LONGINT;
    vp     : g.ViewPortPtr;
    i,j    : INTEGER;

BEGIN
  vp:=y.ADR(Scr^.viewPort);
  IF Number=0 THEN
    IF depth=5 THEN g.LoadRGB32(vp,GUI.colours32); END;
    IF depth=6 THEN g.LoadRGB32(vp,GUI.colours64); END;
    IF depth=7 THEN g.LoadRGB32(vp,GUI.colours128); END;
  END;
  IF Number=1 THEN
    IF depth=5 THEN j:=31; END;
    IF depth=6 THEN j:=45; END;
    IF depth=7 THEN j:=72; END;
    FOR i:=4 TO j DO
      g.SetRGB32(vp,i,0F0000000H,LONG(255 DIV (j-4))*i*001000000H,0);
    END;
  END;
  IF Number=2 THEN
    IF depth=5 THEN j:=31; END;
    IF depth=6 THEN j:=45; END;
    IF depth=7 THEN j:=72; END;
    FOR i:=4 TO j DO
      g.SetRGB32(vp,i,LONG(255 DIV (j-4))*i*001000000H,LONG(255 DIV (j-4))*i*001000000H,LONG(255 DIV (j-4))*i*001000000H);
    END;
  END;
  IF Number=3 THEN
    IF depth=5 THEN j:=31; END;
    IF depth=6 THEN j:=45; END;
    IF depth=7 THEN j:=72; END;
    FOR i:=4 TO j DO
      g.SetRGB32(vp,i,0,LONG(255 DIV (j-4))*i*001000000H,0);
    END;
  END;
END ChangePalette;

BEGIN
  VERSION := "$VER: CloudsAGA 2.0 (02.01.95) by Daniel Amor, Ludwigstr. 124, 70197 Stuttgart, Germany";
  version := g.gfx.libNode.version;
  depth   := 5;
  req.Assert (GUI.SetupScreen(depth,resx,resy) = 0, "Unable to open screen!");
  req.Assert (GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr) = 0, "Unable to open window!");
  quit    := FALSE;
  open    := FALSE;
  DoColours;
  vp:=y.ADR(GUI.Scr^.viewPort);
  SetColors(vp);
  fonty:=GUI.FontY+3;
  size:=0;
  REPEAT
    IF open THEN
      quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
                                           win.userPort.sigBit,
                                           d.ctrlC}))
    ELSE
      quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
                                           d.ctrlC}));
    END;
    msgptr1 := gt.GetIMsg (GUI.CloudsWnd.userPort);
    IF msgptr1 # NIL THEN
      msg1 := msgptr1^;
      gt.ReplyIMsg (msgptr1);

      IF (I.closeWindow IN msg1.class) THEN
        quit := req.RequestWin("Clouds Requester","Do you really want to quit?","Yes","No",GUI.CloudsWnd);
      END;
      IF (I.gadgetUp IN msg1.class) THEN
        aktgad1:=msg1.iAddress;
        nummer:=aktgad1.gadgetID;
        IF  nummer=GUI.GDSize                   THEN size:=msg1.code; END;
        IF (nummer=GUI.GDCreate) AND (NOT open) THEN ClickOne(wx,wy);  END;
        IF  nummer=GUI.GDAnimate                THEN pal.ShowPalette(GUI.Scr,Col,4); END;
        IF (nummer=GUI.GDSmooth) AND open       THEN Smooth(na); END;
        IF (nummer=GUI.GDSave) AND open         THEN ClickFour(wx,wy); END;
        IF  nummer=GUI.GDScreen                 THEN ClickFive(vp); END;
        IF  nummer=GUI.GDMaterial               THEN ChangePalette(GUI.Scr,msg1.code); END;
      END;
      IF (I.vanillaKey IN msg1.class) THEN CheckKey(msg1.code); END;
      IF (I.menuPick IN msg1.class) THEN
        IF I.MenuNum(msg1.code)=0 THEN
          IF I.ItemNum(msg1.code)=0 THEN
            req.Assert(GUI.OpenInfoReqWindow()=0, "Unable to open Info-Requester!");
            WaitUntilClosedInfo;
          END;
          IF I.ItemNum(msg1.code)=2 THEN
            quit := req.RequestWin("Clouds Requester","Do you really want to quit?","Yes","No",GUI.CloudsWnd);
          END;
        END;
      END;
    ELSE
      IF NOT quit THEN
        msgptr2 := gt.GetIMsg (win.userPort);
        IF msgptr2 # NIL THEN
          msg2 := msgptr2^;
          gt.ReplyIMsg (msgptr2);

          IF (I.vanillaKey IN msg2.class) THEN CheckKey(msg2.code); END;
          IF (I.closeWindow IN msg2.class) THEN
            CloseWindow(win);
            open := FALSE;
          END;
        END;
      END;
    END;
  UNTIL quit;
CLOSE
  CloseWindow(win);
  GUI.CloseCloudsWindow(GUI.CloudsWnd);
  pal.ClosePaletteWindow;
  GUI.CloseDownScreen(GUI.Scr);
END Clouds.