home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / dialogs.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  27KB  |  706 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 26 Mar 96
  6. Syntax10b.Scn.Fnt
  7. MODULE Dialogs; 
  8.     (** extended version Markus Knasm
  9. ller 25.May.94 -   
  10.     IMPORT Display, Files, Types, Modules, Oberon, TextFrames, TextPrinter, Texts, Viewers;
  11.     CONST
  12.         ok* = 0; objectIsAlreadyInPanel* = 1; nameExists* = 2; objectNotFound* = 3;
  13.         wrongInput* = 4; noPanelSelected* = 5; objectWouldOverlap* = 6; tooManyObjectsSelected* = 7;
  14.         maxItems = 64;
  15.     TYPE
  16.         Object* = POINTER TO ObjectDesc;
  17.         Panel* = POINTER TO PanelDesc;
  18.         ObjectDesc* = RECORD
  19.             next: Object;     
  20.             x, y, w, h: LONGINT;
  21.             name-: ARRAY 16 OF CHAR;  (** a panel wide unique name *)
  22.             cmd-: ARRAY 32 OF CHAR;  (** a command to be executed when the obj is changed *)
  23.             par-: ARRAY 32 OF CHAR; 
  24.                 (** the invoked commands can assume that Oberon.par.text contains the contest of these text items *)
  25.             selected-: BOOLEAN;  (** TRUE if the object is selected *)
  26.             overlapping-: BOOLEAN;  (** TRUE if the object may overlap others *)
  27.             panel-: Panel; (** panel containing the object *)
  28.             visible: BOOLEAN; (* TRUE if the object is visible *)
  29.         END;
  30.         PanelDesc* = RECORD
  31.             cmd-: ARRAY 64 OF CHAR;  (** cmd which initialies the dialog *)  
  32.             contents: Object; 
  33.         END;
  34.         NotifyMsg* = RECORD(Display.FrameMsg)
  35.             id*: INTEGER;     (** 0 = restore, 1 = hide, 2 = markMenu, 3 = restore all *)
  36.             obj*: Object;    (** defined if id = 0 or id = 1 *)
  37.             p*: Panel;         (** defined if id = 2 or id = 3 *)
  38.         END;
  39.         dUnit*, pUnit*: LONGINT;  (** for device independent coordinates *)
  40.         res*: INTEGER; (** result code from last operation *)
  41.         Edit*: PROCEDURE (obj: Object);
  42.         Update*: PROCEDURE (obj: Object; p: Panel);
  43.         cmdPanel*: Panel;  (** panel from which the last command was called *)
  44.         editPanel*: Panel; (** panel for editing the properties of an object *)
  45.         editObject*: Object; (** object which could be edited by editPanel *)
  46.         deInit*: Panel; (** panel representing DEInit.Dlg *)
  47.         lastin*: Object; (** most recently inserted object *)
  48.         w0: Texts.Writer;
  49.     PROCEDURE^ (p: Panel) MarkMenu*;
  50.     PROCEDURE^ (p: Panel) NamedObject* (name: ARRAY OF CHAR): Object;
  51.     PROCEDURE^ (p: Panel) GetObjects* (x, y, w, h: INTEGER; VAR obArray: ARRAY OF Object; VAR nofelems: INTEGER);
  52.     PROCEDURE^ (p: Panel) RestoreOverlapped (x, y, w, h: INTEGER; o: Object);
  53.     PROCEDURE^ (p: Panel) RemoveSelections*;
  54.     PROCEDURE (o: Object) Draw* (x, y: INTEGER; f: Display.Frame);
  55.     (** abstract: displays the object at (x, y) in frame f *)
  56.     END Draw ;
  57.     PROCEDURE (o: Object) Copy* (VAR dup: Object);
  58.     (** allocates dup and makes a deep copy of o. For calling this methode dup should be equal NIL *)
  59.     BEGIN
  60.         IF dup = NIL THEN NEW (dup) END;
  61.         dup.x := o.x; dup.y := o.y; dup.w := o.w; dup.h := o.h; dup.name := o.name; dup.next := NIL; 
  62.         dup.cmd := o.cmd; dup.par := o.par; dup.selected := FALSE; dup.overlapping := o.overlapping; dup.panel := NIL; 
  63.     END Copy;
  64.     PROCEDURE (o: Object) Print* (x, y: INTEGER);
  65.     (** abstract: prints the object at printer coordinates (x, y) *)
  66.     END Print;
  67.     PROCEDURE (o: Object) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  68.     (** abstract: handles messages which were sent to frame f *)
  69.     END Handle;
  70.     PROCEDURE (o: Object) Edit*;
  71.     (** opens a dialog for editing the properties of the object *)
  72.     BEGIN IF Edit # NIL THEN Edit (o) END
  73.     END Edit;
  74.     PROCEDURE (o: Object) Update* (p: Panel);
  75.     (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
  76.     BEGIN IF Update # NIL THEN Update (o, p) END
  77.     END Update;
  78.     PROCEDURE (o: Object) Init*;
  79.     (** initialies the object, should be called after allocating the object with NEW *)
  80.     BEGIN o.selected := FALSE; o.panel := NIL; o.cmd[0] := 0X; o.par[0] := 0X; o.visible := TRUE;
  81.     END Init;
  82.     PROCEDURE (o: Object) GetDim* (VAR x, y, w, h: INTEGER);
  83.     (** Gets x, y, width and height of object o for drawing *)
  84.     BEGIN
  85.         x := SHORT (o.x DIV dUnit); y := SHORT (o.y DIV dUnit);
  86.         w := SHORT (o.w DIV dUnit); h := SHORT (o.h DIV dUnit);
  87.     END GetDim;
  88.     PROCEDURE (o: Object) GetPDim* (VAR x, y, w, h: INTEGER);
  89.     (** Gets x, y, width and height of object o for printing *)
  90.     BEGIN
  91.         x := SHORT (o.x DIV pUnit); y := SHORT (o.y DIV pUnit);
  92.         w := SHORT (o.w DIV pUnit); h := SHORT (o.h DIV pUnit);
  93.     END GetPDim; 
  94.     PROCEDURE (o: Object) Load* (VAR r: Files.Rider);
  95.     (** reads the object from rider r *)
  96.         VAR name1: ARRAY 64 OF CHAR; cmd1, par1: ARRAY 64 OF CHAR;
  97.     BEGIN 
  98.         o.Init; Files.ReadString (r, name1); COPY (name1, o.name);
  99.         Files.ReadString (r, cmd1); COPY (cmd1, o.cmd); 
  100.         Files.ReadString (r, par1); COPY (par1, o.par);
  101.         Files.ReadLInt (r, o.x); Files.ReadLInt (r, o.y); Files.ReadLInt (r, o.w); 
  102.         Files.ReadLInt (r, o.h); Files.ReadBool (r, o.overlapping) 
  103.     END Load;
  104.     PROCEDURE (o: Object) Store* (VAR r: Files.Rider);
  105.     (** writes the object to rider r *)
  106.     BEGIN 
  107.         Files.WriteString (r, o.name); Files.WriteString (r, o.cmd); Files.WriteString (r, o.par); Files.WriteLInt (r, o.x); 
  108.         Files.WriteLInt (r, o.y); Files.WriteLInt (r, o.w); Files.WriteLInt (r, o.h); Files.WriteBool (r, o.overlapping)
  109.     END Store;
  110.     PROCEDURE (o: Object) CallCmd* (f: Display.Frame; v: Viewers.Viewer; t: Texts.Text);
  111.     (** invokes the command obj.cmd *)
  112.         VAR callres: INTEGER;
  113.     BEGIN
  114.         IF o.cmd[0] # 0X THEN
  115.             Oberon.Par.frame := f; Oberon.Par.vwr := v; Oberon.Par.text := t; Oberon.Par.pos := 0;
  116.             cmdPanel := o.panel; Oberon.Call (o.cmd, Oberon.Par, FALSE, callres)
  117.         END
  118.     END CallCmd;
  119.     PROCEDURE (o: Object) SetCmd* (cmd: ARRAY OF CHAR);
  120.     (** sets the command of the object to cmd *)
  121.     BEGIN
  122.         IF cmd # o.cmd THEN
  123.             COPY (cmd, o.cmd);
  124.             IF o.panel # NIL THEN o.panel.MarkMenu END
  125.         END
  126.     END SetCmd;
  127.     PROCEDURE (o: Object) SetPar* (par: ARRAY OF CHAR);
  128.     (** sets the command of the object to par *)
  129.     BEGIN
  130.         IF par # o.par THEN
  131.             COPY (par, o.par);
  132.             IF o.panel # NIL THEN o.panel.MarkMenu END
  133.         END
  134.     END SetPar;
  135.     PROCEDURE (o: Object) Restore*;
  136.     (** restores object o => redraws it *)
  137.         VAR msg: NotifyMsg;
  138.     BEGIN msg.id := 0; msg.obj := o; Viewers.Broadcast (msg); o.visible := TRUE
  139.     END Restore;
  140.     PROCEDURE (o: Object) SetName* (name: ARRAY OF CHAR);
  141.     (** sets the name of the object to name, unless in the panel containing o already exists such a name *)
  142.     BEGIN
  143.         IF (o.panel = NIL) OR (name[0] = 0X) OR (o.panel.NamedObject (name) = NIL) OR (o.panel.NamedObject (name) = o) THEN 
  144.             IF o.name # name THEN    
  145.                 COPY (name, o.name); res := ok;
  146.                 IF o.panel # NIL THEN 
  147.                     o.panel.MarkMenu; o.Restore;
  148.                 END
  149.             END
  150.         ELSE res := nameExists
  151.         END
  152.     END SetName;
  153.     PROCEDURE (o: Object) Hide*;
  154.     (** removes object from screen, but not from panel *)
  155.         VAR msg: NotifyMsg; ox, oy, ow, oh, nofelems, i: INTEGER; obArray: ARRAY 50 OF Object;
  156.     BEGIN
  157.         IF o.panel = NIL THEN RETURN END;
  158.         msg.id := 1; msg.obj := o; Viewers.Broadcast (msg); o.visible := FALSE;
  159.         IF o.overlapping THEN 
  160.             o.GetDim (ox, oy, ow, oh); 
  161.             o.panel.RestoreOverlapped (ox, oy, ow, oh, o);
  162.             (*o.panel.GetObjects (ox, oy, ow, oh, obArray, nofelems); i := 0;
  163.             WHILE i < nofelems DO 
  164.                 IF obArray[i] # o THEN obArray[i].Restore END;
  165.                 INC (i) 
  166.             END *)
  167.         END
  168.     END Hide;
  169.     PROCEDURE (o: Object) Select* ();
  170.     (** selects o and displays it selected *)
  171.         VAR x, y, w, h: INTEGER;
  172.     BEGIN 
  173.         IF ~ o.selected THEN 
  174.             o.selected := TRUE; o.Hide; 
  175.             o.Restore
  176.         END
  177.     END Select;
  178.     PROCEDURE (o: Object) UnSelect* ();
  179.     (** unselects o and displays it unselected *)
  180.         VAR x, y, w, h: INTEGER;
  181.     BEGIN 
  182.         IF o.selected THEN 
  183.             o.selected := FALSE; o.Hide; o.Restore;
  184.         END
  185.     END UnSelect;
  186.     PROCEDURE (o: Object) IsIn (x, y, w, h: INTEGER): BOOLEAN;
  187.         VAR x0, y0, w0, h0: LONGINT;
  188.     BEGIN
  189.         x0 := x * dUnit; y0 := y * dUnit; w0 := w * dUnit; h0 := h * dUnit;
  190.         IF ~ (y0 + h0 < o.y) THEN
  191.             IF (y0 + h0 >= o.y) & (y0 + h0 <= o.y + o.h) &
  192.                 ~ (((x0 < o.x) & (x0 + w0 < o.x)) OR (x0 > o.x + o.w)) THEN 
  193.                 RETURN TRUE 
  194.             END;
  195.             IF (y0 + h0 > o.y + o.h) & (y0 <= o.y + o.h) & 
  196.                 ~ (((x0 < o.x) & (x0 + w0 < o.x)) OR (x0 > o.x + o.w)) THEN
  197.                 RETURN TRUE    
  198.             END
  199.         END;
  200.         RETURN FALSE
  201.     END IsIn;
  202.     PROCEDURE (o: Object) IsOverlapped (x, y, w, h: INTEGER): BOOLEAN;
  203.         VAR x0, y0 , w0, h0: LONGINT;
  204.     BEGIN
  205.         x0 := x * dUnit; y0 := y * dUnit; w0 := w * dUnit; h0 := h * dUnit;
  206.         RETURN (o.x >= x0) & (o.y >= y0) & (o.x + o.w <= x0 + w0) & (o.y + o.h <= y0 + h0)
  207.     END IsOverlapped;
  208.     PROCEDURE (o: Object) IsOverlapping (p: Panel; x, y, w, h: LONGINT; sel: BOOLEAN): BOOLEAN;
  209.     (* Returns TRUE if o with new dimensions x, y, w, h would overlapping another object of panel p. 
  210.         If sel then overlapping a selected object doesn`t matter. *)
  211.         VAR o1: Object; b: BOOLEAN; hx, hy, hw, hh: LONGINT;
  212.     BEGIN
  213.         IF o.overlapping THEN RETURN FALSE END;
  214.         o1 := p.contents;  
  215.         WHILE o1 # NIL DO
  216.             IF (o1 # o) & ~ o1.overlapping & ~(o1.selected & sel) THEN
  217.                 IF (o1.y < y + h) & (o1.y + o1.h > y) & (o1.x < x + w) & (o1.x + o1.w > x) THEN RETURN TRUE END
  218.             END;
  219.             o1 := o1.next
  220.         END;
  221.         RETURN FALSE
  222.     END IsOverlapping;
  223.     PROCEDURE (o: Object) SetDim* (x, y, w, h: INTEGER; cond: BOOLEAN);
  224.     (** Sets x, y, width and height of object o *)
  225.         VAR ox, oy, ow, oh: LONGINT; ax, ay, aw, ah: INTEGER;
  226.     BEGIN
  227.         o.GetDim (ax, ay, aw, ah);
  228.         ox := x * dUnit; oy := y * dUnit; ow := w * dUnit; oh := h * dUnit;
  229.         IF ow < dUnit THEN ow := dUnit END; IF oh < dUnit THEN oh := dUnit END;
  230.         IF o.panel = NIL THEN
  231.             o.x := ox; o.y := oy; o.w := ow; o.h := oh; res := ok 
  232.         ELSIF  ~ o.IsOverlapping (o.panel, ox, oy, ow, oh, cond) THEN
  233.             IF ~ o.selected THEN o.panel.RemoveSelections END;
  234.             o.Hide; o.x := ox; o.y := oy; o.w := ow; o.h := oh;
  235.             o.Restore; o.panel.MarkMenu;
  236.             o.panel.RestoreOverlapped (ax, ay, aw, ah, o); res := ok
  237.         ELSE 
  238.             res := objectWouldOverlap
  239.         END;
  240.     END SetDim;
  241.     PROCEDURE (o: Object) OverlappingObject* (): Object;
  242.     (** returns the object overlapping this object *)
  243.         VAR o1, ret: Object; x, y, w, h, w1, h1: INTEGER;
  244.     BEGIN
  245.         IF o.panel = NIL THEN RETURN NIL END;
  246.         o1 := o.panel.contents; ret := NIL;
  247.         WHILE o1 # NIL DO
  248.             IF (o # o1) & (o1.overlapping) THEN 
  249.                 o1.GetDim (x, y, w, h); 
  250.                 IF o.IsIn (x, y,  w, h) THEN
  251.                     IF  (ret = NIL)  THEN 
  252.                         ret := o1
  253.                     ELSE
  254.                         ret.GetDim (x, y, w1, h1);
  255.                         IF w1 * h1 > w * h THEN ret := o1 END
  256.                     END;
  257.                 END
  258.             END;
  259.             o1 := o1.next;
  260.         END;
  261.         RETURN ret
  262.     END OverlappingObject;
  263.     PROCEDURE (p: Panel) RestoreOverlapped (x, y, w, h: INTEGER; o: Object);
  264.         VAR o1: Object;
  265.         PROCEDURE Redraw;
  266.         BEGIN 
  267.             IF o1.selected  THEN 
  268.                 IF o1.visible THEN o1.Hide END;
  269.                 o1.Restore 
  270.             ELSE o1.Restore
  271.             END
  272.         END Redraw;
  273.     BEGIN
  274.         o1 := p.contents;
  275.         WHILE o1 # NIL DO
  276.             IF (o1 # o) & o1.overlapping & o1.visible & o1.IsIn (x, y, w, h) THEN Redraw END; 
  277.             o1 := o1.next
  278.         END;
  279.         IF o.overlapping THEN 
  280.             o1 := p.contents; 
  281.             WHILE o1 # NIL DO
  282.                 IF (o1 # o) &  ~ o1.overlapping & o1.visible & o1.IsIn (x, y, w, h) THEN Redraw END; 
  283.                 o1 := o1.next
  284.             END
  285.         END
  286.     END RestoreOverlapped;
  287.     PROCEDURE (p: Panel) SetCmd* (cmd: ARRAY OF CHAR);
  288.     (** sets the command of the object to cmd *)
  289.     BEGIN
  290.         IF cmd # p.cmd THEN
  291.             COPY (cmd, p.cmd);
  292.             p.MarkMenu 
  293.         END
  294.     END SetCmd;
  295.     PROCEDURE (p: Panel) NamedObject* (name: ARRAY OF CHAR): Object;
  296.     (** returns the object with name name *)
  297.         VAR o: Object;
  298.     BEGIN
  299.         IF name = "" THEN RETURN NIL END;
  300.         o := p.contents;
  301.         WHILE (o # NIL) & (o.name # name) DO o := o.next END;
  302.         RETURN o    
  303.     END NamedObject;
  304.     PROCEDURE (p: Panel) Select* (x, y, w, h: INTEGER);
  305.     (** selects all objects in p which are lying under the box specified by x, y, w, h *)
  306.         VAR o: Object; 
  307.     BEGIN
  308.         o := p.contents; 
  309.         WHILE o # NIL DO
  310.             IF o.IsIn (x, y, w, h) THEN o.Select ELSE o.UnSelect END;
  311.             o := o.next
  312.         END
  313.     END Select;
  314.     PROCEDURE (p: Panel) GetObjects* (x, y, w, h: INTEGER; VAR obArray: ARRAY OF Object; VAR nofelems: INTEGER);
  315.     (** gets all objects in p which are lying unter the box specified by x, y, w, h *)
  316.         VAR o: Object;
  317.     BEGIN
  318.         nofelems := 0; o := p.contents;
  319.         WHILE (o # NIL) & (nofelems < LEN (obArray)) DO
  320.             IF o.IsIn (x, y, w, h) THEN obArray [nofelems] := o; INC (nofelems) END; 
  321.             o := o.next;
  322.         END
  323.     END GetObjects;
  324.     PROCEDURE (p: Panel) MarkMenu*;
  325.     (** marks the menu of the frames which are displaying p  *)
  326.         VAR msg: NotifyMsg;
  327.     BEGIN msg.id := 2; msg.p := p; Viewers.Broadcast (msg);
  328.     END MarkMenu; 
  329.     PROCEDURE (p: Panel) Restore*;
  330.     (** restores the panel p => redraws it  *)
  331.         VAR msg: NotifyMsg;
  332.     BEGIN msg.id := 3; msg.p := p; Viewers.Broadcast (msg)
  333.     END Restore;
  334.     PROCEDURE (p: Panel) Remove* (o: Object);
  335.     (** removes object o of panel p *)
  336.         VAR q, prev: Object;
  337.     BEGIN
  338.         q := p.contents;
  339.         WHILE (q # NIL) & (q # o) DO prev := q; q := q.next END;
  340.         IF q # NIL THEN
  341.             q.Hide;
  342.             IF q = p.contents THEN p.contents := q.next ELSE prev.next := q.next END;
  343.             q.next := NIL; res := ok; p.MarkMenu
  344.         ELSE
  345.             res := objectNotFound
  346.         END
  347.     END Remove;
  348.     PROCEDURE (p: Panel) RemoveObjects* (x, y, w, h: INTEGER);
  349.     (** deletes all objects in p which are within x, y, w, h *)
  350.     VAR o, next: Object;  
  351.     BEGIN
  352.         o := p.contents;
  353.         WHILE o # NIL DO
  354.             next := o.next;
  355.             IF o.IsIn (x, y, w, h) THEN p.Remove (o) END;
  356.             o := next;        
  357.         END
  358.     END RemoveObjects;
  359.     PROCEDURE (p: Panel) Enumerate* (handle: PROCEDURE (obj: Object; VAR done: BOOLEAN));
  360.     (** calls the procedure handle for every object of the panel *)
  361.         VAR obj: Object; done: BOOLEAN;
  362.     BEGIN 
  363.         done := FALSE; obj := p.contents;
  364.         WHILE (obj # NIL) & ~ done DO handle (obj, done); obj := obj.next END
  365.     END Enumerate;
  366.     PROCEDURE (p:Panel) RemoveSelections* ();
  367.     (** Unselects all objects *)
  368.         VAR o: Object;
  369.     BEGIN
  370.         o := p.contents;
  371.         WHILE o # NIL DO o.UnSelect (); o := o.next END;
  372.     END RemoveSelections;
  373.     PROCEDURE (p: Panel) Insert* (o: Object; ov: BOOLEAN);
  374.     (** inserts object o in panel p *)
  375.         VAR i, x0, j: INTEGER; a, b: ARRAY 15 OF CHAR;
  376.     BEGIN
  377.         o.overlapping := ov; 
  378.         IF ~ o.IsOverlapping(p, o.x, o.y, o.w, o.h, FALSE) THEN
  379.             IF p.NamedObject (o.name) = NIL THEN 
  380.                 o.panel := p; o.next := p.contents; p.contents := o;
  381.                 o.Restore; o.panel.MarkMenu; lastin := o;
  382.             ELSE res := nameExists
  383.             END
  384.         ELSE res := objectWouldOverlap
  385.         END
  386.     END Insert;
  387.     PROCEDURE (p: Panel) Copy* (): Panel;
  388.     (** returns a deep copy of p *)
  389.         VAR copy: Panel; o, o1: Object; 
  390.     BEGIN
  391.         NEW (copy); o := p.contents; copy.cmd := p.cmd; 
  392.         WHILE o # NIL DO  
  393.             o1 := NIL; o.Copy (o1); copy.Insert (o1, o.overlapping); o := o.next;
  394.         END;
  395.         RETURN copy
  396.     END Copy;
  397.     PROCEDURE (p: Panel) NofSelObjects* (): INTEGER;
  398.     (** returns the number of selected objects in p *)
  399.         VAR o: Object; count: INTEGER;
  400.     BEGIN
  401.         o := p.contents; count := 0;
  402.         WHILE o # NIL DO 
  403.             IF o.selected THEN INC (count) END; 
  404.             o := o.next
  405.         END;
  406.         RETURN (count)
  407.     END NofSelObjects;
  408.     PROCEDURE (p: Panel) ThisObject* (x, y: INTEGER): Object;
  409.     (** returns the object including the coordinates x and y; first it tries to get a not overlapping object *)
  410.         VAR o1, o: Object; x0, y0: LONGINT;
  411.     BEGIN 
  412.         o := p.contents; o1:= NIL;
  413.         x0 := x * dUnit; y0 := y * dUnit;
  414.         WHILE o # NIL DO
  415.             IF (x0 >= o.x) & (x0 < o.x + o.w) & (y0 >= o.y) & (y0 < o.y + o.h) THEN 
  416.                 IF (o1 = NIL) OR ~ o.overlapping THEN o1 := o END
  417.             END;
  418.             o := o.next
  419.         END;
  420.         RETURN o1
  421.     END ThisObject;
  422.     PROCEDURE (p: Panel) Draw* (x, y: INTEGER; f: Display.Frame);
  423.     (** draws the panel at (x, y) in frame f *)
  424.         VAR o: Object; ox, oy, ow, oh: INTEGER;
  425.     BEGIN 
  426.         o := p.contents;
  427.         WHILE o # NIL DO 
  428.             IF o.overlapping THEN o.GetDim (ox, oy, ow, oh); o.Draw (x + ox, y + oy , f) END;
  429.             o := o.next 
  430.         END;
  431.         o := p.contents;
  432.         WHILE o # NIL DO 
  433.             IF ~ o.overlapping THEN o.GetDim (ox, oy, ow, oh); o.Draw (x + ox, y + oy , f) END;
  434.             o := o.next 
  435.         END
  436.     END Draw;
  437.     PROCEDURE (p: Panel) Print* (x, y: INTEGER);
  438.     (** prints the panel at printer coordinates (x, y) *)
  439.         VAR o: Object; ox, oy, ow, oh: INTEGER; 
  440.     BEGIN
  441.         o := p.contents;
  442.         WHILE o # NIL DO
  443.             o.GetPDim (ox, oy, ow, oh); o.Print (x + ox, y + oy); o := o.next
  444.         END
  445.     END Print;
  446.     PROCEDURE (p: Panel) Load* (VAR r: Files.Rider);
  447.     (** reads the panel from rider r *)
  448.         VAR cnt, end1, end2, h: INTEGER; o, prev: Object; module: Modules.ModuleName; name: ARRAY 32 OF CHAR;
  449.             tab1: ARRAY maxItems OF Modules.ModuleName; tab2: ARRAY maxItems OF ARRAY 32 OF CHAR;
  450.             pos: LONGINT;
  451.     BEGIN 
  452.         p.contents := NIL; prev := NIL; Files.ReadInt(r, cnt); COPY ("", p.cmd); end1 := 0; end2 := 0;
  453.         WHILE cnt # 0 DO DEC (cnt);
  454.             pos := Files.Pos (r); Files.ReadInt (r, h); 
  455.             IF h < end1 THEN module := tab1[h]
  456.             ELSE Files.Set (r, Files.Base (r), pos); Files.ReadString (r, module); tab1[end1] := module; INC (end1) 
  457.             END;
  458.             pos := Files.Pos (r); Files.ReadInt (r, h);
  459.             IF h < end2 THEN COPY (tab2[h], name)
  460.             ELSE Files.Set (r, Files.Base (r), pos); Files.ReadString (r, name); COPY (name, tab2[end2]); INC (end2)
  461.             END; 
  462.             Types.NewObj (o, Types.This (Modules.ThisMod (module), name)); ASSERT (o # NIL);
  463.             o.Load (r); o.panel := p;
  464.             IF prev # NIL THEN prev.next := o ELSE p.contents := o END;
  465.             prev := o
  466.         END; 
  467.         Files.ReadString (r, p.cmd);
  468.         p.Restore ()
  469.     END Load;
  470.     PROCEDURE (p: Panel) Store* (VAR r: Files.Rider);
  471.     (** stores the panel from rider r *)
  472.         VAR cnt, end1, end2, i: INTEGER; o: Object; type: Types.Type; cond: BOOLEAN;
  473.             tab1, tab2: ARRAY maxItems OF ARRAY 32 OF CHAR;
  474.     BEGIN 
  475.         o := p.contents; cnt := 0; end1 := 0; end2 := 0;
  476.         WHILE o # NIL DO INC (cnt); o := o.next END;
  477.         Files.WriteInt (r, cnt); o := p.contents;
  478.         WHILE o # NIL DO 
  479.             type := Types.TypeOf (o); cond := FALSE;
  480.             FOR i := 0 TO end1 -1 DO
  481.                 IF tab1[i] = type.module.name THEN Files.WriteInt (r, i); cond := TRUE END;
  482.             END;
  483.             IF ~cond THEN Files.WriteString (r, type.module.name); COPY (type.module.name, tab1[end1]); INC (end1) END;
  484.             cond := FALSE;
  485.             FOR i := 0 TO end2 -1 DO
  486.                 IF tab2[i] = type.name THEN Files.WriteInt (r, i); cond := TRUE END;
  487.             END;
  488.             IF ~cond THEN Files.WriteString (r, type.name); COPY (type.name, tab2[end2]); INC (end2) END;
  489.             o.Store (r); o := o.next
  490.         END;
  491.         Files.WriteString (r, p.cmd)
  492.     END Store;
  493.     PROCEDURE (p: Panel) Contains* (o: Object): BOOLEAN;
  494.     (** returns TRUE if the panel contains o *)
  495.         VAR o1: Object;
  496.     BEGIN
  497.         o1 := p.contents;
  498.         WHILE o1 # NIL DO
  499.             IF o1 = o THEN RETURN TRUE END; 
  500.             o1 := o1.next
  501.         END;
  502.         RETURN FALSE
  503.     END Contains;
  504.     PROCEDURE (p: Panel) MoveSelected* (dx, dy: INTEGER);
  505.     (** moves all selected objects around dx and dy *)
  506.         VAR 
  507.             o: Object; ov: BOOLEAN; msg: NotifyMsg;
  508.             ox, oy, ow, oh, i, nofelems: INTEGER; dx0, dy0: LONGINT;
  509.             obArray: ARRAY 50 OF Object;
  510.     BEGIN    
  511.         IF p.NofSelObjects () = 0 THEN res := ok; RETURN END;
  512.         o := p.contents; ov := FALSE;
  513.         dx0 := dx * dUnit; dy0 := dy * dUnit;
  514.         WHILE (o # NIL) & (~ ov) DO
  515.             IF o.selected THEN ov := o.IsOverlapping (p, o.x + dx0, o.y + dy0, o.w, o.h, TRUE) END;
  516.             o := o.next
  517.         END;
  518.         o := p.contents;
  519.         IF ~ ov THEN 
  520.             WHILE o # NIL DO
  521.                 IF o.selected THEN 
  522.                     msg.id := 1; msg.obj := o; Viewers.Broadcast (msg);
  523.                     o.GetDim (ox, oy, ow, oh); p.GetObjects (ox, oy, ow, oh, obArray, nofelems); i := 0;
  524.                     WHILE i < nofelems DO
  525.                         IF (~ obArray[i].selected) THEN obArray[i].Restore END; 
  526.                         INC (i)
  527.                     END
  528.                 END;
  529.                 o := o.next
  530.             END;
  531.             o := p.contents;
  532.             WHILE o # NIL DO    
  533.                 IF o.selected THEN o.x := o.x + dx0; o.y := o.y + dy0 END; 
  534.                 o := o.next
  535.             END; 
  536.             o := p.contents;
  537.             WHILE o # NIL DO
  538.                 IF o.selected & o.overlapping THEN o.Restore END; 
  539.                 o := o.next
  540.             END;
  541.             o := p.contents; 
  542.             WHILE o # NIL DO
  543.                 IF o.selected & ~ o.overlapping THEN o.Restore END; 
  544.                 o := o.next
  545.             END;
  546.             res := ok; p.MarkMenu
  547.         ELSE
  548.             res := objectWouldOverlap
  549.         END
  550.     END MoveSelected;
  551.     PROCEDURE (p: Panel) ChangeDistance (dir: CHAR);
  552.         VAR sort: ARRAY 50 OF Object; n, i: INTEGER; o: Object; d: LONGINT;
  553.         PROCEDURE Greater (o1, o2: Object): BOOLEAN;
  554.         BEGIN
  555.             IF (dir = "R") OR (dir = "L") THEN RETURN o1.x > o2.x ELSE RETURN o1.y > o2.y END
  556.         END Greater;
  557.     BEGIN
  558.         (* ---- sort objects *)
  559.         o := p.contents; n := 0;
  560.         WHILE o # NIL DO
  561.             IF o.selected THEN
  562.                 i := n - 1;
  563.                 WHILE (i >= 0) & Greater (sort [i], o) DO
  564.                     sort [i + 1] := sort [i]; DEC (i)
  565.                 END;
  566.                 sort [i + 1] := o; INC (n)
  567.             END;
  568.             o := o.next
  569.         END;
  570.         (* ---- calculate distance *)
  571.         d := 0;
  572.         IF (dir = "R") OR (dir = "L") THEN
  573.             FOR i := 0 TO n - 2 DO d := d + sort[i].x - sort[i + 1].x - sort[i + 1].w END
  574.         ELSE 
  575.             FOR i := 0 TO n - 2 DO d := d + sort[i].y - sort[i + 1].y - sort[i + 1].h END
  576.         END;
  577.         d := d DIV (n - 1);
  578.         (* ---- change distance *)
  579.         IF (dir = "R")  OR (dir = "L") THEN
  580.             FOR i := 0 TO n - 2 DO sort[i + 1].x := sort[i].x - sort[i + 1].w - d END
  581.         ELSIF (dir = "U") OR (dir = "D") THEN
  582.             FOR i := 0 TO n - 2 DO sort[i  + 1].y := sort[i].y - sort[i + 1].h - d END
  583.         END
  584.     END ChangeDistance;
  585.     PROCEDURE (p: Panel) AlignTest (dir: CHAR; x: LONGINT): BOOLEAN;
  586.     (* returns TRUE if Align with parameters dir and x is not possible *)
  587.         VAR p2: Panel; o: Object;
  588.     BEGIN
  589.         p2 := p.Copy (); o := p2.contents;
  590.         WHILE o # NIL DO
  591.             IF o.selected THEN
  592.                 IF dir = "R" THEN o.x := x - o.w
  593.                 ELSIF dir = "L" THEN o.x := x
  594.                 ELSIF dir = "U" THEN o.y := x - o.h
  595.                 ELSIF dir = "D" THEN o.y := x
  596.                 END;
  597.             END;
  598.             o := o.next
  599.         END;
  600.         o := p2.contents;
  601.         WHILE o # NIL DO
  602.             IF o.IsOverlapping (p2, o.x, o.y, o.w, o.h, FALSE) THEN RETURN TRUE END;
  603.             o := o.next
  604.         END;
  605.         RETURN FALSE
  606.     END AlignTest;
  607.     PROCEDURE (p: Panel) RegulateDistanceTest (dir: CHAR): BOOLEAN;
  608.     (* returns TRUE if RegulateDistance with parameters dir and x is not possible *)
  609.         VAR p2: Panel; o: Object;
  610.     BEGIN
  611.         p2 := p.Copy (); p2.ChangeDistance (dir); o := p2.contents;
  612.         WHILE o # NIL DO
  613.             IF o.IsOverlapping (p2, o.x, o.y, o.w, o.h, FALSE) THEN RETURN TRUE END;
  614.             o := o.next
  615.         END;
  616.         RETURN FALSE
  617.     END RegulateDistanceTest;
  618.     PROCEDURE (p: Panel) AlignSelected* (dir: CHAR);
  619.     (** aligns the selected objects according to dir (Right, Left, Up or Down) *)
  620.         VAR o: Object; x: LONGINT;
  621.         PROCEDURE Max;
  622.         BEGIN
  623.             IF dir = "R" THEN IF o.x + o.w > x THEN x := o.x + o.w END
  624.             ELSIF dir = "L" THEN IF o.x < x THEN x := o.x END
  625.             ELSIF dir = "U" THEN IF o.y + o.h > x THEN x := o.y + o.h END
  626.             ELSIF dir = "D" THEN IF o.y < x THEN x := o.y END
  627.             END
  628.         END Max;
  629.     BEGIN
  630.         IF (dir # "R") & (dir # "L") & (dir # "U") & (dir # "D") THEN res := wrongInput; RETURN END;
  631.         IF p.NofSelObjects() = 0 THEN res:= ok; RETURN END;
  632.         o := p.contents; 
  633.         IF (dir = "R") OR (dir = "D") THEN 
  634.             x := 0 
  635.         ELSIF (dir = "L") THEN
  636.             x := MAX (LONGINT) 
  637.         ELSE
  638.             x := MIN (LONGINT); 
  639.         END;
  640.         WHILE o # NIL DO
  641.             IF o.selected THEN Max END;
  642.             o := o.next
  643.         END; 
  644.         IF ~ p.AlignTest (dir, x) THEN
  645.             o := p.contents;
  646.             WHILE o# NIL DO
  647.                 IF o.selected THEN
  648.                     IF dir = "R" THEN o.x := x - o.w
  649.                     ELSIF dir = "L" THEN o.x := x
  650.                     ELSIF dir = "U" THEN o.y := x - o.h
  651.                     ELSIF dir = "D" THEN o.y := x
  652.                     END
  653.                 END;
  654.                 o := o.next;
  655.             END;
  656.             p.Restore; res := ok; p.MarkMenu
  657.         ELSE
  658.             res := objectWouldOverlap
  659.         END
  660.     END AlignSelected;
  661.     PROCEDURE (p: Panel) RegulateDistance* (dir: CHAR);
  662.     (** aligns the selected objects along the direction dir such that they are equidistant *)
  663.     BEGIN
  664.         IF (dir # "R") & (dir # "L") & (dir # "U") & (dir # "D") THEN res := wrongInput; RETURN END;
  665.         IF p.NofSelObjects () > 50 THEN res := tooManyObjectsSelected; RETURN END;
  666.         IF p.NofSelObjects () < 3 THEN res := ok; RETURN END;
  667.         IF ~ p.RegulateDistanceTest (dir) THEN
  668.             p.ChangeDistance (dir);        
  669.             p.Restore (); res := ok; p.MarkMenu
  670.         ELSE
  671.             res := objectWouldOverlap
  672.         END
  673.     END RegulateDistance;
  674.     PROCEDURE (p: Panel) Broadcast* (f: Display.Frame; VAR m: Display.FrameMsg);
  675.     (** sends the message m to all objects in the panel p which is displayed in frame f *)
  676.         VAR o, o1: Object; 
  677.     BEGIN
  678.         o := p.contents;
  679.         WHILE o # NIL DO
  680.             o.Handle (f, m); o := o.next;
  681.         END
  682.     END Broadcast;
  683.     PROCEDURE Error* (name: ARRAY OF CHAR);
  684.     (** writes an error message to the log viewer *)
  685.     BEGIN
  686.         Texts.WriteString (w0, name); 
  687.         IF res = objectIsAlreadyInPanel THEN Texts.WriteString (w0, " Error 1: Object is already in Panel")
  688.         ELSIF res = nameExists THEN Texts.WriteString (w0, " Error 2: Name exists")
  689.         ELSIF res = objectNotFound THEN Texts.WriteString (w0, " Error 3: Object not found")
  690.         ELSIF res = wrongInput THEN Texts.WriteString (w0, " Error 4: Wrong input")
  691.         ELSIF res = noPanelSelected THEN Texts.WriteString (w0, "Error 5: No panel selected")
  692.         ELSIF res = objectWouldOverlap THEN Texts.WriteString 
  693.                         (w0, " Error 6: Object would overlap another object")
  694.         ELSIF res = tooManyObjectsSelected THEN Texts.WriteString 
  695.                         (w0, " Error 7: Too many objects selected")
  696.         ELSE Texts.WriteInt (w0, res, 5)
  697.         END;
  698.         Texts.WriteLn (w0);
  699.         Texts.Append (Oberon.Log, w0.buf)
  700.     END Error;
  701. BEGIN
  702.     dUnit := TextFrames.Unit;  pUnit := TextPrinter.Unit; Edit := NIL; Update := NIL; 
  703.     res := ok; editPanel := NIL; cmdPanel := NIL; editObject := NIL; lastin := NIL; 
  704.     Texts.OpenWriter (w0); 
  705. END Dialogs. 
  706.