ð­Syntax10.Scn.FntöÿÿÿÐÝ°­StampElemsAlloc9 May 96HSyntax10b.Scn.Fnt TYbMODULE FontElems; (** HM *) IMPORT Viewers, Fonts, Texts, TextFrames, Oberon, PopupElems; TYPE Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (PopupElems.ElemDesc) END; VAR ext: ARRAY 16 OF CHAR; PROCEDURE SplitFont (name: ARRAY OF CHAR; VAR family: ARRAY OF CHAR; VAR style: CHAR; VAR size: INTEGER); VAR i: INTEGER; BEGIN style := " "; size := 0; i := 0; WHILE (name[i] # 0X) & ((name[i] < "0") OR (name[i] > "9")) DO family[i] := name[i]; INC(i) END; family[i] := 0X; WHILE (name[i] # 0X) & (name[i] >= "0") & (name[i] <= "9") DO size := 10*size + ORD(name[i]) - ORD("0"); INC(i) END; IF (CAP(name[i]) = "I") OR (CAP(name[i]) = "B") OR (CAP(name[i]) = "M") THEN style := name[i] END END SplitFont; PROCEDURE MakeFont (family: ARRAY OF CHAR; style: CHAR; size: INTEGER; VAR name: ARRAY OF CHAR); VAR i, j: INTEGER; d: ARRAY 5 OF CHAR; ch: CHAR; BEGIN i := 0; WHILE family[i] # 0X DO name[i] := family[i]; INC(i) END; j := 0; REPEAT d[j] := CHR(size MOD 10 + ORD("0")); size := size DIV 10; INC(j) UNTIL size = 0; REPEAT DEC(j); name[i] := d[j]; INC(i) UNTIL j = 0; IF style # " " THEN name[i] := style; INC(i) END; j := 0; REPEAT ch := ext[j]; name[i] := ch; INC(i); INC(j) UNTIL ch = 0X END MakeFont; PROCEDURE Change (t: Texts.Text; beg, end: LONGINT; family: ARRAY OF CHAR; style: CHAR; size: INTEGER; color: SHORTINT); VAR r: Texts.Reader; pos, org: LONGINT; ch, sty: CHAR; fnt : Fonts.Font; fam: ARRAY 32 OF CHAR; siz: INTEGER; name: ARRAY 64 OF CHAR; BEGIN pos := beg; Texts.OpenReader(r, t, pos); Texts.Read(r, ch); WHILE pos < end DO org := pos; fnt := r.fnt; REPEAT INC(pos); Texts.Read(r, ch) UNTIL (pos >= end) OR (r.fnt # fnt); SplitFont(fnt.name, fam, sty, siz); IF family # "" THEN COPY(family, fam) END; IF style = "p" THEN sty := " " ELSIF style # " " THEN sty := style END; IF size # 0 THEN siz := size END; MakeFont(fam, sty, siz, name); fnt := Fonts.This(name); IF fnt.name = name THEN Texts.ChangeLooks(t, org, pos, {0}, fnt, 0, 0) ELSE Texts.ChangeLooks(t, org, pos, {1}, NIL, color, 0) END END END Change; PROCEDURE Exec (e: Elem; pos: LONGINT); VAR t: Texts.Text; s: Texts.Scanner; family: ARRAY 32 OF CHAR; style, ch: CHAR; size: INTEGER; color: SHORTINT; beg, end, time: LONGINT; BEGIN Oberon.GetSelection(t, beg, end, time); IF time >= 0 THEN style := " "; family := ""; size := 0; Texts.OpenReader(s, e.menu, pos); Texts.Read(s, ch); color := s.col; Texts.OpenScanner(s, e.menu, pos); Texts.Scan(s); IF (s.class IN {Texts.Name, Texts.String}) & (s.line = 0) THEN IF s.s = "plain" THEN style := "p" ELSIF s.s = "italic" THEN style := "i" ELSIF s.s = "bold" THEN style := "b" ELSIF s.s = "mark" THEN style := "m" ELSE COPY(s.s, family) END; Change(t, beg, end, family, style, size, color) ELSIF (s.class = Texts.Int) & (s.line = 0) THEN size := SHORT(s.i); Change(t, beg, end, family, style, size, color) END END END Exec; PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg); VAR e1: Elem; BEGIN WITH e: Elem DO WITH m: Texts.CopyMsg DO NEW(e1); m.e := e1; PopupElems.Handle(e, m) | m: Texts.IdentifyMsg DO m.mod := "FontElems"; m.proc := "Alloc" | m: PopupElems.ExecMsg DO Exec(e, m.pos) ELSE PopupElems.Handle(e, m) END END END Handle; PROCEDURE Alloc*; VAR e: Elem; BEGIN NEW(e); e.handle := Handle; Texts.new := e END Alloc; PROCEDURE Insert*; VAR e: Elem; insert: TextFrames.InsertElemMsg; BEGIN NEW(e); e.handle := Handle; e.name := "Font"; e.small := TRUE; e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e); insert.e := e; Viewers.Broadcast(insert) END Insert; BEGIN ext := ".Scn.Fnt" END FontElems.