home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 6
/
FreshFish_September1994.bin
/
new
/
dev
/
obero
/
palette
/
palette.mod
< prev
next >
Wrap
Text File
|
1994-05-31
|
12KB
|
365 lines
(*---------------------------------------------------------------------------
:Program. Palette.mod
:Author. Daniel Amor
:Address. Ludwigstr. 124, D-70197 Stuttgart, Germany
:Version. 1.0
:Date. 31-May-94
:Copyright. PD
:Language. Oberon-2
:Translator. Amiga Oberon 3.0
:Imports. Palette [da].
:Contents. Öffnet Palette-Fenster.
---------------------------------------------------------------------------*)
MODULE Palette;
(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
IMPORT e : Exec,
I : Intuition,
gt : GadTools,
g : Graphics,
req : Requests,
u : Utility,
y : SYSTEM;
CONST
PaletteCNT = 9;
PaletteLeft = 10;
PaletteTop = 15;
PaletteWidth = 338;
PaletteHeight = 159;
GDPARED = 0;
GDPAGREEN = 1;
GDPABLUE = 2;
GDPAPALETTE = 3;
GDPAOK = 4;
GDPALOAD = 5;
GDPASAVE = 6;
GDPARESET = 7;
GDPACANCEL = 8;
TYPE colourstype256 = ARRAY 769 OF LONGINT;
colourArray = ARRAY 31 OF INTEGER;
colourRecord * = RECORD
AGACol * : colourstype256;
NoAGA * : colourArray;
END;
VAR msgptr : I.IntuiMessagePtr;
msg : I.IntuiMessage;
vp : g.ViewPortPtr;
version : INTEGER;
Col,Colcopy : colourRecord;
VisualInfo : e.APTR;
PaletteWnd : I.WindowPtr;
PaletteGList : I.GadgetPtr;
PaletteGadgets : ARRAY PaletteCNT OF I.GadgetPtr;
Font : g.TextAttrPtr;
Attr : g.TextAttr;
FontX, FontY : INTEGER;
OffX, OffY : INTEGER;
depth : LONGINT;
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;
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 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; Scr: I.ScreenPtr; colornum: INTEGER): INTEGER;
VAR
ng: gt.NewGadget;
gad: I.GadgetPtr;
help: u.TagListPtr;
lc, tc, lvc, offx, offy: INTEGER;
wleft, wtop, ww, wh: INTEGER;
BEGIN
VisualInfo := gt.GetVisualInfo (Scr, u.done);
IF VisualInfo = NIL THEN RETURN 2 END;
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
);
PaletteGTags[34]:=depth;
PaletteGTags[38]:=colornum;
version := g.base.libNode.version;
IF 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