home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / dialoggroupboxes.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  9KB  |  211 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 30 Dec 95
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogGroupBoxes;
  8. (** Markus Knasm
  9. ller 30 Jun 94 - 
  10. IMPORT DialogFrames, Dialogs, DialogStaticTexts, DialogTexts, Display, Display1, Files, 
  11.     Fonts, GraphicUtils, In, Oberon, Printer, TextFrames, Texts, Viewers;
  12.     CONST W* = 100; H* = 100; black = 15; white = 0; MM = 1; CR = 0DX;
  13.     TYPE
  14.         Item* = POINTER TO ItemDesc;
  15.         ItemDesc* = RECORD(Dialogs.ObjectDesc)
  16.             fnt-: Fonts.Font; (** the font with which the text is shown *)
  17.             s-: ARRAY 64 OF CHAR;  (** the text which is shown *) 
  18.         END;
  19.     VAR w0: Texts.Writer;
  20.     PROCEDURE (g: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  21.     (** displays the object at (x, y) in frame f *)
  22.         VAR mode, w, h, gx, gy, cx, yh: INTEGER;
  23.         PROCEDURE Max (x, y: INTEGER): INTEGER;
  24.         BEGIN
  25.             IF x > y THEN RETURN x ELSE RETURN y END
  26.         END Max;
  27.     BEGIN    
  28.         g.GetDim (gx, gy, w, h); INC (y);
  29.         DEC (w, 2); DEC (h, 5); cx := 0; 
  30.         IF (h < 0) OR (w < 0) THEN 
  31.             Display1.Line (f, black, x, y, x + Max (w, 0), y + Max (h, 0), Display.paint);
  32.             RETURN 
  33.         END;
  34.         IF g.selected THEN mode := Display.invert ELSE mode := Display.paint END;
  35.         yh := y + h - g.fnt.maxY - g.fnt.minY; 
  36.         IF g.s = "" THEN cx := w 
  37.         ELSIF yh > y THEN GraphicUtils.DrawString (f, g.s, x + 3, yh, w - 4, g.fnt, mode, GraphicUtils.center, cx) 
  38.         END;
  39.         Display1.Line (f, black, x, y, x + w, y, mode); Display1.Line (f, black, x, y, x, y + h, mode);
  40.         Display1.Line (f, black, x + w, y, x + w, y + h, mode); 
  41.         Display1.Line (f, white, x, y - 1, x + w, y - 1, mode); Display1.Line (f, white, x + 1, y + 1, x + 1, y + h, mode);
  42.         Display1.Line (f, white, x + w + 1, y, x + w + 1, y + h, mode);
  43.         IF cx > 0 THEN
  44.             Display1.Line (f, black, x, y + h, x + cx, y + h, mode); 
  45.             Display1.Line (f, black, x + w - cx, y + h, x + w, y + h, mode);
  46.             Display1.Line (f, white, x + 1, y + h - 1, x + cx, y + h - 1, mode); 
  47.             Display1.Line (f, white, x + w - cx, y + h - 1, x + w - 1, y + h - 1, mode)
  48.         END;
  49.     END Draw;
  50.     PROCEDURE (g:Item) Print* (x, y: INTEGER);
  51.     (** prints the object at printer coordinates (x, y) *)
  52.         VAR w, h, gx, gy, yh, cx: INTEGER; fnth: LONGINT;
  53.     BEGIN
  54.         g.GetPDim (gx, gy, w, h);
  55.         DEC (w, 2); DEC (h, 5); IF h < 0 THEN RETURN END;
  56.         Printer.Line (x, y, x + w, y); Printer.Line (x, y, x, y + h);
  57.         Printer.Line (x + w, y, x + w, y + h);
  58.         fnth := (g.fnt.maxY + g.fnt.minY) * Dialogs.dUnit DIV Dialogs.pUnit;
  59.         yh := y + h - SHORT (fnth); 
  60.         IF yh > y THEN GraphicUtils.PrintString (g.s, x + 3, yh, w - 4, g.fnt, GraphicUtils.center, cx) END;
  61.         IF cx > 0 THEN
  62.             Printer.Line (x, y + h, x + cx, y + h); Printer.Line (x + w - cx, y + h, x + w, y + h);
  63.         END
  64.     END Print;
  65.     PROCEDURE (g: Item) Copy* (VAR dup: Dialogs.Object);
  66.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  67.         VAR x: Item;
  68.     BEGIN
  69.         IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; 
  70.         g.Copy^ (dup); x.fnt := g.fnt; COPY (g.s, x.s);
  71.     END Copy;
  72.     PROCEDURE (g: Item) Load* (VAR r: Files.Rider);
  73.     (** reads the object from rider r *)
  74.         VAR fntname: ARRAY 32 OF CHAR;
  75.     BEGIN g.Load^ (r); Files.ReadString (r, fntname); g.fnt := Fonts.This (fntname); Files.ReadString (r, g.s) ;
  76.     END Load;
  77.     PROCEDURE (g: Item) Store* (VAR r: Files.Rider);
  78.     (** writes the object to rider r *)
  79.     BEGIN g.Store^ (r); Files.WriteString (r, g.fnt.name); Files.WriteString (r, g.s);
  80.     END Store;
  81.     PROCEDURE (g: Item) SetFont* (fnt: Fonts.Font);
  82.     (** sets the font with which the text is shown *)
  83.     BEGIN g.Hide; g.fnt := fnt; g.Restore; IF g.panel # NIL THEN g.panel.MarkMenu END
  84.     END SetFont;
  85.     PROCEDURE (g: Item) SetString* (s: ARRAY OF CHAR);
  86.     (** sets the text which is shown *)
  87.     BEGIN g.Hide; COPY (s, g.s); g.Restore; IF g.panel # NIL THEN g.panel.MarkMenu END
  88.     END SetString;
  89.     PROCEDURE (g: Item) Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
  90.     (** handles messages which were sent to frame f *)
  91.         VAR t: Texts.Text;
  92.     BEGIN
  93.         g.Handle^ (f, m);
  94.         WITH f: DialogFrames.Frame DO 
  95.             WITH m: Oberon.InputMsg DO
  96.                 IF m.id = Oberon.track THEN 
  97.                     IF (m.keys = {MM}) & (g.cmd[0] # 0X) THEN 
  98.                         DialogTexts.GetParText (g.par, g.panel, t);
  99.                         g.CallCmd (f, Viewers.This (m.X, m.Y), TextFrames.Text ("")) 
  100.                     ELSE Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, m.X, m.Y)
  101.                     END
  102.                 END
  103.             ELSE
  104.             END
  105.         ELSE
  106.         END
  107.     END Handle;
  108.     PROCEDURE WriteToObjectStr (o: DialogTexts.Item; VAR p: Dialogs.Panel; n: ARRAY OF CHAR);
  109.         VAR t: Texts.Text; 
  110.     BEGIN
  111.         t := o.GetText (); Texts.WriteString (w0, n); Texts.Append (t, w0.buf);
  112.     END WriteToObjectStr;
  113.     PROCEDURE (g: Item) Edit*;
  114.     (** opens a dialog for editing the properties of the object *)
  115.         VAR on: Dialogs.Object; os, string: DialogTexts.Item; s: DialogStaticTexts.Item; p: Dialogs.Panel; t1: Texts.Text; fnt: Fonts.Font;
  116.     BEGIN
  117.         g.Edit^ (); p := Dialogs.editPanel;
  118.         NEW (string); string.Init; 
  119.         string.SetName ("string"); string.SetDim (245, -30, 140, 19, FALSE); p.Insert (string, FALSE); 
  120.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  121.         NEW (s); s.Init; s.SetDim (196, -30, 40, 20, FALSE); 
  122.         s.SetString ("String"); fnt := Fonts.This ("Syntax10.Scn.Fnt"); s.SetFont (fnt);
  123.         p.Insert (s, FALSE); 
  124.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  125.         WriteToObjectStr (string, p, g.s); 
  126.         t1 := string.GetText (); Texts.ChangeLooks (t1, 0, t1.len, {0}, g.fnt, 0, 0);
  127.     END Edit;
  128.     PROCEDURE (g: Item) Update* (p: Dialogs.Panel);
  129.     (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
  130.         VAR os: Dialogs.Object; t1: Texts.Text; r: Texts.Reader; ch: CHAR; str: ARRAY 64 OF CHAR; i: INTEGER;
  131.     BEGIN
  132.         g.Update^ (p); 
  133.         os := p.NamedObject ("string"); t1 := os(DialogTexts.Item).GetText ();
  134.         Texts.OpenReader (r, t1, 0); Texts.Read (r, ch); i := 0;
  135.         IF (r.fnt # NIL) & (r.fnt # g.fnt) THEN g.SetFont (r.fnt) END;
  136.         WHILE ~ r.eot DO 
  137.              str[i] := ch; INC (i); Texts.Read (r, ch);
  138.         END;
  139.         str[i] := 0X; 
  140.         IF str # g.s THEN g.SetString (str) END
  141.     END Update;
  142.     PROCEDURE (g: Item) GetObjects* (VAR obArray: ARRAY OF Dialogs.Object; VAR nofelems: INTEGER);
  143.     (** gets all objects which are lying unter the groupbox *)
  144.         VAR p: Dialogs.Panel; x, y, w, h: INTEGER;
  145.     BEGIN
  146.         p := g.panel; g.GetDim (x, y, w, h); p.GetObjects (x, y, w, h, obArray, nofelems);
  147.     END GetObjects;  
  148.     PROCEDURE Insert*;
  149.     (** Insert ([name] [x y w h] | ^ ) inserts a groupbox - item in the panel containing the caret position *)
  150.         VAR x, y, x1, y1, w, h: INTEGER; g: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; r: Texts.Reader; ch: CHAR;
  151.     BEGIN 
  152.         NEW (g); 
  153.         DialogFrames.GetCaretPosition (p, x, y);
  154.         IF (p # NIL) THEN 
  155.             g.Init (); In.Open; Texts.OpenReader (r, Oberon.Par.text, 0); Texts.Read (r, ch);
  156.             In.Name (name);
  157.             IF ~In.Done THEN COPY ("", name); In.Open ELSE g.fnt := r.fnt END;
  158.             g.SetName (name); 
  159.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  160.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  161.             ELSE
  162.                 IF w < 0 THEN w := W END;
  163.                 IF h < 0 THEN h := H END
  164.             END;
  165.             g.SetDim (x1, y1, w, h, FALSE);
  166.             g.SetString (name); g.SetFont (Fonts.This ("Syntax10.Scn.Fnt")); 
  167.             p.Insert (g, TRUE);
  168.         ELSE
  169.             Dialogs.res := Dialogs.wrongInput
  170.         END;
  171.         IF Dialogs.res # 0 THEN 
  172.             Dialogs.Error ("DialogGroupBoxes") 
  173.         END;
  174.     END Insert;
  175.     PROCEDURE SetString*;
  176.     (** SetString ({ch} | ^) sets the string of the groupbox item at the caret to str *)
  177.         VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR; ch: CHAR; i: INTEGER;
  178.     BEGIN 
  179.         In.Open; In.Char (ch); i := 0;
  180.         WHILE In.Done & (ch = " ") DO In.Char (ch) END; (* skip leading blanks *)
  181.         IF ~ In.Done THEN 
  182.             Dialogs.res := Dialogs.wrongInput
  183.         ELSE 
  184.             WHILE In.Done & (ch # CR) & (ch # "~") & (i < 63) DO str[i] := ch; INC (i); In.Char (ch) END; 
  185.             str[i] := 0X;
  186.             DialogFrames.FindObject (o, p);
  187.             IF (Dialogs.res = Dialogs.ok) & (o IS Item) THEN 
  188.                 o(Item).SetString (str); o(Item).SetFont (Fonts.This ("Syntax10.Scn.Fnt")) 
  189.             END 
  190.         END;
  191.         IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogGroupBoxes") END
  192.     END SetString;
  193.     PROCEDURE GetString*;
  194.     (** writes the component s of the groupbox item under the caret to the log viewer *)
  195.         VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR;
  196.     BEGIN
  197.         DialogFrames.FindObject (o, p);
  198.         IF Dialogs.res = Dialogs.ok THEN
  199.             IF o IS Item THEN
  200.                 COPY (o(Item).s, str);
  201.                 Texts.WriteString (w0, "String:"); Texts.WriteString (w0, str); Texts.WriteLn (w0);
  202.                 Texts.Append (Oberon.Log, w0.buf)
  203.             ELSE
  204.                 Dialogs.res := Dialogs.objectNotFound
  205.             END
  206.         END;
  207.         IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogStaticTexts") END
  208.     END GetString;
  209. BEGIN Texts.OpenWriter (w0)
  210. END DialogGroupBoxes.
  211.