home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / develop / gadtoolsbox / oberon / fadaptpal.mod < prev    next >
Encoding:
Text File  |  1995-02-27  |  8.0 KB  |  269 lines
  1. MODULE FAdaptPAL;
  2.  
  3. (*
  4.  *  Source generated with GadToolsBox V1.4
  5.  *  which is (c) Copyright 1991,92 Jaba Development
  6.  *  Oberon-Sourcecode-Generator by Kai Bolay (AMOK)
  7.  *)
  8.  
  9. IMPORT
  10.   e: Exec, I: Intuition, gt: GadTools, g: Graphics, u: Utility, y: SYSTEM;
  11.  
  12. CONST
  13.   GDGadget00                         = 0;
  14.   GDGadget10                         = 1;
  15.   GDGadget20                         = 2;
  16.   GDGadget30                         = 3;
  17.   GDGadget40                         = 4;
  18.   GDGadget50                         = 5;
  19.   GDGadget60                         = 6;
  20.   GDGadget70                         = 7;
  21.   GDGadget80                         = 8;
  22.   GDGadget90                         = 9;
  23.   GDGadget100                        = 10;
  24.   GDGadget110                        = 11;
  25.  
  26. CONST
  27.   Project0CNT = 12;
  28.   Project0Left = 67;
  29.   Project0Top = 37;
  30.   Project0Width = 463;
  31.   Project0Height = 103;
  32. VAR
  33.   Scr*: I.ScreenPtr;
  34.   VisualInfo*: e.APTR;
  35.   Project0Wnd*: I.WindowPtr;
  36.   Project0GList*: I.GadgetPtr;
  37.   Project0Zoom*: ARRAY 4 OF INTEGER;
  38.   Project0Gadgets*: ARRAY Project0CNT OF I.GadgetPtr;
  39.   Font*: g.TextAttrPtr;
  40.   Attr*: g.TextAttr;
  41.   FontX, FontY: INTEGER;
  42.   OffX, OffY: INTEGER;
  43.  
  44. TYPE
  45.   Gadget500LArray = ARRAY     6 OF e.STRPTR;
  46. CONST
  47.   Gadget500Labels = Gadget500LArray (
  48.     y.ADR ("This"),
  49.     y.ADR ("Is"),
  50.     y.ADR ("A"),
  51.     y.ADR ("Cycle"),
  52.     y.ADR ("Gadget"),
  53.     NIL );
  54.  
  55. VAR
  56. VAR
  57. TYPE
  58.   Project0GTypesArray = ARRAY Project0CNT OF INTEGER;
  59. CONST
  60.   Project0GTypes = Project0GTypesArray (
  61.     gt.buttonKind,
  62.     gt.buttonKind,
  63.     gt.buttonKind,
  64.     gt.integerKind,
  65.     gt.numberKind,
  66.     gt.cycleKind,
  67.     gt.paletteKind,
  68.     gt.scrollerKind,
  69.     gt.sliderKind,
  70.     gt.stringKind,
  71.     gt.textKind,
  72.     gt.buttonKind
  73.   );
  74.  
  75. TYPE
  76.   Project0NGadArray = ARRAY Project0CNT OF gt.NewGadget;
  77. CONST
  78.   Project0NGad = Project0NGadArray (
  79.     5, 87, 129, 14, y.ADR ("Save First"), NIL, GDGadget00, LONGSET {gt.placeTextIn} ,NIL, NIL,
  80.     166, 87, 129, 14, y.ADR ("Continue"), NIL, GDGadget10, LONGSET {gt.placeTextIn} ,NIL, NIL,
  81.     329, 87, 129, 14, y.ADR ("Cancel"), NIL, GDGadget20, LONGSET {gt.placeTextIn} ,NIL, NIL,
  82.     131, 5, 164, 14, y.ADR ("Integer Gadget"), NIL, GDGadget30, LONGSET {gt.placeTextLeft} ,NIL, NIL,
  83.     132, 21, 163, 14, y.ADR ("Number Gadget "), NIL, GDGadget40, LONGSET {gt.placeTextLeft} ,NIL, NIL,
  84.     12, 37, 283, 14, NIL, NIL, GDGadget50, LONGSET {} ,NIL, NIL,
  85.     13, 53, 282, 28, NIL, NIL, GDGadget60, LONGSET {} ,NIL, NIL,
  86.     298, 5, 21, 76, NIL, NIL, GDGadget70, LONGSET {} ,NIL, NIL,
  87.     323, 5, 21, 76, NIL, NIL, GDGadget80, LONGSET {} ,NIL, NIL,
  88.     347, 5, 105, 14, NIL, NIL, GDGadget90, LONGSET {} ,NIL, NIL,
  89.     348, 21, 104, 14, NIL, NIL, GDGadget100, LONGSET {} ,NIL, NIL,
  90.     348, 37, 104, 44, y.ADR ("Big Button"), NIL, GDGadget110, LONGSET {gt.placeTextIn} ,NIL, NIL
  91.   );
  92.  
  93. TYPE
  94.   Project0GTagsArray = ARRAY    52 OF u.Tag;
  95. CONST
  96.   Project0GTags = Project0GTagsArray (
  97.     u.done,
  98.     u.done,
  99.     u.done,
  100.     gt.inNumber, 0, gt.inMaxChars, 666, u.done,
  101.     gt.nmBorder, I.LTRUE, u.done,
  102.     gt.cyLabels, y.ADR (Gadget500Labels[0]), gt.inNumber, 0, gt.inMaxChars, 5, u.done,
  103.     gt.paDepth, 2, gt.paIndicatorWidth, 40, u.done,
  104.     gt.scTotal, 20, gt.scArrows, 16, I.pgaFreedom, I.lorientVert, I.gaRelVerify, I.LTRUE, u.done,
  105.     gt.slMaxLevelLen, 2, gt.slLevelFormat, y.ADR (""), I.pgaFreedom, I.lorientVert, I.gaRelVerify, I.LTRUE, u.done,
  106.     gt.stString, y.ADR ("String"), gt.stMaxChars, 256, u.done,
  107.     gt.txText, y.ADR ("Text"), gt.txBorder, I.LTRUE, u.done,
  108.     u.done
  109.   );
  110.  
  111. PROCEDURE ComputeX (value: INTEGER): INTEGER;
  112. BEGIN
  113.   RETURN ((FontX * value) + 4 ) DIV 8;
  114. END ComputeX;
  115.  
  116. PROCEDURE ComputeY (value: INTEGER): INTEGER;
  117. BEGIN
  118.   RETURN ((FontY * value)  + 4 ) DIV 8;
  119. END ComputeY;
  120.  
  121. PROCEDURE ComputeFont (width, height: INTEGER);
  122. BEGIN
  123.   Font := y. ADR (Attr);
  124.   Font^.name := Scr^.rastPort.font^.message.node.name;
  125.   FontY := Scr^.rastPort.font^.ySize;
  126.   Font^.ySize := FontY;
  127.   FontX := Scr^.rastPort.font^.xSize;
  128.  
  129.   OffX := Scr^.wBorLeft;
  130.   OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
  131.  
  132.   IF (width # 0) AND (height # 0) AND
  133.      (ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
  134.      (ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
  135.     Font^.name := y.ADR ("topaz.font");
  136.     Font^.ySize := 8;
  137.     FontY := Font^.ySize;
  138.     FontX := Font^.ySize;
  139.   END;
  140. END ComputeFont;
  141.  
  142. PROCEDURE SetupScreen* (): INTEGER;
  143. BEGIN
  144.   Scr := I.LockPubScreen ("Workbench");  IF Scr = NIL THEN RETURN 1 END;
  145.  
  146.   ComputeFont (0, 0);
  147.  
  148.   VisualInfo := gt.GetVisualInfo (Scr, u.done);
  149.   IF VisualInfo = NIL THEN RETURN 2 END;
  150.  
  151.   RETURN 0;
  152. END SetupScreen;
  153.  
  154. PROCEDURE CloseDownScreen*;
  155. BEGIN
  156.   IF VisualInfo # NIL THEN
  157.     gt.FreeVisualInfo (VisualInfo);
  158.     VisualInfo := NIL;
  159.   END;
  160.   IF Scr # NIL THEN
  161.     I.UnlockPubScreen (NIL, Scr);
  162.     Scr := NIL;
  163.   END;
  164. END CloseDownScreen;
  165.  
  166. PROCEDURE Project0Render*;
  167. BEGIN
  168.   ComputeFont (Project0Width, Project0Height);
  169.  
  170.   gt.DrawBevelBox(Project0Wnd^.rPort, OffX + ComputeX (5),
  171.                   OffY + ComputeY (2),
  172.                   ComputeX (453),
  173.                   ComputeY (82),
  174.                   gt.visualInfo, VisualInfo, u.done);
  175. END Project0Render;
  176.  
  177. PROCEDURE OpenProject0Window* (): INTEGER;
  178. TYPE
  179.   TagArrayPtr = UNTRACED POINTER TO ARRAY MAX (INTEGER) OF u.TagItem;
  180. VAR
  181.   ng: gt.NewGadget;
  182.   gad: I.GadgetPtr;
  183.   help: TagArrayPtr;
  184.   lc, tc, lvc, offx, offy: INTEGER;
  185.   wleft, wtop, ww, wh: INTEGER;
  186. BEGIN
  187.   wleft := Project0Left; wtop := Project0Top;
  188.  
  189.   ComputeFont (Project0Width, Project0Height);
  190.  
  191.   ww := ComputeX (Project0Width);
  192.   wh := ComputeY (Project0Height);
  193.  
  194.   IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
  195.     wleft := Scr^.width - ww;
  196.   END;
  197.   IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
  198.     wtop := Scr^.height - wh;
  199.   END;
  200.   gad := gt.CreateContext (Project0GList);
  201.   IF gad = NIL THEN RETURN 1 END;
  202.  
  203.   lc := 0; tc := 0; lvc := 0;
  204.   WHILE lc < Project0CNT DO
  205.     ng := Project0NGad[lc];
  206.     ng.visualInfo := VisualInfo;
  207.     ng.textAttr   := Font;
  208.     ng.leftEdge   := OffX + ComputeX (ng.leftEdge);
  209.     ng.topEdge    := OffY + ComputeY (ng.topEdge);
  210.     ng.width      := ComputeX (ng.width);
  211.     ng.height     := ComputeY (ng.height);
  212.  
  213.     help := u.CloneTagItems (y.VAL (TagArrayPtr, y.ADR (Project0GTags[tc]))^);
  214.     IF help = NIL THEN RETURN 8 END;
  215.     gad := gt.CreateGadgetA (Project0GTypes[lc], gad, ng, help^ );
  216.     u.FreeTagItems (help^);
  217.     IF gad = NIL THEN RETURN 2 END;
  218.     Project0Gadgets[lc] := gad;
  219.  
  220.     WHILE Project0GTags[tc] # u.done DO INC (tc, 2) END;
  221.     INC (tc);
  222.  
  223.     INC (lc);
  224.   END; (* WHILE *)
  225.   Project0Zoom[0] := 0;
  226.   Project0Zoom[1] := 0;
  227.   Project0Zoom[2] := g.TextLength (y.ADR (Scr^.rastPort), "Font Adapt Test...", 18) + 80;
  228.   Project0Zoom[3] := Scr^.wBorTop + Scr^.rastPort.txHeight + 1;
  229.  
  230.   Project0Wnd := I.OpenWindowTagsA ( NIL,
  231.                     I.waLeft,          wleft,
  232.                     I.waTop,           wtop,
  233.                     I.waWidth,         ww + OffX + Scr^.wBorRight,
  234.                     I.waHeight,        wh + OffY + Scr^.wBorBottom,
  235.                     I.waIDCMP,         gt.buttonIDCMP+gt.integerIDCMP+gt.numberIDCMP+gt.cycleIDCMP+gt.paletteIDCMP+gt.scrollerIDCMP+gt.arrowIDCMP+gt.sliderIDCMP+gt.stringIDCMP+gt.textIDCMP+LONGSET {I.menuPick,I.closeWindow,I.refreshWindow},
  236.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.sizeBRight,I.sizeBBottom},
  237.                     I.waGadgets,       Project0GList,
  238.                     I.waTitle,         y.ADR ("Font Adapt Test..."),
  239.                     I.waZoom,          y.ADR (Project0Zoom),
  240.                     u.done);
  241.   IF Project0Wnd = NIL THEN RETURN 20 END;
  242.  
  243.   Project0Zoom[0] := Project0Wnd^.leftEdge;
  244.   Project0Zoom[1] := Project0Wnd^.topEdge;
  245.   Project0Zoom[2] := Project0Wnd^.width;
  246.   Project0Zoom[3] := Project0Wnd^.height;
  247.  
  248.   gt.RefreshWindow (Project0Wnd, NIL);
  249.  
  250.   Project0Render;
  251.  
  252.   RETURN 0;
  253. END OpenProject0Window;
  254.  
  255. PROCEDURE CloseProject0Window*;
  256. BEGIN
  257.   IF Project0Wnd # NIL THEN
  258.     I.CloseWindow (Project0Wnd);
  259.     Project0Wnd := NIL;
  260.   END;
  261.   IF Project0GList # NIL THEN
  262.     gt.FreeGadgets (Project0GList);
  263.     Project0GList := NIL;
  264.   END;
  265. END CloseProject0Window;
  266.  
  267.  
  268. END FAdaptPAL.
  269.