home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / styleelems.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  11KB  |  258 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax12.Scn.Fnt
  4. Syntax10i.Scn.Fnt
  5. MODULE StyleElems;    (** CAS 19-May-92 / 28-Sep-93 **)
  6.     IMPORT
  7.         Display, Files, Fonts, Viewers, Texts, Oberon, MenuViewers, TextFrames, ParcElems;
  8.     CONST
  9.         search* = 0; change* = 1; rename* = 2;
  10.         NameFont = "Syntax8.Scn.Fnt";
  11.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  12.         pageBreak = TextFrames.pageBreak;
  13.         unit = TextFrames.Unit;
  14.     TYPE
  15.         Name* = ARRAY 32 OF CHAR;
  16.         Parc* = POINTER TO ParcDesc;
  17.         ParcDesc* = RECORD (TextFrames.ParcDesc)
  18.             name*: Name;
  19.             home: Texts.Text
  20.         END;
  21.         UpdateMsg* = RECORD (Texts.ElemMsg)
  22.             id*: INTEGER;
  23.             pos*: LONGINT;
  24.             name*, newName*: Name;
  25.             parc*: Parc
  26.         END;
  27.         font*: Fonts.Font;
  28.     (* arguments *)
  29.     PROCEDURE MarkedFrame (): TextFrames.Frame;
  30.         VAR v: Viewers.Viewer;
  31.     BEGIN v := Oberon.MarkedViewer();
  32.         IF (v IS MenuViewers.Viewer) & (v.dsc.next IS TextFrames.Frame) THEN
  33.             RETURN v.dsc.next(TextFrames.Frame)
  34.         ELSE RETURN NIL
  35.         END
  36.     END MarkedFrame;
  37.     PROCEDURE FocusFrame (): TextFrames.Frame;
  38.         VAR v: Viewers.Viewer; f: TextFrames.Frame;
  39.     BEGIN v := Oberon.FocusViewer;
  40.         IF (v IS MenuViewers.Viewer) & (v.dsc.next IS TextFrames.Frame) THEN
  41.             f := v.dsc.next(TextFrames.Frame);
  42.             IF f.hasCar THEN RETURN f ELSE RETURN NIL END
  43.         ELSE RETURN NIL
  44.         END
  45.     END FocusFrame;
  46.     PROCEDURE GetMainArg (VAR S: Texts.Scanner);
  47.         (*after command or (^) at selection*)
  48.         VAR text: Texts.Text; beg, end, time: LONGINT;
  49.     BEGIN Texts.Scan(S);
  50.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time);
  51.             IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  52.         END;
  53.         IF S.line # 0 THEN S.class := Texts.Inval END
  54.     END GetMainArg;
  55.     (* portable I/O *)
  56.     PROCEDURE WriteString (VAR r: Files.Rider; s: ARRAY OF CHAR);
  57.         VAR i: INTEGER;
  58.     BEGIN i := 0;
  59.         WHILE s[i] # 0X DO INC(i) END;
  60.         Files.WriteBytes(r, s, i + 1)
  61.     END WriteString;
  62.     PROCEDURE ReadString (VAR r: Files.Rider; VAR s: ARRAY OF CHAR);
  63.         VAR i: INTEGER; ch: CHAR;
  64.     BEGIN i := 0;
  65.         REPEAT Files.Read(r, ch); s[i] := ch; INC(i) UNTIL (ch = 0X) OR (i = LEN(s));
  66.         IF ch # 0X THEN s[0] := 0X END
  67.     END ReadString;
  68.     (** operations on elements **)
  69.     PROCEDURE Broadcast* (T: Texts.Text; VAR msg: UpdateMsg);
  70.         VAR R: Texts.Reader; e: Texts.Elem;
  71.     BEGIN Texts.OpenReader(R, T, 0); Texts.ReadElem(R);
  72.         WHILE ~R.eot DO e := R.elem; msg.pos := Texts.Pos(R) - 1; Texts.ReadElem(R); e.handle(e, msg) END
  73.     END Broadcast;
  74.     PROCEDURE Search* (T: Texts.Text; VAR name: Name; VAR P: Parc);
  75.         VAR update: UpdateMsg;
  76.     BEGIN update.id := search; update.name := name; update.parc := NIL;
  77.         Broadcast(T, update);
  78.         P := update.parc
  79.     END Search;
  80.     PROCEDURE Synch* (P: Parc; VAR synched: BOOLEAN);
  81.         VAR T: Texts.Text; Q: Parc;
  82.     BEGIN T := Texts.ElemBase(P); synched := FALSE;
  83.         IF (T # NIL) & (P.home # T) THEN Search(T, P.name, Q);
  84.             IF Q # NIL THEN ParcElems.CopyParc(Q, P); EXCL(P.opts, pageBreak); synched := TRUE END;
  85.             P.home := T
  86.         END
  87.     END Synch;
  88.     PROCEDURE ChangeSetting* (P: Parc);
  89.         VAR T: Texts.Text; update: UpdateMsg;
  90.     BEGIN T := Texts.ElemBase(P);
  91.         update.id := change; update.name := P.name; update.parc := P;
  92.         Broadcast(T, update)
  93.     END ChangeSetting;
  94.     PROCEDURE ChangeName* (P: Parc; name: ARRAY OF CHAR; VAR synched: BOOLEAN);
  95.     BEGIN synched := FALSE;
  96.         IF P.name # name THEN COPY(name, P.name); P.home := NIL; Synch(P, synched) END
  97.     END ChangeName;
  98.     PROCEDURE Load* (P: Parc; VAR r: Files.Rider);
  99.     BEGIN ParcElems.LoadParc(P, r); ReadString(r, P.name); P.home := Texts.ElemBase(P)
  100.     END Load;
  101.     PROCEDURE Store* (P: Parc; VAR r: Files.Rider);
  102.         VAR synched: BOOLEAN;
  103.     BEGIN Synch(P, synched); ParcElems.StoreParc(P, r); WriteString(r, P.name)
  104.     END Store;
  105.     PROCEDURE Copy* (SP, DP: Parc);
  106.     BEGIN ParcElems.CopyParc(SP, DP); DP.name := SP.name; DP.home := SP.home
  107.     END Copy;
  108.     PROCEDURE Prepare* (P: Parc; indent, unit: LONGINT);
  109.         VAR synched: BOOLEAN;
  110.     BEGIN Synch(P, synched); ParcElems.Prepare(P, indent, unit);
  111.         IF LONG(font.height + 4) * unit > P.H THEN P.H := LONG(font.height + 4) * unit END
  112.     END Prepare;
  113.     PROCEDURE Width (P: Parc): INTEGER;
  114.         VAR pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER;
  115.     BEGIN i := 0; px := 0;
  116.         WHILE P.name[i] # 0X DO
  117.             Display.GetChar(font.raster, P.name[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
  118.         END;
  119.         RETURN px
  120.     END Width;
  121.     PROCEDURE DrawString (P: Parc; col: SHORTINT; x0, y0, bw: INTEGER);
  122.         VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER;
  123.     BEGIN i := 0;
  124.         Display.ReplConst(Display.black, x0, y0, bw + 4, font.height, Display.replace); INC(x0, 2); DEC(y0, font.minY);
  125.         WHILE P.name[i] # 0X DO
  126.             Display.GetChar(font.raster, P.name[i], dx, x, y, w, h, pat); INC(i);
  127.             Display.CopyPattern(col, pat, x0 + x, y0 + y, Display.replace); INC(x0, dx)
  128.         END
  129.     END DrawString;
  130.     PROCEDURE Draw* (P: Parc; F: Display.Frame; col: SHORTINT; x0, y0: INTEGER);
  131.         VAR bw: INTEGER;
  132.     BEGIN ParcElems.Draw(P, F, col, x0, y0);
  133.         bw := Width(P); DrawString(P, col, x0 + SHORT(P.W DIV unit) - bw - 20, y0 + 4, bw)
  134.     END Draw;
  135.     PROCEDURE Edit* (P: Parc; F: TextFrames.Frame; pos: LONGINT; x0, y0, x, y: INTEGER; keysum: SET);
  136.     BEGIN
  137.         IF F.showsParcs THEN ParcElems.Edit(P, F, pos, x0, y0, x, y, keysum);
  138.             IF (middleKey IN keysum) & (keysum # cancel) THEN ChangeSetting(P) END
  139.         END
  140.     END Edit;
  141.     PROCEDURE SetAttr* (P: Parc; F: TextFrames.Frame; VAR S: Texts.Scanner; log: Texts.Text);
  142.     BEGIN ParcElems.SetAttr(P, F, unit, S, log); ChangeSetting(P)
  143.     END SetAttr;
  144.     (** handle elements **)
  145.     PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  146.         VAR e: Parc; opts: SET; synched: BOOLEAN;
  147.     BEGIN
  148.         WITH E: Parc DO
  149.             IF msg IS TextFrames.DisplayMsg THEN
  150.                 WITH msg: TextFrames.DisplayMsg DO
  151.                     IF msg.prepare THEN Prepare(E, msg.indent, unit)
  152.                     ELSE Draw(E, msg.frame, msg.col, msg.X0, msg.Y0)
  153.                     END
  154.                 END
  155.             ELSIF msg IS Texts.IdentifyMsg THEN
  156.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "StyleElems"; msg.proc := "Alloc" END
  157.             ELSIF msg IS Texts.FileMsg THEN
  158.                 WITH msg: Texts.FileMsg DO
  159.                     IF msg.id = Texts.load THEN Load(E, msg.r)
  160.                     ELSIF msg.id = Texts.store THEN Store(E, msg.r)
  161.                     END
  162.                 END
  163.             ELSIF msg IS Texts.CopyMsg THEN NEW(e); Copy(E, e); msg(Texts.CopyMsg).e := e
  164.             ELSIF msg IS TextFrames.TrackMsg THEN
  165.                 WITH msg: TextFrames.TrackMsg DO
  166.                     Edit(E, msg.frame(TextFrames.Frame), msg.pos, msg.X0, msg.Y0, msg.X, msg.Y, msg.keys)
  167.                 END
  168.             ELSIF msg IS ParcElems.StateMsg THEN
  169.                 WITH msg: ParcElems.StateMsg DO
  170.                     IF msg.id = ParcElems.set THEN SetAttr(E, msg.frame, msg.par, msg.log)
  171.                     ELSE ParcElems.Handle(E, msg)
  172.                     END
  173.                 END
  174.             ELSIF msg IS UpdateMsg THEN
  175.                 WITH msg: UpdateMsg DO
  176.                     IF (msg.id = search) & (msg.parc = NIL) & (E.name = msg.name) & (E.home = Texts.ElemBase(E)) THEN
  177.                         msg.parc := E
  178.                     ELSIF (msg.id = change) & (E.name = msg.name) THEN
  179.                         IF E # msg.parc THEN opts := E.opts;
  180.                             ParcElems.CopyParc(msg.parc, E); E.opts := E.opts - {pageBreak} + opts * {pageBreak}
  181.                         END;
  182.                         ParcElems.ChangedParc(E, msg.pos)
  183.                     ELSIF (msg.id = rename) & (E.name = msg.name) THEN
  184.                         ChangeName(E, msg.newName, synched);
  185.                         IF synched THEN ParcElems.ChangedParc(E, msg.pos)
  186.                         ELSE Texts.ChangeLooks(Texts.ElemBase(E), msg.pos, msg.pos+1, {}, NIL, 0, 0)
  187.                         END
  188.                     END
  189.                 END
  190.             ELSE ParcElems.Handle(E, msg)
  191.             END
  192.         END
  193.     END Handle;
  194.     PROCEDURE Alloc*;
  195.         VAR p: Parc;
  196.     BEGIN NEW(p); p.handle := Handle; Texts.new := p
  197.     END Alloc;
  198.     (** commands **)
  199.     PROCEDURE Insert*;    (** ("^" | name | string) **)
  200.         VAR F: TextFrames.Frame; P: TextFrames.Parc; p: Parc; S: Texts.Scanner; pbeg: LONGINT;
  201.             m: TextFrames.InsertElemMsg;
  202.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S);
  203.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  204.             F := FocusFrame();
  205.             IF F # NIL THEN TextFrames.ParcBefore(F.text, F.carloc.pos, P, pbeg)
  206.             ELSE P := TextFrames.defParc
  207.             END;
  208.             NEW(p); ParcElems.CopyParc(P, p);
  209.             p.handle := Handle; COPY(S.s, p.name); p.home := NIL; m.e := p;
  210.             Oberon.FocusViewer.handle(Oberon.FocusViewer, m)
  211.         END
  212.     END Insert;
  213.     PROCEDURE Rename*;    (** ("^" | name | string) ["/s"] **)
  214.         VAR S: Texts.Scanner; F: TextFrames.Frame; P: TextFrames.Parc; p: Parc;
  215.             pbeg: LONGINT; synch, synched: BOOLEAN;
  216.             name: Name;
  217.     BEGIN F := MarkedFrame(); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S);
  218.         IF (F # NIL) & F.hasSel & (F.selbeg.pos + 1 = F.selend.pos)
  219.         & ((S.class = Texts.Name) OR (S.class = Texts.String)) THEN
  220.             TextFrames.ParcBefore(F.text, F.selbeg.pos, P, pbeg);
  221.             IF (P IS Parc) & (pbeg = F.selbeg.pos) & (P(Parc).name # S.s) THEN
  222.                 COPY(S.s, name); Texts.Scan(S);
  223.                 IF (S.class = Texts.Char) & (S.c = "/") & (CAP(S.nextCh) = "S") THEN synch := TRUE
  224.                 ELSE Search(F.text, name, p); synch := p = NIL
  225.                 END;
  226.                 ChangeName(P(Parc), name, synched);
  227.                 IF synched THEN ParcElems.ChangedParc(P, pbeg)
  228.                 ELSE Texts.ChangeLooks(F.text, pbeg, pbeg+1, {}, NIL, 0, 0)
  229.                 END
  230.             END
  231.         END
  232.     END Rename;
  233.     PROCEDURE RenameAll*;    (** ("^" | name | string) ["/s"] **)
  234.         VAR S: Texts.Scanner; F: TextFrames.Frame; P: TextFrames.Parc; p: Parc;
  235.             pbeg: LONGINT; synch: BOOLEAN;
  236.             msg: UpdateMsg; name: Name;
  237.     BEGIN F := MarkedFrame(); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S);
  238.         IF (F # NIL) & F.hasSel & (F.selbeg.pos + 1 = F.selend.pos)
  239.         & ((S.class = Texts.Name) OR (S.class = Texts.String)) THEN
  240.             TextFrames.ParcBefore(F.text, F.selbeg.pos, P, pbeg);
  241.             IF (P IS Parc) & (pbeg = F.selbeg.pos) & (P(Parc).name # S.s) THEN
  242.                 COPY(S.s, name); Texts.Scan(S);
  243.                 IF (S.class = Texts.Char) & (S.c = "/") & (CAP(S.nextCh) = "S") THEN synch := TRUE
  244.                 ELSE Search(F.text, name, p); synch := p = NIL
  245.                 END;
  246.                 IF synch THEN
  247.                     msg.id := rename; msg.name := P(Parc).name; msg.newName := name;
  248.                     Broadcast(F.text, msg)
  249.                 END
  250.             END
  251.         END
  252.     END RenameAll;
  253. BEGIN font := Fonts.This(NameFont)
  254. END StyleElems.
  255.     Write.Open ^    Styles.Text        System.Free StyleElems ~
  256.     StyleElems.Insert ^    StyleElems.Rename ^    StyleElems.RenameAll ^
  257.         "heading"    "sub-heading"    "table A"/s
  258.