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.05 ⌐ 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.05 ⌐ 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;
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;
BEGIN
VERSION := "$VER: CloudsAGA 1.05 (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;
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);