(*---------------------------------------------------------------------------
    :Program.    CloudsAGA.mod
    :Author.     Daniel Amor
    :Address.    Ludwigstr. 124, D-70197 Stuttgart
    :Shortcut.   [da]
    :Version.    1.0
    :Date.       15-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,
        str  : Strings,IFF,ASL;

CONST UntereFarbe   = 4;

TYPE colourstype32  = ARRAY 86  OF LONGINT;
     colourstype64  = ARRAY 182 OF LONGINT;
     colourstype128 = ARRAY 386 OF LONGINT;
     colourArray    = ARRAY 31 OF INTEGER;

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;
    Scr2                          : I.ScreenPtr;
    depth,resx,resy               : LONGINT;
    key                           : CHAR;
    wx,wy,ObereFarbe,MittlereFarbe: INTEGER;
    colours32                     : colourstype32;
    colours64                     : colourstype64;
    colours128                    : colourstype128;
    VERSION                       : ARRAY 90 OF CHAR;
    Col32,Col32copy : colourstype128;
    colourNoAGA,colourNoAGAcopy : colourArray;

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 1.0 © Danny Amor in 1994"),
                    I.waPubScreen,     GUI.Scr,
                    I.waMinWidth,      67,
                    I.waMinHeight,     21,
                    I.waMaxWidth,      656,
                    I.waMaxHeight,     414, u.done);

  IF version>38 THEN
    I.LendMenus(GUI.CloudsWnd,GUI.PaletteWnd);
(*    quit:=I.SetMenuStrip(GUI.PaletteWnd,GUI.Menu^);*)
  END;
  gt.RefreshWindow (win, NIL);
END OpenWindow;

PROCEDURE CloseWindow (VAR win: I.WindowPtr);

BEGIN
  IF win # NIL THEN
    I.ClearMenuStrip(GUI.PaletteWnd);
    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);

  VAR q: INTEGER;

  BEGIN
   n1:=n DIV 2;
   l:=1;
   FOR q:=1 TO i DO l:=l*2; END;
  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:=1;
      FOR p:=1 TO i DO test2:=test2*2; END;
      test2:=test2-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 1.0 © Danny Amor in 1994"));
END Cloud;

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

VAR numiter: INTEGER;
    mu     : REAL;

BEGIN
  IF size=0 THEN
    na:=64;
    numiter:=5;
    faktor:=2;
  END;
  IF size=1 THEN
    na:=128;
    numiter:=6;
    faktor:=3;
  END;
  IF size=2 THEN
    na:=256;
    numiter:=7;
    faktor:=4;
  END;
  IF size=3 THEN
    na:=512;
    numiter:=8;
    faktor:=5;
  END;
  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 1.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 1.0 © Danny Amor in 1994"));
END Smooth;

PROCEDURE SetColors(VAR vp: g.ViewPortPtr);

VAR a,i,nf,n: INTEGER;

BEGIN
  IF version<39 THEN
    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);
    nf:=1;  n:=UntereFarbe+1;
    g.SetRGB4(vp,4,0,0,15);
    FOR i:=4 TO 14 DO
      g.SetRGB4(vp,n,i,i,15);
      INC(n);
    END;
    g.SetRGB4(vp,n,15,15,15);
    INC(n);
    FOR i:=14 TO 10 DO
      g.SetRGB4(vp,n,i,i,i+1);
      INC(n);
    END;
    FOR i:=1 TO 10 DO
      a:=1;
      IF i>2 THEN a:=5-i END;
      IF i>7 THEN a:=i-10 END;
      a:=(10-a);
      g.SetRGB4(vp,n,a,a,a+1);
      INC(n);
    END;
  ELSE
    g.SetRGB32(vp,0,0AC000000H,0AC000000H,0AC000000H);
    g.SetRGB32(vp,1,0,0,0);
    g.SetRGB32(vp,2,0FF000000H,0FF000000H,0FF000000H);
    g.SetRGB32(vp,3,066000000H,088000000H,0BA000000H);
    IF depth=5 THEN
      colours32:=colourstype32(1C0004H,000000000H,000000000H,0FF000000H, 000000000H,010000000H,0FF000000H,
                                     000000000H,020000000H,0FF000000H, 000000000H,030000000H,0FF000000H,
                                     000000000H,040000000H,0FF000000H, 000000000H,050000000H,0FF000000H,
                                     000000000H,060000000H,0FF000000H, 000000000H,070000000H,0FF000000H,
                                     010000000H,080000000H,0FF000000H, 020000000H,08A000000H,0FF000000H,
                                     030000000H,090000000H,0FF000000H, 040000000H,09A000000H,0FF000000H,
                                     050000000H,0A0000000H,0FF000000H, 060000000H,0AA000000H,0FF000000H,
                                     070000000H,0B0000000H,0FF000000H, 080000000H,0BA000000H,0FF000000H,
                                     090000000H,0C0000000H,0FF000000H, 0A0000000H,0CA000000H,0FF000000H,
                                     0B0000000H,0D0000000H,0FF000000H, 0C0000000H,0DA000000H,0FF000000H,
                                     0D0000000H,0E0000000H,0FF000000H, 0E0000000H,0EA000000H,0FF000000H,
                                     0F0000000H,0F0000000H,0FF000000H, 0E0000000H,0E0000000H,0EF000000H,
                                     0D0000000H,0D0000000H,0DF000000H, 0C0000000H,0C0000000H,0CF000000H,
                                     0B0000000H,0B0000000H,0BF000000H, 0A0000000H,0A0000000H,0AF000000H,0);

      g.LoadRGB32(vp,colours32);
    END;
    IF depth=6 THEN
      colours64:=colourstype64(3C0004H,000000000H,000000000H,0FF000000H, 000000000H,008000000H,0FF000000H,
                                     000000000H,010000000H,0FF000000H, 000000000H,018000000H,0FF000000H,
                                     000000000H,020000000H,0FF000000H, 000000000H,028000000H,0FF000000H,
                                     000000000H,030000000H,0FF000000H, 000000000H,038000000H,0FF000000H,
                                     000000000H,040000000H,0FF000000H, 000000000H,048000000H,0FF000000H,
                                     000000000H,050000000H,0FF000000H, 000000000H,058000000H,0FF000000H,
                                     000000000H,060000000H,0FF000000H, 000000000H,068000000H,0FF000000H,
                                     000000000H,070000000H,0FF000000H, 000000000H,078000000H,0FF000000H,
                                     010000000H,080000000H,0FF000000H, 018000000H,088000000H,0FF000000H,
                                     020000000H,08A000000H,0FF000000H, 028000000H,08C000000H,0FF000000H,
                                     030000000H,090000000H,0FF000000H, 038000000H,098000000H,0FF000000H,
                                     040000000H,09A000000H,0FF000000H, 048000000H,09C000000H,0FF000000H,
                                     050000000H,0A0000000H,0FF000000H, 058000000H,0A8000000H,0FF000000H,
                                     060000000H,0AA000000H,0FF000000H, 068000000H,0AC000000H,0FF000000H,
                                     070000000H,0B0000000H,0FF000000H, 078000000H,0B8000000H,0FF000000H,
                                     080000000H,0BA000000H,0FF000000H, 088000000H,0BC000000H,0FF000000H,
                                     090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
                                     0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
                                     0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
                                     0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
                                     0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
                                     0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
                                     0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
                                     0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
                                     0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
                                     0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
                                     0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
                                     0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
                                     09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
                                     098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,0);
     g.LoadRGB32(vp,colours64);
   END;
    IF depth=7 THEN
      colours128:=colourstype128(7C0004H,000000000H,000000000H,0FF000000H, 000000000H,004000000H,0FF000000H,
                                     000000000H,008000000H,0FF000000H, 000000000H,00B000000H,0FF000000H,
                                     000000000H,010000000H,0FF000000H, 000000000H,014000000H,0FF000000H,
                                     000000000H,018000000H,0FF000000H, 000000000H,01B000000H,0FF000000H,
                                     000000000H,020000000H,0FF000000H, 000000000H,024000000H,0FF000000H,
                                     000000000H,028000000H,0FF000000H, 000000000H,02B000000H,0FF000000H,
                                     000000000H,030000000H,0FF000000H, 000000000H,034000000H,0FF000000H,
                                     000000000H,038000000H,0FF000000H, 000000000H,03B000000H,0FF000000H,
                                     000000000H,040000000H,0FF000000H, 000000000H,044000000H,0FF000000H,
                                     000000000H,048000000H,0FF000000H, 000000000H,04B000000H,0FF000000H,
                                     000000000H,050000000H,0FF000000H, 000000000H,054000000H,0FF000000H,
                                     000000000H,058000000H,0FF000000H, 000000000H,05B000000H,0FF000000H,
                                     000000000H,060000000H,0FF000000H, 000000000H,064000000H,0FF000000H,
                                     000000000H,068000000H,0FF000000H, 000000000H,06B000000H,0FF000000H,
                                     000000000H,070000000H,0FF000000H, 000000000H,074000000H,0FF000000H,
                                     000000000H,078000000H,0FF000000H, 000000000H,07B000000H,0FF000000H,
                                     010000000H,080000000H,0FF000000H, 014000000H,084000000H,0FF000000H,
                                     016000000H,088000000H,0FF000000H, 018000000H,08B000000H,0FF000000H,
                                     020000000H,08A000000H,0FF000000H, 024000000H,08B000000H,0FF000000H,
                                     026000000H,08C000000H,0FF000000H, 028000000H,08D000000H,0FF000000H,
                                     030000000H,090000000H,0FF000000H, 034000000H,094000000H,0FF000000H,
                                     036000000H,098000000H,0FF000000H, 038000000H,09B000000H,0FF000000H,
                                     040000000H,09A000000H,0FF000000H, 044000000H,09B000000H,0FF000000H,
                                     046000000H,09C000000H,0FF000000H, 048000000H,09D000000H,0FF000000H,
                                     050000000H,0A0000000H,0FF000000H, 054000000H,0A4000000H,0FF000000H,
                                     056000000H,0A8000000H,0FF000000H, 058000000H,0AB000000H,0FF000000H,
                                     060000000H,0AA000000H,0FF000000H, 064000000H,0AB000000H,0FF000000H,
                                     066000000H,0AC000000H,0FF000000H, 068000000H,0AD000000H,0FF000000H,
                                     070000000H,0B0000000H,0FF000000H, 074000000H,0B4000000H,0FF000000H,
                                     076000000H,0B8000000H,0FF000000H, 078000000H,0BB000000H,0FF000000H,
                                     080000000H,0BA000000H,0FF000000H, 084000000H,0BB000000H,0FF000000H,
                                     088000000H,0BC000000H,0FF000000H, 08B000000H,0BD000000H,0FF000000H,
                                     090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
                                     0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
                                     0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
                                     0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
                                     0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
                                     0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
                                     0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
                                     0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
                                     0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
                                     0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
                                     0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
                                     0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
                                     09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
                                     098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,
                                     0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
                                     0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
                                     0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
                                     0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
                                     0);
     g.LoadRGB32(vp,colours128);
   END;
 END (* IF THEN ELSE *);
END SetColors;

PROCEDURE ClickNull(VAR size: INTEGER);

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

PROCEDURE ClickOne(VAR x,y: INTEGER);

VAR q  : INTEGER;

BEGIN
  x:=64;
  y:=64;
  FOR q:=1 TO size DO x:=x*2; y:=y*2; END;
  x:=x+10;
  y:=y+fonty+4;
  OpenWindow(0,0,x,y,win);
  open:=TRUE;
  I.WindowToFront(GUI.CloudsWnd);
  SizeOut(na,4,size);
END ClickOne;

PROCEDURE GetColour(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR depth: LONGINT);

VAR i,aha: LONGINT;

BEGIN
  IF version>38 THEN
    aha:=1;
    FOR i:=1 TO depth DO aha:=aha*2; END;
    g.GetRGB32(GUI.Scr^.viewPort.colorMap,0,aha,Col32);
    FOR i:=0 TO 277 DO Col32[277-i+1]:=Col32[277-i]; END;
    Col32[0]:=010000H*aha;
  ELSE
    FOR i:=0 TO 32 DO
      colourNoAGA[i]:=g.GetRGB4(GUI.Scr^.viewPort.colorMap,i);
    END;
  END;
END GetColour;

PROCEDURE SetSlider(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR colornum: INTEGER);

VAR blue,green,red,i : INTEGER;

BEGIN
  IF version>38 THEN
    red   := SHORT(Col32[colornum*3+1] DIV 001000000H);
    green := SHORT(Col32[colornum*3+2] DIV 001000000H);
    blue  := SHORT(Col32[colornum*3+3] DIV 001000000H);
    IF red<0   THEN red  :=256+red; END;
    IF green<0 THEN green:=256+green; END;
    IF blue<0  THEN blue :=256+blue; END;
  ELSE
    red   := y.LSH(colourNoAGA[colornum],-8);
    green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
    blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
  END;
  gt.SetGadgetAttrs(GUI.PaletteGadgets[0]^,GUI.PaletteWnd,NIL,gt.slLevel,red);
  gt.SetGadgetAttrs(GUI.PaletteGadgets[1]^,GUI.PaletteWnd,NIL,gt.slLevel,green);
  gt.SetGadgetAttrs(GUI.PaletteGadgets[2]^,GUI.PaletteWnd,NIL,gt.slLevel,blue);
END SetSlider;

PROCEDURE SetColor(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR vp: g.ViewPortPtr;
                   VAR colornum: INTEGER; coltype: INTEGER; VAR count: INTEGER);

VAR red,green,blue,col: INTEGER;

BEGIN
  IF version>38 THEN
    col:=colornum*3;
    Col32[col+coltype]:=count*001000000H;
    g.SetRGB32(vp,colornum,Col32[col+1],Col32[col+2],Col32[col+3]);
  ELSE
    red   := y.LSH(colourNoAGA[colornum],-8);
    green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
    blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
    IF coltype=1 THEN red   := count; END;
    IF coltype=2 THEN green := count; END;
    IF coltype=3 THEN blue  := count; END;
    g.SetRGB4(vp,colornum,red,green,blue);
    red   := y.LSH(red,8);
    green := y.LSH(green,4);
    colourNoAGA[colornum]:=red+green+blue;
 END;
END SetColor;

PROCEDURE ClickTwo(VAR vp: g.ViewPortPtr; VAR depth: LONGINT);

VAR quit                 : BOOLEAN;
    aktgad               : I.GadgetPtr;
    nummer, colornum,info: INTEGER;

BEGIN
  req.Assert(GUI.OpenPaletteWindow(depth)=0,"Unable to open palette window!");
  GetColour(Col32,colourNoAGA,depth);
  Col32copy:=Col32;
  colourNoAGAcopy:=colourNoAGA;
  colornum:=3;
  quit:=FALSE;
  SetSlider(Col32copy,colourNoAGAcopy,colornum);
  REPEAT
    e.WaitPort(GUI.PaletteWnd.userPort);
    msgptr := gt.GetIMsg (GUI.PaletteWnd.userPort);
    IF msgptr#NIL THEN
      msg  := msgptr^;
      info := msg.code;
      gt.ReplyIMsg (msgptr);
      IF (I.gadgetUp IN msg.class) THEN
        aktgad:=msg.iAddress;
        nummer:=aktgad.gadgetID;
        IF nummer=GUI.GDPACANCEL  THEN
          IF version>38 THEN g.LoadRGB32(vp,Col32);
                        ELSE g.LoadRGB4(vp,colourNoAGA,32); END;
          quit:=TRUE;
        END;
        IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
        IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
        IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
        IF nummer=GUI.GDPAOK      THEN quit:=TRUE; END;
        IF nummer=GUI.GDPAPALETTE THEN colornum:=info; SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
        IF nummer=GUI.GDPARESET   THEN SetColors(vp); GetColour(Col32copy,colourNoAGAcopy,depth); SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
      ELSE
        IF (I.mouseMove IN msg.class) THEN
          aktgad:=msg.iAddress;
          nummer:=aktgad.gadgetID;
          IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
          IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
          IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
        END;
      END;
    END;
  UNTIL quit;
  GUI.ClosePaletteWindow;
END ClickTwo;

PROCEDURE ClickThree;

BEGIN
  Smooth(na);
END ClickThree;

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 1.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 1.0 © Danny Amor in 1994"));
  END;
END ClickFour;

PROCEDURE DoColours;

VAR i: LONGINT;

BEGIN
  ObereFarbe:=1;
  FOR i:=1 TO depth DO ObereFarbe:=ObereFarbe*2; END;
  DEC(ObereFarbe);
  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);
    GUI.ClosePaletteWindow;
    GUI.CloseCloudsWindow(GUI.CloudsWnd);
    GUI.CloseDownScreen(GUI.Scr);
    req.Assert(GUI.SetupScreen(depth,resx,resy)=0,"Unable to open screen!");
    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;

BEGIN
  VERSION := "$VER: CloudsAGA 1.01 (26.02.94) 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 ClickTwo(vp,depth);  END;
        IF (nummer=GUI.GDSmooth) AND open       THEN ClickThree;END;
        IF (nummer=GUI.GDSave) AND open         THEN ClickFour(wx,wy); END;
        IF  nummer=GUI.GDScreen                 THEN ClickFive(vp); END;
      END;
      IF (I.vanillaKey IN msg1.class) THEN
        key:=CAP(CHR(msg1.code));
        IF  key="Z"                 THEN ClickNull(size);   END;
        IF (key="C") AND (NOT open) THEN ClickOne(wx,wy);   END;
        IF  key="P"                 THEN ClickTwo(vp,depth);END;
        IF (key="M") AND open       THEN ClickThree;        END;
        IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
        IF  key="R"                 THEN ClickFive(vp);     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
            key:=CAP(CHR(msg2.code));
            IF  key="Z"                 THEN ClickNull(size);   END;
            IF  key="P"                 THEN ClickTwo(vp,depth);END;
            IF (key="M") AND open       THEN ClickThree;        END;
            IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
            IF  key="R"                 THEN ClickFive(vp);     END;
          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);
  GUI.ClosePaletteWindow;
  GUI.CloseDownScreen(GUI.Scr);
  GUI.CloseDownScreen(Scr2);
END Clouds.