home *** CD-ROM | disk | FTP | other *** search
- MODULE CloudsGUI;
-
- (*
- * Source generated with GadToolsBox V2.0b
- * which is (c) Copyright 1991-1993 Jaba Development
- * Oberon-Sourcecode-Generator by Kai Bolay (AMOK)
- *
- * GUI Designed by : Danny Amor
- *)
-
- (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
-
- IMPORT
- e: Exec, I: Intuition, gt: GadTools, g: Graphics, u: Utility, y: SYSTEM, a: ASL, req: Requests;
-
- CONST
- GDSize * = 0;
- GDCreate * = 1;
- GDAnimate * = 2;
- GDSmooth * = 3;
- GDSave * = 4;
- GDScreen * = 5;
- GDPARED * = 0;
- GDPAGREEN * = 1;
- GDPABLUE * = 2;
- GDPAPALETTE * = 3;
- GDPAOK * = 4;
- GDPALOAD * = 5;
- GDPASAVE * = 6;
- GDPARESET * = 7;
- GDPACANCEL * = 8;
-
- CONST
- CloudsCNT = 6;
- CloudsLeft = 106;
- CloudsTop = 20;
- CloudsWidth = 106;
- CloudsHeight = 103;
- PaletteCNT = 9;
- PaletteLeft = 10;
- PaletteTop = 15;
- PaletteWidth = 338;
- PaletteHeight = 159;
-
- CONST
- GDGadget00 * = 0;
-
- CONST
- InfoReqCNT = 1;
- InfoReqLeft = 112;
- InfoReqTop = 105;
- InfoReqWidth = 358;
- InfoReqHeight = 133;
-
- VAR
- Scr*: I.ScreenPtr;
- VisualInfo*: e.APTR;
- CloudsWnd*: I.WindowPtr;
- PaletteWnd*: I.WindowPtr;
- InfoReqWnd*: I.WindowPtr;
- CloudsGList*: I.GadgetPtr;
- CloudsGadgets*: ARRAY CloudsCNT OF I.GadgetPtr;
- PaletteGList*: I.GadgetPtr;
- PaletteGadgets*: ARRAY PaletteCNT OF I.GadgetPtr;
- InfoReqGList*: I.GadgetPtr;
- InfoReqGadgets*: ARRAY InfoReqCNT OF I.GadgetPtr;
- Font*: g.TextAttrPtr;
- Attr*: g.TextAttr;
- FontX, FontY*: INTEGER;
- OffX, OffY: INTEGER;
- Menu*: I.MenuPtr;
-
- TYPE
- Size0LArray = ARRAY 5 OF e.STRPTR;
- CONST
- Size0Labels = Size0LArray (
- y.ADR ("25"),
- y.ADR ("50"),
- y.ADR ("75"),
- y.ADR ("100"),
- NIL );
-
- TYPE
- CloudsGTypesArray = ARRAY CloudsCNT OF INTEGER;
- CONST
- CloudsGTypes = CloudsGTypesArray (
- gt.cycleKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind
- );
-
- TYPE
- CloudsNGadArray = ARRAY CloudsCNT OF gt.NewGadget;
- CONST
- CloudsNGad = CloudsNGadArray (
- 43, 2, 59, 15, y.ADR ("Si_ze"), NIL, GDSize, LONGSET {gt.placeTextLeft} ,NIL, NIL,
- 3, 19, 99, 15, y.ADR ("_Create"), NIL, GDCreate, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 3, 35, 99, 15, y.ADR ("_Palette"), NIL, GDAnimate, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 3, 51, 99, 15, y.ADR ("S_mooth"), NIL, GDSmooth, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 3, 67, 99, 15, y.ADR ("_Save"), NIL, GDSave, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 3, 83, 99, 15, y.ADR ("Sc_reen"), NIL, GDScreen, LONGSET {gt.placeTextIn} ,NIL, NIL
- );
-
- TYPE
- CloudsGTagsArray = ARRAY 20 OF u.Tag;
- CONST
- CloudsGTags * = CloudsGTagsArray (
- gt.underscore, ORD ('_'), gt.cyLabels, y.ADR (Size0Labels[0]), u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done
- );
- TYPE
- PaletteGTypesArray = ARRAY PaletteCNT OF INTEGER;
- CONST
- PaletteGTypes = PaletteGTypesArray (
- gt.sliderKind,
- gt.sliderKind,
- gt.sliderKind,
- gt.paletteKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind,
- gt.buttonKind
- );
-
- TYPE
- PaletteNGadArray = ARRAY PaletteCNT OF gt.NewGadget;
- CONST
- PaletteNGad = PaletteNGadArray (
- 83, 8, 242, 13, y.ADR ("Red: "), NIL, GDPARED, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
- 83, 25, 242, 13, y.ADR ("Green: "), NIL, GDPAGREEN, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
- 83, 42, 242, 13, y.ADR ("Blue: "), NIL, GDPABLUE, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
- 11, 88, 314, 47, y.ADR ("_Palette"), NIL, GDPAPALETTE, LONGSET {gt.placeTextAbove} ,NIL, NIL,
- 4, 141, 91, 14, y.ADR ("_OK"), NIL, GDPAOK, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 83, 58, 76, 14, y.ADR ("_Load..."), NIL, GDPALOAD, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 166, 58, 76, 14, y.ADR ("_Save..."), NIL, GDPASAVE, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 249, 58, 76, 14, y.ADR ("_Reset"), NIL, GDPARESET, LONGSET {gt.placeTextIn} ,NIL, NIL,
- 243, 142, 91, 14, y.ADR ("_Cancel"), NIL, GDPACANCEL, LONGSET {gt.placeTextIn} ,NIL, NIL
- );
-
- TYPE
- PaletteGTagsArray = ARRAY 63 OF u.Tag;
- VAR PaletteGTags: PaletteGTagsArray;
-
- TYPE
- DriPenArray = ARRAY 1 OF INTEGER;
- CONST
- DriPens = DriPenArray (-1);
-
- TYPE
- MenuArray = ARRAY 5 OF gt.NewMenu;
- CONST
- NewMenu = MenuArray (
- gt.title, y.ADR ("Project"), NIL, {}, y.VAL (LONGSET, 0), NIL,
- gt.item, y.ADR ("About..."), y.ADR ("A"), {}, y.VAL (LONGSET, 0), NIL,
- gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
- gt.item, y.ADR ("Quit..."), y.ADR ("Q"), {}, y.VAL (LONGSET, 0), NIL,
- gt.end, NIL, NIL, {}, LONGSET {}, NIL);
-
- VAR
- InfoReqIText: ARRAY 7 OF I.IntuiText;
- TYPE
- InfoReqGTypesArray = ARRAY InfoReqCNT OF INTEGER;
- CONST
- InfoReqGTypes = InfoReqGTypesArray (
- gt.buttonKind
- );
-
- TYPE
- InfoReqNGadArray = ARRAY InfoReqCNT OF gt.NewGadget;
- CONST
- InfoReqNGad = InfoReqNGadArray (
- 133, 114, 91, 14, y.ADR ("_Ok"), NIL, GDGadget00, LONGSET {gt.placeTextIn} ,NIL, NIL
- );
-
- TYPE
- InfoReqGTagsArray = ARRAY 3 OF u.Tag;
- CONST
- InfoReqGTags = InfoReqGTagsArray (
- gt.underscore, ORD ('_'), u.done
- );
-
- PROCEDURE ComputeX (value: INTEGER): INTEGER;
- BEGIN
- RETURN ((FontX * value) + 4 ) DIV 8;
- END ComputeX;
-
- PROCEDURE ComputeY (value: INTEGER): INTEGER;
- BEGIN
- RETURN ((FontY * value) + 4 ) DIV 8;
- END ComputeY;
-
- PROCEDURE ComputeFont (width, height: INTEGER; VAR Scr: I.ScreenPtr);
- BEGIN
- Font := y. ADR (Attr);
- Font^.name := Scr^.rastPort.font^.message.node.name;
- FontY := Scr^.rastPort.font^.ySize;
- Font^.ySize := FontY;
- FontX := Scr^.rastPort.font^.xSize;
-
- OffX := Scr^.wBorLeft;
- OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
-
- IF (width # 0) AND (height # 0) AND
- (ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
- (ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
- Font^.name := y.ADR ("topaz.font");
- Font^.ySize := 8;
- FontY := Font^.ySize;
- FontX := Font^.ySize;
- END;
- END ComputeFont;
-
- PROCEDURE SetupScreen*(VAR depth,resx,resy: LONGINT): INTEGER;
-
- VAR Req : UNTRACED POINTER TO a.ScreenModeRequester;
- DisplayID : LONGINT;
- Ok : BOOLEAN;
-
- BEGIN
- IF a.asl.version>37 THEN
- IF a.asl#NIL THEN
- Req := a.AllocAslRequestTags(a.screenModeRequest,
- a.doOverscanType,1,
- a.doAutoScroll,1,
- a.doHeight,1,
- a.doWidth,1,
- a.doDepth,1,
- a.initialDisplayID,g.euro72ProductKey,
- a.initialDisplayWidth,656,
- a.initialDisplayHeight,414,
- a.initialDisplayDepth,depth,
- a.smMinDepth,5,
- a.smMaxDepth,7,
- u.done);
- IF Req#NIL THEN
- Ok:=a.AslRequest(Req,NIL);
- IF Ok THEN
- DisplayID := Req^.displayID;
- resx := Req^.displayWidth;
- resy := Req^.displayHeight;
- depth := Req^.displayDepth;
-
- Scr := I.OpenScreenTagsA (NIL, I.saLeft, 0,
- I.saTop, 0,
- I.saWidth, resx,
- I.saHeight, resy,
- I.saDepth, depth,
- I.saType, LONGSET{0..3},
- I.saDisplayID, DisplayID,
- I.saAutoScroll, I.LTRUE,
- I.saOverscan, I.oScanText,
- I.saPens, y.ADR (DriPens[0]),
- I.saTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
- u.done);
- IF Scr = NIL THEN RETURN 1 END;
-
- ComputeFont (0, 0, Scr);
-
- VisualInfo := gt.GetVisualInfo (Scr, u.done);
- IF VisualInfo = NIL THEN RETURN 2 END;
- ELSE RETURN 5 END;
- END;
- END;
- ELSE
- IF g.base.libNode.version>36 THEN
- Ok:=req.Request("Clouds Request:","You only have Workbench 2.0!\nYou can only choose between high\nand low resolution!","High","Low");
- depth:=5;
- resx:=320;
- resy:=256;
- DisplayID:=g.loresKey+g.palMonitorID;
- IF Ok THEN resy:=512; DisplayID:=g.loresLaceKey+g.palMonitorID; END;
- Scr := I.OpenScreenTagsA (NIL, I.saLeft, 0,
- I.saTop, 0,
- I.saWidth, resx,
- I.saHeight, resy,
- I.saDepth, depth,
- I.saType, LONGSET{0..3},
- I.saDisplayID, DisplayID,
- I.saAutoScroll, I.LTRUE,
- I.saPens, y.ADR (DriPens[0]),
- I.saTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
- u.done);
- IF Scr = NIL THEN RETURN 1 END;
-
- ComputeFont (0, 0, Scr);
-
- VisualInfo := gt.GetVisualInfo (Scr, u.done);
- IF VisualInfo = NIL THEN RETURN 2 END;
- ELSE
- req.Fail("Sorry, you need Amiga-OS 2.0 or higher!");
- END;
- END;
- RETURN 0;
- END SetupScreen;
-
- PROCEDURE CloseDownScreen* (VAR scr : I.ScreenPtr);
- BEGIN
- IF VisualInfo # NIL THEN
- gt.FreeVisualInfo (VisualInfo);
- VisualInfo := NIL;
- END;
- IF Scr # NIL THEN
- IF I.CloseScreen (Scr) THEN END;
- Scr := NIL;
- END;
- END CloseDownScreen;
-
- PROCEDURE OpenCloudsWindow* (VAR CloudsWnd: I.WindowPtr; VAR Scr: I.ScreenPtr): INTEGER;
-
-
- VAR
- ng: gt.NewGadget;
- gad: I.GadgetPtr;
- help: u.TagListPtr;
- lc, tc, lvc, offx, offy: INTEGER;
- wleft, wtop: INTEGER;
-
- BEGIN
- wleft := CloudsLeft; wtop := CloudsTop;
-
- ComputeFont (CloudsWidth, CloudsHeight,Scr);
-
- wleft := Scr^.width - ComputeX(CloudsWidth);
- wtop := OffY;
-
- Menu := gt.CreateMenus (NewMenu, gt.mnNewLookMenus, 1,u.done);
- IF Menu = NIL THEN RETURN 3 END;
-
- IF NOT gt.LayoutMenus (Menu, VisualInfo, gt.mnTextAttr, Font, u.done) THEN RETURN 4 END;
-
- gad := gt.CreateContext (CloudsGList);
- IF gad = NIL THEN RETURN 1 END;
-
- lc := 0; tc := 0; lvc := 0;
-
- WHILE lc < CloudsCNT DO
- ng := CloudsNGad[lc];
- ng.visualInfo := VisualInfo;
- ng.textAttr := Font;
- ng.leftEdge := OffX + ComputeX (ng.leftEdge);
- ng.topEdge := OffY + ComputeY (ng.topEdge);
- ng.width := ComputeX (ng.width);
- ng.height := ComputeY (ng.height);
-
- help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (CloudsGTags[tc])));
- IF help = NIL THEN RETURN 8 END;
- gad := gt.CreateGadgetA (CloudsGTypes[lc], gad, ng, help^ );
- IF gad = NIL THEN RETURN 2 END;
- u.FreeTagItems (help);
- CloudsGadgets[lc] := gad;
-
- WHILE CloudsGTags[tc] # u.done DO INC (tc, 2) END;
- INC (tc);
-
- lc:=lc+1; (* INC (lc); *)
- END; (* WHILE *)
-
- CloudsWnd := I.OpenWindowTagsA ( NIL,
- I.waLeft, wleft,
- I.waTop, wtop,
- I.waWidth, ComputeX(CloudsWidth) + OffX + Scr^.wBorRight,
- I.waHeight, ComputeY(CloudsHeight) + OffY + Scr^.wBorBottom,
- I.waIDCMP, gt.cycleIDCMP+gt.buttonIDCMP+LONGSET {I.closeWindow,I.refreshWindow,I.vanillaKey,I.menuPick},
- I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.activate,I.newLookMenus},
- I.waGadgets, CloudsGList,
- I.waTitle, y.ADR ("Clouds"),
- I.waScreenTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
- I.waCustomScreen, Scr,
- u.done);
-
- IF CloudsWnd = NIL THEN RETURN 20 END;
-
- IF NOT I.SetMenuStrip (CloudsWnd, Menu^) THEN RETURN 5 END;
- gt.RefreshWindow (CloudsWnd, NIL);
-
- RETURN 0;
-
- END OpenCloudsWindow;
-
- PROCEDURE CloseCloudsWindow* (VAR CloudsWnd: I.WindowPtr);
- BEGIN
- IF Menu # NIL THEN
- IF CloudsWnd # NIL THEN
- I.ClearMenuStrip (CloudsWnd);
- END;
- gt.FreeMenus(Menu);
- Menu := NIL;
- END;
- IF CloudsWnd # NIL THEN
- I.CloseWindow (CloudsWnd);
- CloudsWnd := NIL;
- END;
- IF CloudsGList # NIL THEN
- gt.FreeGadgets (CloudsGList);
- CloudsGList := NIL;
- END;
- END CloseCloudsWindow;
-
-
- PROCEDURE PaletteRender*;
- BEGIN
- gt.DrawBevelBox(PaletteWnd^.rPort, OffX + ComputeX (4),
- OffY + ComputeY (4),
- ComputeX (329),
- ComputeY (134),
- gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
- END PaletteRender;
-
- PROCEDURE OpenPaletteWindow* (depth: LONGINT): INTEGER;
-
- VAR
- ng: gt.NewGadget;
- gad: I.GadgetPtr;
- help: u.TagListPtr;
- lc, tc, lvc, offx, offy: INTEGER;
- wleft, wtop, ww, wh: INTEGER;
- BEGIN
- PaletteGTags := PaletteGTagsArray (
- gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
- gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
- gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
- gt.paDepth, 5, gt.paIndicatorWidth, 50, gt.paColor, 3, gt.paColorOffset, 0, gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
- gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
- gt.underscore, ORD ('_'), u.done,
- gt.underscore, ORD ('_'), u.done
- );
- IF depth#5 THEN PaletteGTags[34]:=depth; END;
- IF g.base.libNode.version<39 THEN
- PaletteGTags[1] :=15;
- PaletteGTags[12]:=15;
- PaletteGTags[23]:=15;
- END;
-
- wleft := PaletteLeft; wtop := PaletteTop;
-
- ComputeFont (PaletteWidth, PaletteHeight, Scr);
-
- ww := ComputeX (PaletteWidth);
- wh := ComputeY (PaletteHeight);
-
- IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
- wleft := Scr^.width - ww;
- END;
- IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
- wtop := Scr^.height - wh;
- END;
- gad := gt.CreateContext (PaletteGList);
- IF gad = NIL THEN RETURN 1 END;
-
- lc := 0; tc := 0; lvc := 0;
- WHILE lc < PaletteCNT DO
- ng := PaletteNGad[lc];
- ng.visualInfo := VisualInfo;
- ng.textAttr := Font;
- ng.leftEdge := OffX + ComputeX (ng.leftEdge);
- ng.topEdge := OffY + ComputeY (ng.topEdge);
- ng.width := ComputeX (ng.width);
- ng.height := ComputeY (ng.height);
-
- help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (PaletteGTags[tc])));
- IF help = NIL THEN RETURN 8 END;
- gad := gt.CreateGadgetA (PaletteGTypes[lc], gad, ng, help^ );
- u.FreeTagItems (help);
- IF gad = NIL THEN RETURN 2 END;
- PaletteGadgets[lc] := gad;
-
- WHILE PaletteGTags[tc] # u.done DO INC (tc, 2) END;
- INC (tc);
-
- INC (lc);
- END; (* WHILE *)
- PaletteWnd := I.OpenWindowTagsA ( NIL,
- I.waLeft, wleft,
- I.waTop, wtop,
- I.waWidth, ww + OffX + Scr^.wBorRight,
- I.waHeight, wh + OffY + Scr^.wBorBottom,
- I.waIDCMP, gt.sliderIDCMP+gt.paletteIDCMP+gt.buttonIDCMP+LONGSET {I.vanillaKey,I.refreshWindow},
- I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.activate,I.rmbTrap},
- I.waGadgets, PaletteGList,
- I.waTitle, y.ADR ("Edit Screen Palette"),
- I.waCustomScreen, Scr,
- I.waAutoAdjust, I.LTRUE,
- u.done);
- IF PaletteWnd = NIL THEN RETURN 20 END;
-
- gt.RefreshWindow (PaletteWnd, NIL);
-
- PaletteRender;
-
- RETURN 0;
- END OpenPaletteWindow;
-
- PROCEDURE ClosePaletteWindow*;
- BEGIN
- IF PaletteWnd # NIL THEN
- I.CloseWindow (PaletteWnd);
- PaletteWnd := NIL;
- END;
- IF PaletteGList # NIL THEN
- gt.FreeGadgets (PaletteGList);
- PaletteGList := NIL;
- END;
- END ClosePaletteWindow;
-
- PROCEDURE InfoReqRender*;
- BEGIN
- InfoReqIText[0].iText := y.ADR ("Clouds 1.05");
- InfoReqIText[0].iTextFont := Font;
- InfoReqIText[0].frontPen := 2;
- InfoReqIText[0].backPen := 0;
- InfoReqIText[0].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[0].leftEdge := OffX + ComputeX (178) - (I.IntuiTextLength (InfoReqIText[0]) DIV 2);
- InfoReqIText[0].topEdge := OffY + ComputeY (10) - (Font^.ySize DIV 2);
- InfoReqIText[0].nextText := y.ADR (InfoReqIText[1]);
-
- InfoReqIText[1].iText := y.ADR ("written by Danny Amor in 1994");
- InfoReqIText[1].iTextFont := Font;
- InfoReqIText[1].frontPen := 1;
- InfoReqIText[1].backPen := 0;
- InfoReqIText[1].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[1].leftEdge := OffX + ComputeX (178) - (I.IntuiTextLength (InfoReqIText[1]) DIV 2);
- InfoReqIText[1].topEdge := OffY + ComputeY (22) - (Font^.ySize DIV 2);
- InfoReqIText[1].nextText := y.ADR (InfoReqIText[2]);
-
- InfoReqIText[2].iText := y.ADR ("Danny Amor");
- InfoReqIText[2].iTextFont := Font;
- InfoReqIText[2].frontPen := 1;
- InfoReqIText[2].backPen := 0;
- InfoReqIText[2].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[2].leftEdge := OffX + ComputeX (181) - (I.IntuiTextLength (InfoReqIText[2]) DIV 2);
- InfoReqIText[2].topEdge := OffY + ComputeY (49) - (Font^.ySize DIV 2);
- InfoReqIText[2].nextText := y.ADR (InfoReqIText[3]);
-
- InfoReqIText[3].iText := y.ADR ("Ludwigstr. 124");
- InfoReqIText[3].iTextFont := Font;
- InfoReqIText[3].frontPen := 1;
- InfoReqIText[3].backPen := 0;
- InfoReqIText[3].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[3].leftEdge := OffX + ComputeX (182) - (I.IntuiTextLength (InfoReqIText[3]) DIV 2);
- InfoReqIText[3].topEdge := OffY + ComputeY (59) - (Font^.ySize DIV 2);
- InfoReqIText[3].nextText := y.ADR (InfoReqIText[4]);
-
- InfoReqIText[4].iText := y.ADR ("70197 Stuttgart");
- InfoReqIText[4].iTextFont := Font;
- InfoReqIText[4].frontPen := 1;
- InfoReqIText[4].backPen := 0;
- InfoReqIText[4].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[4].leftEdge := OffX + ComputeX (182) - (I.IntuiTextLength (InfoReqIText[4]) DIV 2);
- InfoReqIText[4].topEdge := OffY + ComputeY (69) - (Font^.ySize DIV 2);
- InfoReqIText[4].nextText := y.ADR (InfoReqIText[5]);
-
- InfoReqIText[5].iText := y.ADR ("Germany");
- InfoReqIText[5].iTextFont := Font;
- InfoReqIText[5].frontPen := 1;
- InfoReqIText[5].backPen := 0;
- InfoReqIText[5].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[5].leftEdge := OffX + ComputeX (180) - (I.IntuiTextLength (InfoReqIText[5]) DIV 2);
- InfoReqIText[5].topEdge := OffY + ComputeY (79) - (Font^.ySize DIV 2);
- InfoReqIText[5].nextText := y.ADR (InfoReqIText[6]);
-
- InfoReqIText[6].iText := y.ADR ("Have you already smiled today?");
- InfoReqIText[6].iTextFont := Font;
- InfoReqIText[6].frontPen := 2;
- InfoReqIText[6].backPen := 0;
- InfoReqIText[6].drawMode := g.jam1+SHORTSET {};
- InfoReqIText[6].leftEdge := OffX + ComputeX (188) - (I.IntuiTextLength (InfoReqIText[6]) DIV 2);
- InfoReqIText[6].topEdge := OffY + ComputeY (105) - (Font^.ySize DIV 2);
- InfoReqIText[6].nextText := NIL;
-
- I.PrintIText (InfoReqWnd^.rPort, InfoReqIText[0], 0, 0);
- gt.DrawBevelBox(InfoReqWnd^.rPort, OffX + ComputeX (244),
- OffY + ComputeY (35),
- ComputeX (105),
- ComputeY (61),
- gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
- gt.DrawBevelBox(InfoReqWnd^.rPort, OffX + ComputeX (12),
- OffY + ComputeY (34),
- ComputeX (105),
- ComputeY (61),
- gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
- END InfoReqRender;
-
- PROCEDURE OpenInfoReqWindow* (): INTEGER;
- VAR
- ng: gt.NewGadget;
- gad: I.GadgetPtr;
- help: u.TagListPtr;
- lc, tc, lvc, offx, offy: INTEGER;
- wleft, wtop, ww, wh: INTEGER;
- BEGIN
- wleft := InfoReqLeft; wtop := InfoReqTop;
-
- ComputeFont (InfoReqWidth, InfoReqHeight, Scr);
-
- ww := ComputeX (InfoReqWidth);
- wh := ComputeY (InfoReqHeight);
-
- IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
- wleft := Scr^.width - ww;
- END;
- IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
- wtop := Scr^.height - wh;
- END;
- gad := gt.CreateContext (InfoReqGList);
- IF gad = NIL THEN RETURN 1 END;
-
- lc := 0; tc := 0; lvc := 0;
- WHILE lc < InfoReqCNT DO
- ng := InfoReqNGad[lc];
- ng.visualInfo := VisualInfo;
- ng.textAttr := Font;
- ng.leftEdge := OffX + ComputeX (ng.leftEdge);
- ng.topEdge := OffY + ComputeY (ng.topEdge);
- ng.width := ComputeX (ng.width);
- ng.height := ComputeY (ng.height);
-
- help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (InfoReqGTags[tc])));
- IF help = NIL THEN RETURN 8 END;
- gad := gt.CreateGadgetA (InfoReqGTypes[lc], gad, ng, help^ );
- u.FreeTagItems (help);
- IF gad = NIL THEN RETURN 2 END;
- InfoReqGadgets[lc] := gad;
-
- WHILE InfoReqGTags[tc] # u.done DO INC (tc, 2) END;
- INC (tc);
-
- INC (lc);
- END; (* WHILE *)
- InfoReqWnd := I.OpenWindowTagsA ( NIL,
- I.waLeft, wleft,
- I.waTop, wtop,
- I.waWidth, ww + OffX + Scr^.wBorRight,
- I.waHeight, wh + OffY + Scr^.wBorBottom,
- I.waIDCMP, gt.buttonIDCMP+LONGSET {I.vanillaKey,I.refreshWindow},
- I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.activate},
- I.waGadgets, InfoReqGList,
- I.waTitle, y.ADR ("CloudsAGA Requester"),
- I.waScreenTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
- I.waPubScreen, Scr,
- u.done);
- IF InfoReqWnd = NIL THEN RETURN 20 END;
-
- gt.RefreshWindow (InfoReqWnd, NIL);
-
- InfoReqRender;
-
- RETURN 0;
- END OpenInfoReqWindow;
-
- PROCEDURE CloseInfoReqWindow*;
- BEGIN
- IF InfoReqWnd # NIL THEN
- I.CloseWindow (InfoReqWnd);
- InfoReqWnd := NIL;
- END;
- IF InfoReqGList # NIL THEN
- gt.FreeGadgets (InfoReqGList);
- InfoReqGList := NIL;
- END;
- END CloseInfoReqWindow;
-
- END CloudsGUI.
-