home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / fish / disks / d1031.lha / Programs / Textfield / Oberon / TestClass.mod < prev    next >
Encoding:
Text File  |  1994-11-12  |  6.5 KB  |  199 lines
  1. MODULE TestClass;
  2.  
  3. (* This is just a small example, no prefwindow yet...
  4. ** I had no time to improve it.
  5. **
  6. ** Stefan
  7. **
  8. ** slbrbbbh@w250zrz.zrz.TU-Berlin.de
  9. **    StElb@IRC
  10. *)
  11.  
  12.  
  13. IMPORT
  14.   y := SYSTEM,
  15.  
  16.   d := Dos,
  17.   e := Exec,
  18.   g := Graphics,
  19.   IP := IFFParse,
  20.   I := Intuition,
  21.   TF := TextField,
  22.   u := Utility;
  23.  
  24. CONST
  25.   versionString = "$VER: TestClass.mod 0.4 (18.09.94)";
  26.  
  27. VAR
  28.   window: I.WindowPtr;
  29.   dri: I.DrawInfoPtr;
  30.   pens: I.DRIPenArrayPtr;
  31.   edit, prop, up, down: I.GadgetPtr;
  32.   upi, downi: I.ImagePtr;
  33.   cliphandle, undohandle: IP.ClipboardHandlePtr;
  34.   textbuffer, mybuffer: e.LSTRPTR;
  35.   length: LONGINT;
  36.  
  37. CONST
  38.   initialtext = "Sample text placed immediatly into the "
  39.                 "object.\nOr try AMIGA-[, AMIGA-=, AMIGA-]"
  40.                 "or AMIGA-\\. \n";
  41.   moretext = "I think the gadget looks best withe the double-bevel border"
  42.              "and a medium cursor speed.";
  43.   prop2edit = u.Tags2(I.pgaTop, TF.top, u.done, 0);
  44.   edit2prop = u.Tags4(TF.top, I.pgaTop,
  45.                       TF.visible, I.pgaVisible,
  46.                       TF.lines, I.pgaTotal,
  47.                       u.done, 0);
  48.   up2edit = u.Tags2(I.gaID, TF.up, u.done, 0);
  49.   down2edit = u.Tags2(I.gaID, TF.down, u.done, 0);
  50.  
  51.  
  52.  
  53. PROCEDURE Init():BOOLEAN;
  54.  
  55. BEGIN
  56.   cliphandle := IP.OpenClipboard(0);
  57.   undohandle := IP.OpenClipboard(255);
  58.  
  59.   window := I.OpenWindowTagsA(NIL,
  60.                     I.waFlags, LONGSET{I.windowDepth, I.windowDrag, I.windowClose, I.windowSizing,
  61.                                        I.sizeBBottom, I.sizeBRight},
  62.                     I.waActivate, e.LTRUE,
  63.                     I.waIDCMP, LONGSET{I.closeWindow},
  64.                     I.waWidth, 320,
  65.                     I.waHeight, 200,
  66.                     I.waNoCareRefresh, e.LTRUE,
  67.                     I.waTitle, y.ADR("This is just a small example..."),
  68.                     I.waScreenTitle, y.ADR("Testing textfield.gadget"),
  69.                     u.done);
  70.   IF window = NIL THEN RETURN FALSE END;
  71.   dri := I.GetScreenDrawInfo(window.wScreen);
  72.   IF dri = NIL THEN RETURN FALSE END;
  73.   pens := dri.pens;
  74.   IF I.WindowLimits(window, 160, window.borderTop + window.borderBottom +
  75.                                  window.wScreen.rastPort.txHeight + 46, -1, -1) THEN END;
  76.   prop := I.NewObject(NIL, "propgclass",
  77.                     I.gaID, 2,
  78.                     I.gaTop, window.borderTop,
  79.                     I.gaRelRight, -(window.borderRight - 5),
  80.                     I.gaWidth, window.borderRight - 8,
  81.                     I.gaRelHeight, -(window.borderTop + 3*(window.borderBottom)) - 2,
  82.                     I.gaRightBorder, e.LTRUE,
  83.                     I.icaMap, y.ADR(prop2edit),
  84.                     I.pgaNewLook, e.LTRUE,
  85.                     I.pgaBorderless, e.LTRUE,
  86.                     I.gaBorder, e.LTRUE,
  87.                     I.pgaVisible, 50,
  88.                     I.pgaTotal, 50,
  89.                     u.done);
  90.   upi := I.NewObject(NIL, "sysiclass",
  91.                     I.sysiaDrawInfo, dri,
  92.                     I.sysiaWhich, I.upImage,
  93.                     I.iaWidth, window.borderRight,
  94.                     I.iaHeight, window.borderBottom,
  95.                     u.done);
  96.   downi := I.NewObject(NIL, "sysiclass",
  97.                     I.sysiaDrawInfo, dri,
  98.                     I.sysiaWhich, I.downImage,
  99.                     I.iaWidth, window.borderRight,
  100.                     I.iaHeight, window.borderBottom,
  101.                     u.done);
  102.   up := I.NewObject(NIL, "buttongclass",
  103.                     I.gaRelBottom, -(3 * window.borderBottom) - 1,
  104.                     I.gaRelRight, -(window.borderRight - 1),
  105.                     I.gaHeight, window.borderBottom,
  106.                     I.gaWidth, window.borderRight,
  107.                     I.gaImage, upi,
  108.                     I.gaRightBorder, e.LTRUE,
  109.                     I.gaRelVerify, e.LTRUE,
  110.                     I.gaPrevious, prop,
  111.                     I.icaMap, y.ADR(up2edit),
  112.                     u.done);
  113.   down := I.NewObject(NIL, "buttongclass",
  114.                     I.gaRelBottom, -(2 * window.borderBottom),
  115.                     I.gaRelRight, -(window.borderRight - 1),
  116.                     I.gaHeight, window.borderBottom,
  117.                     I.gaWidth, window.borderRight,
  118.                     I.gaImage, downi,
  119.                     I.gaRightBorder, e.LTRUE,
  120.                     I.gaRelVerify, e.LTRUE,
  121.                     I.gaPrevious, up,
  122.                     I.icaMap, y.ADR(down2edit),
  123.                     u.done);
  124.   edit := I.NewObject(TF.textFieldClass, NIL,
  125.                     I.gaID, 1,
  126.                     I.gaTop, window.borderTop + 20,
  127.                     I.gaLeft, window.borderLeft + 20,
  128.                     I.gaRelWidth, -(window.borderLeft + window.borderRight + 40),
  129.                     I.gaRelHeight, -(window.borderTop + window.borderBottom + 40),
  130.                     I.gaPrevious, down,
  131.                     I.icaMap, y.ADR(edit2prop),
  132.                     I.icaTarget, prop,
  133.                     TF.text, y.ADR(initialtext),
  134.                     TF.border, TF.doubleBevel,
  135.                     TF.userAlign, e.LTRUE,
  136.                     TF.clipStream, cliphandle,
  137.                     TF.clipStream2, undohandle,
  138.                     TF.cursorPos, 10,
  139.                     u.done);
  140.   RETURN (edit # NIL) & (prop # NIL) & (upi # NIL) & (downi # NIL) & (up # NIL) & (down # NIL);
  141. END Init;
  142.  
  143.  
  144.  
  145. PROCEDURE Connect();
  146. VAR
  147.   d: LONGINT;
  148.  
  149. BEGIN
  150.   d := I.SetGadgetAttrs(prop^, window, NIL, I.icaTarget, edit, u.done);
  151.   d := I.SetGadgetAttrs(up^, window, NIL, I.icaTarget, edit, u.done);
  152.   d := I.SetGadgetAttrs(down^, window, NIL, I.icaTarget, edit, u.done);
  153.   d := I.AddGList(window, prop, -1, -1, NIL);
  154.   I.RefreshGadgets(prop, window, NIL);
  155. END Connect;
  156.  
  157.  
  158.  
  159. PROCEDURE MainLoop();
  160. VAR
  161.   signal: LONGSET;
  162.   imsg: I.IntuiMessagePtr;
  163.   going: BOOLEAN;
  164.  
  165. BEGIN
  166.   going := TRUE;
  167.   WHILE going DO
  168.     signal := e.Wait(LONGSET{window.userPort.sigBit, d.ctrlC});
  169.     IF d.ctrlC IN signal THEN going := FALSE END;
  170.     REPEAT
  171.       imsg := e.GetMsg(window.userPort);
  172.       IF imsg # NIL THEN
  173.         IF (I.closeWindow IN imsg.class) THEN going := FALSE;
  174.         (*ELSIF etc. pp. *)
  175.         END;
  176.         e.ReplyMsg(imsg);
  177.       END;
  178.     UNTIL imsg = NIL;
  179.   END; (* WHILE going *)
  180. END MainLoop;
  181.  
  182. BEGIN
  183.   IF Init() THEN END;
  184.   Connect();
  185.   MainLoop();
  186. CLOSE
  187.   IF dri # NIL THEN I.FreeScreenDrawInfo(window.wScreen, dri) END;
  188.   IF window # NIL THEN I.CloseWindow(window) END;
  189.   IF prop # NIL THEN IF I.RemoveGList(window, prop, -1) = 0 THEN END END;
  190.   I.DisposeObject(prop);
  191.   I.DisposeObject(up);
  192.   I.DisposeObject(down);
  193.   I.DisposeObject(edit);
  194.   I.DisposeObject(upi);
  195.   I.DisposeObject(downi);
  196.   IP.CloseClipboard(cliphandle);
  197.   IP.CloseClipboard(undohandle);
  198. END TestClass.
  199.