home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / graphics / fractals / cloudsaga / source.lha / Clouds.mod next >
Text File  |  1995-01-10  |  30KB  |  732 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    CloudsAGA.mod
  3.     :Author.     Daniel Amor
  4.     :Address.    Ludwigstr. 124, D-70197 Stuttgart
  5.     :Shortcut.   [da]
  6.     :Version.    1.0
  7.     :Date.       15-Feb-94
  8.     :Copyright.  PD
  9.     :Language.   Oberon-2
  10.     :Translator. Amiga Oberon 3.0
  11.     :Imports.    Clouds [da].
  12.     :Contents.   Erzeugt Fraktal-Wolken.
  13.     :Remark.     Aufruf: Clouds
  14. ---------------------------------------------------------------------------*)
  15.  
  16. MODULE Clouds;
  17.  
  18. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
  19.  
  20. IMPORT  e    : Exec,
  21.         d    : Dos,
  22.         I    : Intuition,
  23.         gt   : GadTools,
  24.         g    : Graphics,
  25.         req  : Requests,
  26.         GUI  : CloudsGUI,
  27.         u    : Utility,
  28.         r    : Random,
  29.         y    : SYSTEM,
  30.         str  : Strings,IFF,ASL;
  31.  
  32. CONST UntereFarbe   = 4;
  33.  
  34. TYPE colourstype32  = ARRAY 86  OF LONGINT;
  35.      colourstype64  = ARRAY 182 OF LONGINT;
  36.      colourstype128 = ARRAY 386 OF LONGINT;
  37.      colourArray    = ARRAY 31 OF INTEGER;
  38.  
  39. VAR quit,open,gOK                 : BOOLEAN;
  40.     msgptr,msgptr1,msgptr2        : I.IntuiMessagePtr;
  41.     msg,msg1,msg2                 : I.IntuiMessage;
  42.     item1,item2                   : I.MenuItemPtr;
  43.     aktgad1,aktgad2               : I.GadgetPtr;
  44.     vp                            : g.ViewPortPtr;
  45.     nummer,farbe,na,fonty,size,version    : INTEGER;
  46.     win                           : I.WindowPtr;
  47.     Scr2                          : I.ScreenPtr;
  48.     depth,resx,resy               : LONGINT;
  49.     key                           : CHAR;
  50.     wx,wy,ObereFarbe,MittlereFarbe: INTEGER;
  51.     colours32                     : colourstype32;
  52.     colours64                     : colourstype64;
  53.     colours128                    : colourstype128;
  54.     VERSION                       : ARRAY 90 OF CHAR;
  55.     Col32,Col32copy : colourstype128;
  56.     colourNoAGA,colourNoAGAcopy : colourArray;
  57.  
  58. PROCEDURE FileReq(hail: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; win : I.WindowPtr): BOOLEAN;
  59.  
  60. VAR i,j       : INTEGER;
  61.     Dirname   : ARRAY 256 OF CHAR;
  62.     Filename  : ARRAY 356 OF CHAR;
  63.     flags     : LONGINT;
  64.     res       : BOOLEAN;
  65.     fr        : ASL.FileRequesterPtr;
  66.     pattern   : ARRAY 80 OF CHAR;
  67.  
  68. BEGIN
  69.   j := SHORT(str.Length(name));
  70.   WHILE (j>=0) & (name[j]#":") & (name[j]#"/") DO DEC(j) END;
  71.   i := 0;
  72.   WHILE i<=j DO Dirname[i] := name[i]; INC(i) END; Dirname[i] := 0X;
  73.   j := 0;
  74.   REPEAT Filename[j] := name[i]; INC(j); INC(i) UNTIL name[i-1]=0X;
  75.   fr := ASL.AllocAslRequestTags(ASL.fileRequest, u.done);
  76.   IF fr=NIL THEN HALT(20) END;
  77.   flags := ASH(1,ASL.patGad);
  78.   INC(flags,ASH(1,ASL.save));
  79.   res := ASL.AslRequestTags(fr, ASL.hail,     y.ADR(hail),
  80.                                 ASL.file,     y.ADR(Filename),
  81.                                 ASL.dir,      y.ADR(Dirname),
  82.                                 ASL.window,   win,
  83.                                 ASL.pattern,  y.ADR(pattern),
  84.                                 ASL.funcFlags,flags,
  85.                                 u.done);
  86.   COPY(fr.dir^,Dirname);
  87.   COPY(fr.file^,Filename);
  88.  
  89.   i := SHORT(str.Length(Dirname));
  90.   IF (i>0) & (Dirname[i-1]#"/") & (Dirname[i-1]#":") THEN
  91.     Dirname[i] := "/"; INC(i);
  92.     Dirname[i] := 0X;
  93.   END;
  94.   IF LEN(name)>i+str.Length(Filename) THEN
  95.     COPY(Dirname,name);
  96.     str.Append(name,Filename);
  97.     RETURN TRUE;
  98.   END;
  99.   RETURN FALSE;
  100. END FileReq;
  101.  
  102. PROCEDURE OpenWindow (left,top,width,height: LONGINT; VAR win: I.WindowPtr);
  103.  
  104. VAR quit: BOOLEAN;
  105.  
  106. BEGIN
  107.   IF height<resy-GUI.FontY THEN top:=GUI.FontY+3 END;
  108.   win := I.OpenWindowTagsA ( NIL,
  109.                     I.waLeft,          left,
  110.                     I.waTop,           top,
  111.                     I.waWidth,         width,
  112.                     I.waHeight,        height,
  113.                     I.waIDCMP,         LONGSET {I.closeWindow,I.refreshWindow,I.vanillaKey,I.menuPick},
  114.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.activate,I.newLookMenus},
  115.                     I.waTitle,         y.ADR ("Generating..."),
  116.                     I.waScreenTitle,   y.ADR ("CloudsAGA 1.0 © Danny Amor in 1994"),
  117.                     I.waPubScreen,     GUI.Scr,
  118.                     I.waMinWidth,      67,
  119.                     I.waMinHeight,     21,
  120.                     I.waMaxWidth,      656,
  121.                     I.waMaxHeight,     414, u.done);
  122.  
  123.   IF version>38 THEN
  124.     I.LendMenus(GUI.CloudsWnd,GUI.PaletteWnd);
  125. (*    quit:=I.SetMenuStrip(GUI.PaletteWnd,GUI.Menu^);*)
  126.   END;
  127.   gt.RefreshWindow (win, NIL);
  128. END OpenWindow;
  129.  
  130. PROCEDURE CloseWindow (VAR win: I.WindowPtr);
  131.  
  132. BEGIN
  133.   IF win # NIL THEN
  134.     I.ClearMenuStrip(GUI.PaletteWnd);
  135.     I.CloseWindow (win);
  136.     win := NIL;
  137.   END;
  138. END CloseWindow;
  139.  
  140. PROCEDURE TestF(VAR farbe: INTEGER);
  141.  
  142. BEGIN
  143.   IF farbe>ObereFarbe  THEN farbe:=ObereFarbe;  END;
  144.   IF farbe<UntereFarbe THEN farbe:=UntereFarbe; END;
  145. END TestF;
  146.  
  147. PROCEDURE RandomFarbe(VAR Rp: g.RastPortPtr; Start: INTEGER; VAR mf: REAL; x,y: INTEGER);
  148.  
  149. VAR farbe: INTEGER;
  150.     OK   : BOOLEAN;
  151.  
  152. BEGIN
  153.   farbe:=SHORT(Start+SHORT(mf*(r.RND(1)*LONG(2)-1))+1);
  154.   TestF(farbe);
  155.   g.SetAPen(Rp,farbe);
  156.   OK:=g.WritePixel(Rp,x+4,y+fonty);
  157. END RandomFarbe;
  158.  
  159. PROCEDURE Cloud(numiter: INTEGER; mu: REAL; na: INTEGER);
  160.  
  161. TYPE Coord = ARRAY 11 OF INTEGER;
  162.  
  163. VAR i,j,k,l,x1,y1,x2,y2,x3,y3,smul1,smul2,p  : INTEGER;
  164.     xy                                       : Coord;
  165.     n,n1,farbe,nk,test,test2                 : INTEGER;
  166.     farbe1,farbe2,farbe3,farbe4              : LONGINT;
  167.     mf                                       : REAL;
  168.  
  169.   PROCEDURE BigPic(n,i: INTEGER; VAR n1,l: INTEGER);
  170.  
  171.   VAR q: INTEGER;
  172.  
  173.   BEGIN
  174.    n1:=n DIV 2;
  175.    l:=1;
  176.    FOR q:=1 TO i DO l:=l*2; END;
  177.   END BigPic;
  178.  
  179.   PROCEDURE SetEdge(VAR Rp: g.RastPortPtr; x1,y1,x2,y2,x3,y3: INTEGER; VAR mf: REAL);
  180.  
  181.   BEGIN
  182.     farbe1:=g.ReadPixel(Rp,x1+4,y1+fonty);
  183.     farbe2:=g.ReadPixel(Rp,x2+4,y2+fonty);
  184.     RandomFarbe(Rp,SHORT(farbe1+farbe2) DIV 2,mf,x3,y3);
  185.   END SetEdge;
  186.  
  187.  PROCEDURE SetPoint(VAR Rp: g.RastPortPtr; VAR mf: REAL; VAR xy: Coord);
  188.  
  189.   VAR a: BOOLEAN;
  190.  
  191.   BEGIN
  192.     farbe1:=g.ReadPixel(Rp,xy[1]+4,xy[2]+fonty);
  193.     farbe2:=g.ReadPixel(Rp,xy[3]+4,xy[4]+fonty);
  194.     farbe3:=g.ReadPixel(Rp,xy[5]+4,xy[6]+fonty);
  195.     farbe4:=g.ReadPixel(Rp,xy[7]+4,xy[8]+fonty);
  196.     farbe:=SHORT(((farbe1+farbe2+farbe3+farbe4) DIV 4)+SHORT(r.RND(2)*2*mf-mf));
  197.     TestF(farbe);
  198.     g.SetAPen(Rp,farbe);
  199.     a:=g.WritePixel(Rp,xy[9]+4,xy[10]+fonty);
  200.   END SetPoint;
  201.  
  202. BEGIN
  203.   mf:=(numiter+1)*mu;
  204.   RandomFarbe(win^.rPort,MittlereFarbe,mf,0,  0);
  205.   RandomFarbe(win^.rPort,MittlereFarbe,mf,0, na);
  206.   RandomFarbe(win^.rPort,MittlereFarbe,mf,na, 0);
  207.   RandomFarbe(win^.rPort,MittlereFarbe,mf,na,na);
  208.   n:=na;
  209.   test:=1;
  210.   FOR i:=0 TO numiter DO
  211.     mf:=(numiter-i+1)*mu;
  212.     BigPic(n,i,n1,l);
  213.     FOR j:=1 TO l DO
  214.       smul1:=(j-1)*n;
  215.       smul2:=j*n;
  216.       SetEdge(win^.rPort,smul1,0    ,smul2,0    ,smul2-n1,0       ,mf);
  217.       SetEdge(win^.rPort,smul1,na   ,smul2,na   ,smul2-n1,na      ,mf);
  218.       SetEdge(win^.rPort,0    ,smul1,0    ,smul2,0       ,smul2-n1,mf);
  219.       SetEdge(win^.rPort,na   ,smul1,na   ,smul2,na      ,smul2-n1,mf);
  220.     END;
  221.     n:=n1;
  222.   END;
  223.   n:=na;
  224.   FOR i:=0 TO numiter DO
  225.     mf:=(numiter-i+1)*mu;
  226.     BigPic(n,i,n1,l);
  227.     FOR k:=1 TO l DO
  228.       FOR j:=1 TO l DO
  229.         smul1:=k*n;   smul2:=j*n;
  230.         xy[1]:=smul2-n; xy[2]:=smul1-n; xy[3]:=smul2-n;
  231.         xy[4]:=smul1  ; xy[5]:=smul2  ; xy[6]:=smul1-n;
  232.         xy[7]:=smul2  ; xy[8]:=smul1  ; xy[9]:=smul2-n1;
  233.         xy[10]:=smul1-n1;
  234.         SetPoint(win^.rPort,mf,xy);
  235.       END;
  236.     END;
  237.     nk:=0;
  238.     FOR k:=1 TO test DO
  239.       nk:=1-nk;
  240.       test2:=1;
  241.       FOR p:=1 TO i DO test2:=test2*2; END;
  242.       test2:=test2-nk;
  243.       FOR j:=1 TO test2 DO
  244.         smul1:=j*n+nk*n1;   smul2:=k*n1;
  245.         xy[1]:=smul1-n1; xy[2]:=smul2-n1; xy[3]:=smul1;
  246.         xy[4]:=smul2   ; xy[5]:=smul1-n1; xy[6]:=smul2+n1;
  247.         xy[7]:=smul1-n ; xy[8]:=smul2   ; xy[9]:=smul1-n1;
  248.         xy[10]:=smul2;
  249.         SetPoint(win^.rPort,mf,xy);
  250.       END;
  251.     END;
  252.     n:=n1;
  253.     test:=((test+1)*2)-1;
  254.   END;
  255.   I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.0 © Danny Amor in 1994"));
  256. END Cloud;
  257.  
  258. PROCEDURE SizeOut(VAR na: INTEGER; faktor,size: INTEGER);
  259.  
  260. VAR numiter: INTEGER;
  261.     mu     : REAL;
  262.  
  263. BEGIN
  264.   IF size=0 THEN
  265.     na:=64;
  266.     numiter:=5;
  267.     faktor:=2;
  268.   END;
  269.   IF size=1 THEN
  270.     na:=128;
  271.     numiter:=6;
  272.     faktor:=3;
  273.   END;
  274.   IF size=2 THEN
  275.     na:=256;
  276.     numiter:=7;
  277.     faktor:=4;
  278.   END;
  279.   IF size=3 THEN
  280.     na:=512;
  281.     numiter:=8;
  282.     faktor:=5;
  283.   END;
  284.   mu:=2.5-faktor/5;
  285.   Cloud(numiter,mu,na);
  286. END SizeOut;
  287.  
  288. PROCEDURE Smooth(VAR na: INTEGER);
  289.  
  290. VAR y1,x,farbe                 : INTEGER;
  291.     a                          : BOOLEAN;
  292.     farbe1,farbe2,farbe3,farbe4: LONGINT;
  293.  
  294. BEGIN
  295.   I.SetWindowTitles(win,y.ADR("Smoothing..."),y.ADR("CloudsAGA 1.0 © Danny Amor in 1994"));
  296.   FOR y1:=0 TO na-1 DO
  297.     FOR x:=0 TO na-1 DO
  298.       farbe1:=g.ReadPixel(win^.rPort,x+4,y1+fonty);
  299.       farbe2:=g.ReadPixel(win^.rPort,x+5,y1+fonty);
  300.       farbe3:=g.ReadPixel(win^.rPort,x+4,y1+1+fonty);
  301.       farbe4:=g.ReadPixel(win^.rPort,x+5,y1+1+fonty);
  302.       farbe :=SHORT(SHORT((farbe1+farbe2+farbe3+farbe4)/4));
  303.       g.SetAPen(win^.rPort,farbe);
  304.       a:=g.WritePixel(win^.rPort,x+4,y1+fonty);
  305.     END;
  306.   END;
  307.   I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.0 © Danny Amor in 1994"));
  308. END Smooth;
  309.  
  310. PROCEDURE SetColors(VAR vp: g.ViewPortPtr);
  311.  
  312. VAR a,i,nf,n: INTEGER;
  313.  
  314. BEGIN
  315.   IF version<39 THEN
  316.     g.SetRGB4(vp,0,10,10,10);
  317.     g.SetRGB4(vp,1,0,0,0);
  318.     g.SetRGB4(vp,2,15,15,15);
  319.     g.SetRGB4(vp,3,6,8,11);
  320.     nf:=1;  n:=UntereFarbe+1;
  321.     g.SetRGB4(vp,4,0,0,15);
  322.     FOR i:=4 TO 14 DO
  323.       g.SetRGB4(vp,n,i,i,15);
  324.       INC(n);
  325.     END;
  326.     g.SetRGB4(vp,n,15,15,15);
  327.     INC(n);
  328.     FOR i:=14 TO 10 DO
  329.       g.SetRGB4(vp,n,i,i,i+1);
  330.       INC(n);
  331.     END;
  332.     FOR i:=1 TO 10 DO
  333.       a:=1;
  334.       IF i>2 THEN a:=5-i END;
  335.       IF i>7 THEN a:=i-10 END;
  336.       a:=(10-a);
  337.       g.SetRGB4(vp,n,a,a,a+1);
  338.       INC(n);
  339.     END;
  340.   ELSE
  341.     g.SetRGB32(vp,0,0AC000000H,0AC000000H,0AC000000H);
  342.     g.SetRGB32(vp,1,0,0,0);
  343.     g.SetRGB32(vp,2,0FF000000H,0FF000000H,0FF000000H);
  344.     g.SetRGB32(vp,3,066000000H,088000000H,0BA000000H);
  345.     IF depth=5 THEN
  346.       colours32:=colourstype32(1C0004H,000000000H,000000000H,0FF000000H, 000000000H,010000000H,0FF000000H,
  347.                                      000000000H,020000000H,0FF000000H, 000000000H,030000000H,0FF000000H,
  348.                                      000000000H,040000000H,0FF000000H, 000000000H,050000000H,0FF000000H,
  349.                                      000000000H,060000000H,0FF000000H, 000000000H,070000000H,0FF000000H,
  350.                                      010000000H,080000000H,0FF000000H, 020000000H,08A000000H,0FF000000H,
  351.                                      030000000H,090000000H,0FF000000H, 040000000H,09A000000H,0FF000000H,
  352.                                      050000000H,0A0000000H,0FF000000H, 060000000H,0AA000000H,0FF000000H,
  353.                                      070000000H,0B0000000H,0FF000000H, 080000000H,0BA000000H,0FF000000H,
  354.                                      090000000H,0C0000000H,0FF000000H, 0A0000000H,0CA000000H,0FF000000H,
  355.                                      0B0000000H,0D0000000H,0FF000000H, 0C0000000H,0DA000000H,0FF000000H,
  356.                                      0D0000000H,0E0000000H,0FF000000H, 0E0000000H,0EA000000H,0FF000000H,
  357.                                      0F0000000H,0F0000000H,0FF000000H, 0E0000000H,0E0000000H,0EF000000H,
  358.                                      0D0000000H,0D0000000H,0DF000000H, 0C0000000H,0C0000000H,0CF000000H,
  359.                                      0B0000000H,0B0000000H,0BF000000H, 0A0000000H,0A0000000H,0AF000000H,0);
  360.  
  361.       g.LoadRGB32(vp,colours32);
  362.     END;
  363.     IF depth=6 THEN
  364.       colours64:=colourstype64(3C0004H,000000000H,000000000H,0FF000000H, 000000000H,008000000H,0FF000000H,
  365.                                      000000000H,010000000H,0FF000000H, 000000000H,018000000H,0FF000000H,
  366.                                      000000000H,020000000H,0FF000000H, 000000000H,028000000H,0FF000000H,
  367.                                      000000000H,030000000H,0FF000000H, 000000000H,038000000H,0FF000000H,
  368.                                      000000000H,040000000H,0FF000000H, 000000000H,048000000H,0FF000000H,
  369.                                      000000000H,050000000H,0FF000000H, 000000000H,058000000H,0FF000000H,
  370.                                      000000000H,060000000H,0FF000000H, 000000000H,068000000H,0FF000000H,
  371.                                      000000000H,070000000H,0FF000000H, 000000000H,078000000H,0FF000000H,
  372.                                      010000000H,080000000H,0FF000000H, 018000000H,088000000H,0FF000000H,
  373.                                      020000000H,08A000000H,0FF000000H, 028000000H,08C000000H,0FF000000H,
  374.                                      030000000H,090000000H,0FF000000H, 038000000H,098000000H,0FF000000H,
  375.                                      040000000H,09A000000H,0FF000000H, 048000000H,09C000000H,0FF000000H,
  376.                                      050000000H,0A0000000H,0FF000000H, 058000000H,0A8000000H,0FF000000H,
  377.                                      060000000H,0AA000000H,0FF000000H, 068000000H,0AC000000H,0FF000000H,
  378.                                      070000000H,0B0000000H,0FF000000H, 078000000H,0B8000000H,0FF000000H,
  379.                                      080000000H,0BA000000H,0FF000000H, 088000000H,0BC000000H,0FF000000H,
  380.                                      090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
  381.                                      0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
  382.                                      0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
  383.                                      0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
  384.                                      0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
  385.                                      0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
  386.                                      0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
  387.                                      0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
  388.                                      0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
  389.                                      0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
  390.                                      0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
  391.                                      0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
  392.                                      09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
  393.                                      098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,0);
  394.      g.LoadRGB32(vp,colours64);
  395.    END;
  396.     IF depth=7 THEN
  397.       colours128:=colourstype128(7C0004H,000000000H,000000000H,0FF000000H, 000000000H,004000000H,0FF000000H,
  398.                                      000000000H,008000000H,0FF000000H, 000000000H,00B000000H,0FF000000H,
  399.                                      000000000H,010000000H,0FF000000H, 000000000H,014000000H,0FF000000H,
  400.                                      000000000H,018000000H,0FF000000H, 000000000H,01B000000H,0FF000000H,
  401.                                      000000000H,020000000H,0FF000000H, 000000000H,024000000H,0FF000000H,
  402.                                      000000000H,028000000H,0FF000000H, 000000000H,02B000000H,0FF000000H,
  403.                                      000000000H,030000000H,0FF000000H, 000000000H,034000000H,0FF000000H,
  404.                                      000000000H,038000000H,0FF000000H, 000000000H,03B000000H,0FF000000H,
  405.                                      000000000H,040000000H,0FF000000H, 000000000H,044000000H,0FF000000H,
  406.                                      000000000H,048000000H,0FF000000H, 000000000H,04B000000H,0FF000000H,
  407.                                      000000000H,050000000H,0FF000000H, 000000000H,054000000H,0FF000000H,
  408.                                      000000000H,058000000H,0FF000000H, 000000000H,05B000000H,0FF000000H,
  409.                                      000000000H,060000000H,0FF000000H, 000000000H,064000000H,0FF000000H,
  410.                                      000000000H,068000000H,0FF000000H, 000000000H,06B000000H,0FF000000H,
  411.                                      000000000H,070000000H,0FF000000H, 000000000H,074000000H,0FF000000H,
  412.                                      000000000H,078000000H,0FF000000H, 000000000H,07B000000H,0FF000000H,
  413.                                      010000000H,080000000H,0FF000000H, 014000000H,084000000H,0FF000000H,
  414.                                      016000000H,088000000H,0FF000000H, 018000000H,08B000000H,0FF000000H,
  415.                                      020000000H,08A000000H,0FF000000H, 024000000H,08B000000H,0FF000000H,
  416.                                      026000000H,08C000000H,0FF000000H, 028000000H,08D000000H,0FF000000H,
  417.                                      030000000H,090000000H,0FF000000H, 034000000H,094000000H,0FF000000H,
  418.                                      036000000H,098000000H,0FF000000H, 038000000H,09B000000H,0FF000000H,
  419.                                      040000000H,09A000000H,0FF000000H, 044000000H,09B000000H,0FF000000H,
  420.                                      046000000H,09C000000H,0FF000000H, 048000000H,09D000000H,0FF000000H,
  421.                                      050000000H,0A0000000H,0FF000000H, 054000000H,0A4000000H,0FF000000H,
  422.                                      056000000H,0A8000000H,0FF000000H, 058000000H,0AB000000H,0FF000000H,
  423.                                      060000000H,0AA000000H,0FF000000H, 064000000H,0AB000000H,0FF000000H,
  424.                                      066000000H,0AC000000H,0FF000000H, 068000000H,0AD000000H,0FF000000H,
  425.                                      070000000H,0B0000000H,0FF000000H, 074000000H,0B4000000H,0FF000000H,
  426.                                      076000000H,0B8000000H,0FF000000H, 078000000H,0BB000000H,0FF000000H,
  427.                                      080000000H,0BA000000H,0FF000000H, 084000000H,0BB000000H,0FF000000H,
  428.                                      088000000H,0BC000000H,0FF000000H, 08B000000H,0BD000000H,0FF000000H,
  429.                                      090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
  430.                                      0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
  431.                                      0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
  432.                                      0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
  433.                                      0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
  434.                                      0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
  435.                                      0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
  436.                                      0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
  437.                                      0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
  438.                                      0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
  439.                                      0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
  440.                                      0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
  441.                                      09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
  442.                                      098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,
  443.                                      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,
  444.                                      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,
  445.                                      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,
  446.                                      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,
  447.                                      0);
  448.      g.LoadRGB32(vp,colours128);
  449.    END;
  450.  END (* IF THEN ELSE *);
  451. END SetColors;
  452.  
  453. PROCEDURE ClickNull(VAR size: INTEGER);
  454.  
  455. BEGIN
  456.   INC(size);
  457.   IF size>3 THEN size:=0; END;
  458.   gt.SetGadgetAttrs(GUI.CloudsGadgets[0]^,GUI.CloudsWnd,NIL,gt.cyActive,size);
  459. END ClickNull;
  460.  
  461. PROCEDURE ClickOne(VAR x,y: INTEGER);
  462.  
  463. VAR q  : INTEGER;
  464.  
  465. BEGIN
  466.   x:=64;
  467.   y:=64;
  468.   FOR q:=1 TO size DO x:=x*2; y:=y*2; END;
  469.   x:=x+10;
  470.   y:=y+fonty+4;
  471.   OpenWindow(0,0,x,y,win);
  472.   open:=TRUE;
  473.   I.WindowToFront(GUI.CloudsWnd);
  474.   SizeOut(na,4,size);
  475. END ClickOne;
  476.  
  477. PROCEDURE GetColour(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR depth: LONGINT);
  478.  
  479. VAR i,aha: LONGINT;
  480.  
  481. BEGIN
  482.   IF version>38 THEN
  483.     aha:=1;
  484.     FOR i:=1 TO depth DO aha:=aha*2; END;
  485.     g.GetRGB32(GUI.Scr^.viewPort.colorMap,0,aha,Col32);
  486.     FOR i:=0 TO 277 DO Col32[277-i+1]:=Col32[277-i]; END;
  487.     Col32[0]:=010000H*aha;
  488.   ELSE
  489.     FOR i:=0 TO 32 DO
  490.       colourNoAGA[i]:=g.GetRGB4(GUI.Scr^.viewPort.colorMap,i);
  491.     END;
  492.   END;
  493. END GetColour;
  494.  
  495. PROCEDURE SetSlider(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR colornum: INTEGER);
  496.  
  497. VAR blue,green,red,i : INTEGER;
  498.  
  499. BEGIN
  500.   IF version>38 THEN
  501.     red   := SHORT(Col32[colornum*3+1] DIV 001000000H);
  502.     green := SHORT(Col32[colornum*3+2] DIV 001000000H);
  503.     blue  := SHORT(Col32[colornum*3+3] DIV 001000000H);
  504.     IF red<0   THEN red  :=256+red; END;
  505.     IF green<0 THEN green:=256+green; END;
  506.     IF blue<0  THEN blue :=256+blue; END;
  507.   ELSE
  508.     red   := y.LSH(colourNoAGA[colornum],-8);
  509.     green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
  510.     blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
  511.   END;
  512.   gt.SetGadgetAttrs(GUI.PaletteGadgets[0]^,GUI.PaletteWnd,NIL,gt.slLevel,red);
  513.   gt.SetGadgetAttrs(GUI.PaletteGadgets[1]^,GUI.PaletteWnd,NIL,gt.slLevel,green);
  514.   gt.SetGadgetAttrs(GUI.PaletteGadgets[2]^,GUI.PaletteWnd,NIL,gt.slLevel,blue);
  515. END SetSlider;
  516.  
  517. PROCEDURE SetColor(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR vp: g.ViewPortPtr;
  518.                    VAR colornum: INTEGER; coltype: INTEGER; VAR count: INTEGER);
  519.  
  520. VAR red,green,blue,col: INTEGER;
  521.  
  522. BEGIN
  523.   IF version>38 THEN
  524.     col:=colornum*3;
  525.     Col32[col+coltype]:=count*001000000H;
  526.     g.SetRGB32(vp,colornum,Col32[col+1],Col32[col+2],Col32[col+3]);
  527.   ELSE
  528.     red   := y.LSH(colourNoAGA[colornum],-8);
  529.     green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
  530.     blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
  531.     IF coltype=1 THEN red   := count; END;
  532.     IF coltype=2 THEN green := count; END;
  533.     IF coltype=3 THEN blue  := count; END;
  534.     g.SetRGB4(vp,colornum,red,green,blue);
  535.     red   := y.LSH(red,8);
  536.     green := y.LSH(green,4);
  537.     colourNoAGA[colornum]:=red+green+blue;
  538.  END;
  539. END SetColor;
  540.  
  541. PROCEDURE ClickTwo(VAR vp: g.ViewPortPtr; VAR depth: LONGINT);
  542.  
  543. VAR quit                 : BOOLEAN;
  544.     aktgad               : I.GadgetPtr;
  545.     nummer, colornum,info: INTEGER;
  546.  
  547. BEGIN
  548.   req.Assert(GUI.OpenPaletteWindow(depth)=0,"Unable to open palette window!");
  549.   GetColour(Col32,colourNoAGA,depth);
  550.   Col32copy:=Col32;
  551.   colourNoAGAcopy:=colourNoAGA;
  552.   colornum:=3;
  553.   quit:=FALSE;
  554.   SetSlider(Col32copy,colourNoAGAcopy,colornum);
  555.   REPEAT
  556.     e.WaitPort(GUI.PaletteWnd.userPort);
  557.     msgptr := gt.GetIMsg (GUI.PaletteWnd.userPort);
  558.     IF msgptr#NIL THEN
  559.       msg  := msgptr^;
  560.       info := msg.code;
  561.       gt.ReplyIMsg (msgptr);
  562.       IF (I.gadgetUp IN msg.class) THEN
  563.         aktgad:=msg.iAddress;
  564.         nummer:=aktgad.gadgetID;
  565.         IF nummer=GUI.GDPACANCEL  THEN
  566.           IF version>38 THEN g.LoadRGB32(vp,Col32);
  567.                         ELSE g.LoadRGB4(vp,colourNoAGA,32); END;
  568.           quit:=TRUE;
  569.         END;
  570.         IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
  571.         IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
  572.         IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
  573.         IF nummer=GUI.GDPAOK      THEN quit:=TRUE; END;
  574.         IF nummer=GUI.GDPAPALETTE THEN colornum:=info; SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
  575.         IF nummer=GUI.GDPARESET   THEN SetColors(vp); GetColour(Col32copy,colourNoAGAcopy,depth); SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
  576.       ELSE
  577.         IF (I.mouseMove IN msg.class) THEN
  578.           aktgad:=msg.iAddress;
  579.           nummer:=aktgad.gadgetID;
  580.           IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
  581.           IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
  582.           IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
  583.         END;
  584.       END;
  585.     END;
  586.   UNTIL quit;
  587.   GUI.ClosePaletteWindow;
  588. END ClickTwo;
  589.  
  590. PROCEDURE ClickThree;
  591.  
  592. BEGIN
  593.   Smooth(na);
  594. END ClickThree;
  595.  
  596. PROCEDURE ClickFour(x,y1: INTEGER);
  597.  
  598. VAR Ok   : BOOLEAN;
  599.     Name : ARRAY 80 OF CHAR;
  600.     xm,ym: LONGINT;
  601.  
  602. BEGIN
  603.   Name:="RAM:Clouds_1.IFF";
  604.   Ok:=FileReq("Save Clouds as...",Name,win);
  605.   IF Ok THEN
  606.     I.SetWindowTitles(win,y.ADR("Saving..."),y.ADR("CloudsAGA 1.0 © Danny Amor in 1994"));
  607.     I.WindowToBack(GUI.CloudsWnd);
  608.     xm:=win^.leftEdge DIV 8+(x DIV 8)+1;
  609.     ym:=win^.topEdge+y1;
  610.     IF xm>resx THEN xm:=(x DIV 8)+1-(xm-resx); END;
  611.     IF ym>resy THEN ym:=y1-(ym-resy); END;
  612.     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!");
  613.     I.WindowToFront(GUI.CloudsWnd);
  614.     I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.0 © Danny Amor in 1994"));
  615.   END;
  616. END ClickFour;
  617.  
  618. PROCEDURE DoColours;
  619.  
  620. VAR i: LONGINT;
  621.  
  622. BEGIN
  623.   ObereFarbe:=1;
  624.   FOR i:=1 TO depth DO ObereFarbe:=ObereFarbe*2; END;
  625.   DEC(ObereFarbe);
  626.   MittlereFarbe:=(ObereFarbe DIV 2)+SHORT(depth);
  627. END DoColours;
  628.  
  629. PROCEDURE ClickFive(VAR vp: g.ViewPortPtr);
  630.  
  631. VAR doit: BOOLEAN;
  632.  
  633. BEGIN
  634.   doit:=TRUE;
  635.   IF open THEN doit:=req.Request("Change Screenmode:","Do you want to restart with another\nresolution (this pic will be killed)?","OK","Cancel"); END;
  636.   IF doit THEN
  637.     CloseWindow(win);
  638.     GUI.ClosePaletteWindow;
  639.     GUI.CloseCloudsWindow(GUI.CloudsWnd);
  640.     GUI.CloseDownScreen(GUI.Scr);
  641.     req.Assert(GUI.SetupScreen(depth,resx,resy)=0,"Unable to open screen!");
  642.     DoColours;
  643.     vp:=y.ADR(GUI.Scr^.viewPort);
  644.     fonty:=GUI.FontY+3;
  645.     SetColors(vp);
  646.     size:=0;
  647.     req.Assert(GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr)=0,"Unable to open window!");
  648.     open      := FALSE;
  649.     quit      := FALSE;
  650.   END;
  651. END ClickFive;
  652.  
  653. BEGIN
  654.   VERSION := "$VER: CloudsAGA 1.01 (26.02.94) by Daniel Amor, Ludwigstr. 124, 70197 Stuttgart, Germany";
  655.   version := g.gfx.libNode.version;
  656.   depth   := 5;
  657.   req.Assert (GUI.SetupScreen(depth,resx,resy) = 0, "Unable to open screen!");
  658.   req.Assert (GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr) = 0, "Unable to open window!");
  659.   quit    := FALSE;
  660.   open    := FALSE;
  661.   DoColours;
  662.   vp:=y.ADR(GUI.Scr^.viewPort);
  663.   SetColors(vp);
  664.   fonty:=GUI.FontY+3;
  665.   size:=0;
  666.   REPEAT
  667.     IF open THEN
  668.       quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
  669.                                            win.userPort.sigBit,
  670.                                            d.ctrlC}))
  671.     ELSE
  672.       quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
  673.                                            d.ctrlC}));
  674.     END;
  675.     msgptr1 := gt.GetIMsg (GUI.CloudsWnd.userPort);
  676.     IF msgptr1 # NIL THEN
  677.       msg1 := msgptr1^;
  678.       gt.ReplyIMsg (msgptr1);
  679.  
  680.       IF (I.closeWindow IN msg1.class) THEN
  681.         quit := req.RequestWin("Clouds Requester","Do you really want to quit?","Yes","No",GUI.CloudsWnd);
  682.       END;
  683.       IF (I.gadgetUp IN msg1.class) THEN
  684.         aktgad1:=msg1.iAddress;
  685.         nummer:=aktgad1.gadgetID;
  686.         IF  nummer=GUI.GDSize                   THEN size:=msg1.code; END;
  687.         IF (nummer=GUI.GDCreate) AND (NOT open) THEN ClickOne(wx,wy);  END;
  688.         IF  nummer=GUI.GDAnimate                THEN ClickTwo(vp,depth);  END;
  689.         IF (nummer=GUI.GDSmooth) AND open       THEN ClickThree;END;
  690.         IF (nummer=GUI.GDSave) AND open         THEN ClickFour(wx,wy); END;
  691.         IF  nummer=GUI.GDScreen                 THEN ClickFive(vp); END;
  692.       END;
  693.       IF (I.vanillaKey IN msg1.class) THEN
  694.         key:=CAP(CHR(msg1.code));
  695.         IF  key="Z"                 THEN ClickNull(size);   END;
  696.         IF (key="C") AND (NOT open) THEN ClickOne(wx,wy);   END;
  697.         IF  key="P"                 THEN ClickTwo(vp,depth);END;
  698.         IF (key="M") AND open       THEN ClickThree;        END;
  699.         IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
  700.         IF  key="R"                 THEN ClickFive(vp);     END;
  701.       END;
  702.     ELSE
  703.       IF NOT quit THEN
  704.         msgptr2 := gt.GetIMsg (win.userPort);
  705.         IF msgptr2 # NIL THEN
  706.           msg2 := msgptr2^;
  707.           gt.ReplyIMsg (msgptr2);
  708.  
  709.           IF (I.vanillaKey IN msg2.class) THEN
  710.             key:=CAP(CHR(msg2.code));
  711.             IF  key="Z"                 THEN ClickNull(size);   END;
  712.             IF  key="P"                 THEN ClickTwo(vp,depth);END;
  713.             IF (key="M") AND open       THEN ClickThree;        END;
  714.             IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
  715.             IF  key="R"                 THEN ClickFive(vp);     END;
  716.           END;
  717.           IF (I.closeWindow IN msg2.class) THEN
  718.             CloseWindow(win);
  719.             open := FALSE;
  720.           END;
  721.         END;
  722.       END;
  723.     END;
  724.   UNTIL quit;
  725. CLOSE
  726.   CloseWindow(win);
  727.   GUI.CloseCloudsWindow(GUI.CloudsWnd);
  728.   GUI.ClosePaletteWindow;
  729.   GUI.CloseDownScreen(GUI.Scr);
  730.   GUI.CloseDownScreen(Scr2);
  731. END Clouds.
  732.