home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 6 / FreshFish_September1994.bin / new / dev / obero / palette / palette.mod < prev    next >
Text File  |  1994-05-31  |  12KB  |  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