home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / fish / disks / d1096.lha / Programs / CloudsAGA / Source / Palette.MOD < prev   
Encoding:
Text File  |  1994-07-18  |  12.2 KB  |  365 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    Palette.mod
  3.     :Author.     Daniel Amor
  4.     :Address.    Ludwigstr. 124, D-70197 Stuttgart, Germany
  5.     :Version.    1.0
  6.     :Date.       31-May-94
  7.     :Copyright.  PD
  8.     :Language.   Oberon-2
  9.     :Translator. Amiga Oberon 3.0
  10.     :Imports.    Palette [da].
  11.     :Contents.   Öffnet Palette-Fenster.
  12. ---------------------------------------------------------------------------*)
  13.  
  14. MODULE Palette;
  15.  
  16. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
  17.  
  18. IMPORT  e    : Exec,
  19.         I    : Intuition,
  20.         gt   : GadTools,
  21.         g    : Graphics,
  22.         req  : Requests,
  23.         u    : Utility,
  24.         y    : SYSTEM;
  25.  
  26. CONST
  27.   PaletteCNT        = 9;
  28.   PaletteLeft       = 10;
  29.   PaletteTop        = 15;
  30.   PaletteWidth      = 338;
  31.   PaletteHeight     = 159;
  32.   GDPARED           = 0;
  33.   GDPAGREEN         = 1;
  34.   GDPABLUE          = 2;
  35.   GDPAPALETTE       = 3;
  36.   GDPAOK            = 4;
  37.   GDPALOAD          = 5;
  38.   GDPASAVE          = 6;
  39.   GDPARESET         = 7;
  40.   GDPACANCEL        = 8;
  41.  
  42. TYPE colourstype256  = ARRAY 769 OF LONGINT;
  43.      colourArray     = ARRAY 31 OF INTEGER;
  44.      colourRecord  * = RECORD
  45.                          AGACol * : colourstype256;
  46.                          NoAGA * :  colourArray;
  47.                        END;
  48.  
  49. VAR msgptr         : I.IntuiMessagePtr;
  50.     msg            : I.IntuiMessage;
  51.     vp             : g.ViewPortPtr;
  52.     version        : INTEGER;
  53.     Col,Colcopy    : colourRecord;
  54.     VisualInfo     : e.APTR;
  55.     PaletteWnd     : I.WindowPtr;
  56.     PaletteGList   : I.GadgetPtr;
  57.     PaletteGadgets : ARRAY PaletteCNT OF I.GadgetPtr;
  58.     Font           : g.TextAttrPtr;
  59.     Attr           : g.TextAttr;
  60.     FontX, FontY   : INTEGER;
  61.     OffX, OffY     : INTEGER;
  62.     depth          : LONGINT;
  63.  
  64. TYPE PaletteGTypesArray = ARRAY PaletteCNT OF INTEGER;
  65.  
  66. CONST PaletteGTypes = PaletteGTypesArray (gt.sliderKind,
  67.                                           gt.sliderKind,
  68.                                           gt.sliderKind,
  69.                                           gt.paletteKind,
  70.                                           gt.buttonKind,
  71.                                           gt.buttonKind,
  72.                                           gt.buttonKind,
  73.                                           gt.buttonKind,
  74.                                           gt.buttonKind);
  75.  
  76. TYPE PaletteNGadArray = ARRAY PaletteCNT OF gt.NewGadget;
  77.  
  78. CONST PaletteNGad = PaletteNGadArray (
  79.     83, 8, 242, 13, y.ADR ("Red:    "), NIL, GDPARED, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
  80.     83, 25, 242, 13, y.ADR ("Green:  "), NIL, GDPAGREEN, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
  81.     83, 42, 242, 13, y.ADR ("Blue:   "), NIL, GDPABLUE, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
  82.     11, 88, 314, 47, y.ADR ("_Palette"), NIL, GDPAPALETTE, LONGSET {gt.placeTextAbove} ,NIL, NIL,
  83.     4, 141, 91, 14, y.ADR ("_OK"), NIL, GDPAOK, LONGSET {gt.placeTextIn} ,NIL, NIL,
  84.     83, 58, 76, 14, y.ADR ("_Load..."), NIL, GDPALOAD, LONGSET {gt.placeTextIn} ,NIL, NIL,
  85.     166, 58, 76, 14, y.ADR ("_Save..."), NIL, GDPASAVE, LONGSET {gt.placeTextIn} ,NIL, NIL,
  86.     249, 58, 76, 14, y.ADR ("_Reset"), NIL, GDPARESET, LONGSET {gt.placeTextIn} ,NIL, NIL,
  87.     243, 142, 91, 14, y.ADR ("_Cancel"), NIL, GDPACANCEL, LONGSET {gt.placeTextIn} ,NIL, NIL);
  88.  
  89. TYPE PaletteGTagsArray = ARRAY    63 OF u.Tag;
  90.  
  91. VAR PaletteGTags: PaletteGTagsArray;
  92.  
  93. PROCEDURE ComputeX (value: INTEGER): INTEGER;
  94.  
  95. BEGIN
  96.   RETURN ((FontX * value) + 4 ) DIV 8;
  97. END ComputeX;
  98.  
  99. PROCEDURE ComputeY (value: INTEGER): INTEGER;
  100.  
  101. BEGIN
  102.   RETURN ((FontY * value)  + 4 ) DIV 8;
  103. END ComputeY;
  104.  
  105. PROCEDURE ComputeFont (width, height: INTEGER; VAR Scr: I.ScreenPtr);
  106.  
  107. BEGIN
  108.   Font := y. ADR (Attr);
  109.   Font^.name := Scr^.rastPort.font^.message.node.name;
  110.   FontY := Scr^.rastPort.font^.ySize;
  111.   Font^.ySize := FontY;
  112.   FontX := Scr^.rastPort.font^.xSize;
  113.  
  114.   OffX := Scr^.wBorLeft;
  115.   OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
  116.  
  117.   IF (width # 0) AND (height # 0) AND
  118.      (ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
  119.      (ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
  120.     Font^.name := y.ADR ("topaz.font");
  121.     Font^.ySize := 8;
  122.     FontY := Font^.ySize;
  123.     FontX := Font^.ySize;
  124.   END;
  125. END ComputeFont;
  126.  
  127. PROCEDURE PaletteRender*;
  128.  
  129. BEGIN
  130.   gt.DrawBevelBox(PaletteWnd^.rPort, OffX + ComputeX (4),
  131.                   OffY + ComputeY (4),
  132.                   ComputeX (329),
  133.                   ComputeY (134),
  134.                   gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
  135. END PaletteRender;
  136.  
  137. PROCEDURE OpenPaletteWindow* (depth: LONGINT; Scr: I.ScreenPtr; colornum: INTEGER): INTEGER;
  138.  
  139. VAR
  140.   ng: gt.NewGadget;
  141.   gad: I.GadgetPtr;
  142.   help: u.TagListPtr;
  143.   lc, tc, lvc, offx, offy: INTEGER;
  144.   wleft, wtop, ww, wh: INTEGER;
  145. BEGIN
  146.   VisualInfo := gt.GetVisualInfo (Scr, u.done);
  147.  IF VisualInfo = NIL THEN RETURN 2 END;
  148.  
  149.  PaletteGTags := PaletteGTagsArray (
  150.     gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
  151.     gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
  152.     gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
  153.     gt.paDepth, 5, gt.paIndicatorWidth, 50, gt.paColor, 3, gt.paColorOffset, 0, gt.underscore, ORD ('_'), u.done,
  154.     gt.underscore, ORD ('_'), u.done,
  155.     gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
  156.     gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
  157.     gt.underscore, ORD ('_'), u.done,
  158.     gt.underscore, ORD ('_'), u.done
  159.   );
  160.   PaletteGTags[34]:=depth;
  161.   PaletteGTags[38]:=colornum;
  162.   version := g.base.libNode.version;
  163.   IF version<39 THEN
  164.     PaletteGTags[1] :=15;
  165.     PaletteGTags[12]:=15;
  166.     PaletteGTags[23]:=15;
  167.   END;
  168.  
  169.   wleft := PaletteLeft; wtop := PaletteTop;
  170.  
  171.   ComputeFont (PaletteWidth, PaletteHeight, Scr);
  172.  
  173.   ww := ComputeX (PaletteWidth);
  174.   wh := ComputeY (PaletteHeight);
  175.  
  176.   IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
  177.     wleft := Scr^.width - ww;
  178.   END;
  179.   IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
  180.     wtop := Scr^.height - wh;
  181.   END;
  182.   gad := gt.CreateContext (PaletteGList);
  183.   IF gad = NIL THEN RETURN 1 END;
  184.  
  185.   lc := 0; tc := 0; lvc := 0;
  186.   WHILE lc < PaletteCNT DO
  187.     ng := PaletteNGad[lc];
  188.     ng.visualInfo := VisualInfo;
  189.     ng.textAttr   := Font;
  190.     ng.leftEdge   := OffX + ComputeX (ng.leftEdge);
  191.     ng.topEdge    := OffY + ComputeY (ng.topEdge);
  192.     ng.width      := ComputeX (ng.width);
  193.     ng.height     := ComputeY (ng.height);
  194.  
  195.     help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (PaletteGTags[tc])));
  196.     IF help = NIL THEN RETURN 8 END;
  197.     gad := gt.CreateGadgetA (PaletteGTypes[lc], gad, ng, help^ );
  198.     u.FreeTagItems (help);
  199.     IF gad = NIL THEN RETURN 2 END;
  200.     PaletteGadgets[lc] := gad;
  201.  
  202.     WHILE PaletteGTags[tc] # u.done DO INC (tc, 2) END;
  203.     INC (tc);
  204.  
  205.     INC (lc);
  206.   END; (* WHILE *)
  207.   PaletteWnd := I.OpenWindowTagsA ( NIL,
  208.                     I.waLeft,          wleft,
  209.                     I.waTop,           wtop,
  210.                     I.waWidth,         ww + OffX + Scr^.wBorRight,
  211.                     I.waHeight,        wh + OffY + Scr^.wBorBottom,
  212.                     I.waIDCMP,         gt.sliderIDCMP+gt.paletteIDCMP+gt.buttonIDCMP+LONGSET {I.vanillaKey,I.refreshWindow},
  213.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.activate,I.rmbTrap},
  214.                     I.waGadgets,       PaletteGList,
  215.                     I.waTitle,         y.ADR ("Edit Screen Palette"),
  216.                     I.waCustomScreen,  Scr,
  217.                     I.waAutoAdjust,    I.LTRUE,
  218.                     u.done);
  219.   IF PaletteWnd = NIL THEN RETURN 20 END;
  220.  
  221.   gt.RefreshWindow (PaletteWnd, NIL);
  222.  
  223.   PaletteRender;
  224.  
  225.   RETURN 0;
  226. END OpenPaletteWindow;
  227.  
  228. PROCEDURE ClosePaletteWindow*;
  229. BEGIN
  230.   IF PaletteWnd # NIL THEN
  231.     I.CloseWindow (PaletteWnd);
  232.     PaletteWnd := NIL;
  233.   END;
  234.   IF PaletteGList # NIL THEN
  235.     gt.FreeGadgets (PaletteGList);
  236.     PaletteGList := NIL;
  237.   END;
  238. END ClosePaletteWindow;
  239.  
  240. PROCEDURE SetColors(VAR ColRec: colourRecord; VAR vp: g.ViewPortPtr; VAR numcolours: LONGINT);
  241.  
  242. BEGIN
  243.   IF version<39 THEN
  244.     g.LoadRGB4(vp,ColRec.NoAGA,numcolours);
  245.   ELSE
  246.     g.LoadRGB32(vp,ColRec.AGACol);
  247.   END;
  248. END SetColors;
  249.  
  250. PROCEDURE GetColour(VAR Col: colourRecord; numcolours: LONGINT; Scr: I.ScreenPtr);
  251.  
  252. VAR i,colo: LONGINT;
  253.  
  254. BEGIN
  255.   IF version>38 THEN
  256.     g.GetRGB32(Scr^.viewPort.colorMap,0,numcolours,Col.AGACol);
  257.     colo := numcolours*3;
  258.     FOR i:=0 TO colo DO Col.AGACol[colo-i+1]:=Col.AGACol[colo-i]; END;
  259.     Col.AGACol[colo*3+1] := 0;
  260.     Col.AGACol[0]        := 010000H*numcolours;
  261.   ELSE
  262.     FOR i:=0 TO numcolours-1 DO
  263.       Col.NoAGA[i]:=g.GetRGB4(Scr^.viewPort.colorMap,i);
  264.     END;
  265.   END;
  266. END GetColour;
  267.  
  268. PROCEDURE SetSlider(VAR Col: colourRecord; VAR colornum: INTEGER);
  269.  
  270. VAR blue,green,red,i : INTEGER;
  271.  
  272. BEGIN
  273.   IF version>38 THEN
  274.     red   := SHORT(Col.AGACol[colornum*3+1] DIV 001000000H);
  275.     green := SHORT(Col.AGACol[colornum*3+2] DIV 001000000H);
  276.     blue  := SHORT(Col.AGACol[colornum*3+3] DIV 001000000H);
  277.     IF red<0   THEN red  :=256+red; END;
  278.     IF green<0 THEN green:=256+green; END;
  279.     IF blue<0  THEN blue :=256+blue; END;
  280.   ELSE
  281.     red   := y.LSH(Col.NoAGA[colornum],-8);
  282.     green := y.LSH(y.LSH(Col.NoAGA[colornum],8),-12);
  283.     blue  := y.LSH(y.LSH(Col.NoAGA[colornum],12),-12);
  284.   END;
  285.   gt.SetGadgetAttrs(PaletteGadgets[0]^,PaletteWnd,NIL,gt.slLevel,red);
  286.   gt.SetGadgetAttrs(PaletteGadgets[1]^,PaletteWnd,NIL,gt.slLevel,green);
  287.   gt.SetGadgetAttrs(PaletteGadgets[2]^,PaletteWnd,NIL,gt.slLevel,blue);
  288. END SetSlider;
  289.  
  290. PROCEDURE SetColor(VAR Col: colourRecord; VAR vp: g.ViewPortPtr;
  291.                    VAR colornum: INTEGER; coltype: INTEGER; VAR count: INTEGER);
  292.  
  293. VAR red,green,blue,colo: INTEGER;
  294.  
  295. BEGIN
  296.   IF version>38 THEN
  297.     colo:=colornum*3;
  298.     Col.AGACol[colo+coltype]:=count*001000000H;
  299.     g.SetRGB32(vp,colornum,Col.AGACol[colo+1],Col.AGACol[colo+2],Col.AGACol[colo+3]);
  300.   ELSE
  301.     red   := y.LSH(Col.NoAGA[colornum],-8);
  302.     green := y.LSH(y.LSH(Col.NoAGA[colornum],8),-12);
  303.     blue  := y.LSH(y.LSH(Col.NoAGA[colornum],12),-12);
  304.     IF coltype=1 THEN red   := count; END;
  305.     IF coltype=2 THEN green := count; END;
  306.     IF coltype=3 THEN blue  := count; END;
  307.     g.SetRGB4(vp,colornum,red,green,blue);
  308.     red   := y.LSH(red,8);
  309.     green := y.LSH(green,4);
  310.     Col.NoAGA[colornum]:=red+green+blue;
  311.   END;
  312. END SetColor;
  313.  
  314. PROCEDURE ShowPalette*(Scr: I.ScreenPtr; VAR ColRec: colourRecord; colornum: INTEGER);
  315.  
  316. VAR quit       : BOOLEAN;
  317.     aktgad     : I.GadgetPtr;
  318.     nummer,info: INTEGER;
  319.     numcolours : INTEGER;
  320.  
  321. BEGIN
  322.   vp    := y.ADR(Scr^.viewPort);
  323.   depth := Scr^.rastPort.bitMap.depth;
  324.   numcolours := y.LSH(LONG(1),depth);
  325.   req.Assert(OpenPaletteWindow(depth,Scr,colornum)=0,"Unable to open palette window!");
  326.   GetColour(Col,numcolours,Scr);
  327.   IF ColRec.AGACol[0]=NIL THEN
  328.     ColRec:=Col;
  329.   END;
  330.   Colcopy:=Col;
  331.   quit:=FALSE;
  332.   SetSlider(Colcopy,colornum);
  333.   REPEAT
  334.     e.WaitPort(PaletteWnd.userPort);
  335.     msgptr := gt.GetIMsg (PaletteWnd.userPort);
  336.     IF msgptr#NIL THEN
  337.       msg  := msgptr^;
  338.       info := msg.code;
  339.       gt.ReplyIMsg (msgptr);
  340.       IF (I.gadgetUp IN msg.class) THEN
  341.         aktgad:=msg.iAddress;
  342.         nummer:=aktgad.gadgetID;
  343.         IF nummer=GDPACANCEL  THEN SetColors(Col,vp,depth); quit:=TRUE; END;
  344.         IF nummer=GDPARED     THEN SetColor(Colcopy,vp,colornum,1,info); END;
  345.         IF nummer=GDPAGREEN   THEN SetColor(Colcopy,vp,colornum,2,info); END;
  346.         IF nummer=GDPABLUE    THEN SetColor(Colcopy,vp,colornum,3,info); END;
  347.         IF nummer=GDPAOK      THEN quit:=TRUE; END;
  348.         IF nummer=GDPAPALETTE THEN colornum:=info; SetSlider(Colcopy,colornum); END;
  349.         IF nummer=GDPARESET   THEN SetColors(ColRec,vp,depth); GetColour(Colcopy,numcolours,Scr); SetSlider(Colcopy,colornum); END;
  350.       ELSE
  351.         IF (I.mouseMove IN msg.class) THEN
  352.           aktgad:=msg.iAddress;
  353.           nummer:=aktgad.gadgetID;
  354.           IF nummer=GDPARED     THEN SetColor(Colcopy,vp,colornum,1,info); END;
  355.           IF nummer=GDPAGREEN   THEN SetColor(Colcopy,vp,colornum,2,info); END;
  356.           IF nummer=GDPABLUE    THEN SetColor(Colcopy,vp,colornum,3,info); END;
  357.         END;
  358.       END;
  359.     END;
  360.   UNTIL quit;
  361.   ClosePaletteWindow;
  362. END ShowPalette;
  363.  
  364. END Palette.
  365.