ðTSyntax10.Scn.FntéSyntax10b.Scn.Fnt p·9• ¡ æ¥]*³åyÆ×× ©•TMODULE FontEdit; (* gri 22.10.92 / mh 24.9.1994 *) IMPORT Input, Display, Files, Texts, TextFrames, Viewers, MenuViewers, Oberon, FEFonts, Fonts; CONST default = ORD("A"); black = Display.black; white = Display.white; left = 2; middle = 1; right = 0; cancel = {left, middle, right}; width = 50; height = 40; side = 9; LeftMarg = 20; TopMarg = 50; MetrMarg = 30; (* Color version: *) MetricLineCol = 13; (* grey *) SelectCol = 1; (* red *) (* BW Version: MetricLineCol = white; SelectCol = white; *) UpdateProbeStr = 100; TYPE Frame = POINTER TO FrameDesc; FrameDesc = RECORD (Display.FrameDesc) font: FEFonts.Font; this: INTEGER; undo: FEFonts.Character; focus: BOOLEAN; iMin, jMin: INTEGER; (* minimum i and j values in this frame *) (* iMin <= 0; jMin <= 0 *) probe: ARRAY 128 OF CHAR; END; FrameMsg = RECORD (Display.FrameMsg) font: FEFonts.Font; op, ch, i, j: INTEGER END; VAR W: Texts.Writer; DIGIT: ARRAY 16+1 OF CHAR; PROCEDURE AppendInt (n: INTEGER; base: INTEGER; VAR str: ARRAY OF CHAR); VAR i: INTEGER; PROCEDURE Digit(k: INTEGER); BEGIN IF k > base-1 THEN Digit(k DIV base) END; str[i] := DIGIT[k MOD base]; INC(i) END Digit; BEGIN i := 0; ASSERT(base <= 16); WHILE str[i] # 0X DO INC(i) END; IF n < 0 THEN str[i] := "-"; INC(i); n := -n END; Digit(n); str[i] := 0X; END AppendInt; PROCEDURE AppendStr (s: ARRAY OF CHAR; VAR str: ARRAY OF CHAR); VAR n, k: INTEGER; BEGIN n := 0; k := 0; WHILE str[n] # 0X DO INC(n) END; WHILE s[k] # 0X DO str[n] := s[k]; INC(n); INC(k) END; str[n] := 0X; END AppendStr; PROCEDURE MarkMenu (F: Frame); VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR; BEGIN V := Viewers.This(F.X, F.Y); IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) THEN T := V.dsc(TextFrames.Frame).text; IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END; IF ch # "!" THEN Texts.Write(W, "!"); Texts.Append(T, W.buf) END END END MarkMenu; PROCEDURE DispString (F: Frame; s: ARRAY OF CHAR; X, Y: INTEGER; col: INTEGER); VAR i, x, y, w, h, dx: INTEGER; pat: LONGINT; BEGIN i := 0; WHILE (i= 0 THEN Texts.OpenScanner(S, Sel, beg) ELSE S.class := Texts.Inval END ELSE Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); END END OpenScanner; PROCEDURE Open*; VAR S: Texts.Scanner; F: Frame; X, Y: INTEGER; V: MenuViewers.Viewer; font: FEFonts.Font; menu: TextFrames.Frame; buf: Texts.Buffer; T: Texts.Text; BEGIN OpenScanner(S); Texts.Scan(S); IF (S.class = Texts.Name) & (S.line = 0) THEN font := FEFonts.This(S.s); IF font # NIL THEN font.notify := Notify; NEW(F); F.handle := Handle; F.font := font; F.this := default; FEFonts.GetChar(font, default, F.undo); F.focus := FALSE; F.iMin := -16; F.jMin := -16; F.probe := "The quick brown fox jumps over the lazy dog"; IF Files.Old("FontEdit.Menu.Text") = NIL THEN menu := TextFrames.NewMenu(font.name, "System.Close System.Copy System.Grow FontEdit.Undo FontEdit.Store "); ELSE menu := TextFrames.NewMenu(font.name, ""); NEW(T); Texts.Open(T, "FontEdit.Menu.Text"); NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(menu.text, buf) END; Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y); V := MenuViewers.New(menu, F, TextFrames.menuH, X, Y) ELSE Texts.WriteString(W, S.s); Texts.WriteString(W, " not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); END END END Open; PROCEDURE New*; VAR F: Frame; X, Y: INTEGER; V: MenuViewers.Viewer; font: FEFonts.Font; menu: TextFrames.Frame; buf: Texts.Buffer; T: Texts.Text; BEGIN font := FEFonts.New(); IF font # NIL THEN font.notify := Notify; NEW(F); F.handle := Handle; F.font := font; F.this := default; FEFonts.GetChar(font, default, F.undo); F.focus := FALSE; F.iMin := -16; F.jMin := -16; F.probe := "The quick brown fox jumps over the lazy dog"; IF Files.Old("FontEdit.Menu.Text") = NIL THEN menu := TextFrames.NewMenu(font.name, "System.Close System.Copy System.Grow FontEdit.Undo FontEdit.Store "); ELSE menu := TextFrames.NewMenu(font.name, ""); NEW(T); Texts.Open(T, "FontEdit.Menu.Text"); NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(menu.text, buf) END; Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y); V := MenuViewers.New(menu, F, TextFrames.menuH, X, Y) END END New; PROCEDURE GetFrame(): Frame; VAR F: Frame; V: Viewers.Viewer; BEGIN F := NIL; IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN IF Oberon.Par.frame.next IS Frame THEN F := Oberon.Par.frame.next(Frame) END ELSE V := Oberon.MarkedViewer(); IF (V # NIL) & (V.dsc # NIL) & (V.dsc.next # NIL) THEN IF V.dsc.next IS Frame THEN F := V.dsc.next(Frame) END END END; RETURN F END GetFrame; PROCEDURE Store*; VAR F: Frame; S: Texts.Scanner; t: Texts.Text; BEGIN F := GetFrame(); IF F # NIL THEN t := Oberon.Par.vwr.dsc(TextFrames.Frame).text; Texts.OpenScanner(S, t, 0); Texts.Scan(S); IF (S.class = Texts.Name) & (S.line = 0) THEN Texts.WriteString(W, "FontEdit.Store "); Texts.Append(Oberon.Log, W.buf); FEFonts.Store(S.s, F.font); Texts.WriteString(W, S.s); Texts.WriteLn(W); IF F.font.height < F.font.maxY - F.font.minY THEN Texts.WriteString(W, " WARNING: font height < maxY - minY !"); Texts.WriteLn(W); END; Texts.Append(Oberon.Log, W.buf); Texts.OpenReader(S, t, t.len-1); Texts.Read(S, S.c); IF S.c = "!" THEN Texts.Delete(t, t.len-1, t.len) END; END END END Store; PROCEDURE Show*; VAR S: Texts.Scanner; F: Frame; n, ascii: INTEGER; s: ARRAY 16 OF CHAR; PROCEDURE HexVal(ch: CHAR): INTEGER; BEGIN IF ("0" <= ch) & (ch <= "9") THEN RETURN ORD(ch) - ORD("0") ELSIF ("A" <= ch) & (ch <= "F") OR ("a" <= ch) & (ch <= "f") THEN RETURN ORD(CAP(ch)) - ORD("A") + 10; END; RETURN -1; END HexVal; BEGIN F := GetFrame(); IF F # NIL THEN OpenScanner(S); n := 0; ascii := -1; WHILE (S.nextCh <= " ") & ~S.eot DO Texts.Read(S, S.nextCh) END; IF ~S.eot THEN REPEAT s[n] := S.nextCh; INC(n); Texts.Read(S, S.nextCh) UNTIL (S.nextCh <= " ") OR (n = 16); IF n > 1 THEN IF s[n-1] = "X" THEN ascii := HexVal(s[n-2]); IF (ascii >= 0) & (n > 2) THEN INC(ascii, 16*HexVal(s[n-3])) END END END; IF (ascii < 0) & (n > 0) THEN ascii := ORD(s[0]) END; IF (ascii > 0) & (ascii # F.this) THEN DrawChar(F, black); F.this := ascii; FEFonts.GetChar(F.font, F.this, F.undo); DrawChar(F, white) END END END END Show; PROCEDURE CopyFrom*; VAR src, targ: Frame; V: Viewers.Viewer; BEGIN src := GetFrame(); IF src # NIL THEN V := Oberon.FocusViewer; IF (V # NIL) & (V IS MenuViewers.Viewer) & (V.dsc.next IS Frame) THEN targ := V.dsc.next(Frame); IF src # targ THEN DrawChar(targ, black); FEFonts.GetChar(src.font, src.this, targ.undo); (*targ.this := src.this;*) FEFonts.SetChar(targ.font, targ.this, targ.undo); DrawChar(targ, white) END END END END CopyFrom; PROCEDURE Commit*; VAR F: Frame; BEGIN F := GetFrame(); IF F # NIL THEN FEFonts.Commit(F.font, F.this) END END Commit; PROCEDURE Undo*; VAR F: Frame; BEGIN F := GetFrame(); IF F # NIL THEN FEFonts.Undo(F.font, F.this); FEFonts.UpdateMetrics(F.font); Notify(F.font, UpdateProbeStr, 0, 0, 0); END END Undo; PROCEDURE Next*; VAR F: Frame; BEGIN F := GetFrame(); IF F # NIL THEN DrawChar(F, black); F.this := (F.this + 1) MOD 100H; FEFonts.GetChar(F.font, F.this, F.undo); DrawChar(F, white) END END Next; PROCEDURE Prev*; VAR F: Frame; BEGIN F := GetFrame(); IF F # NIL THEN DrawChar(F, black); F.this := (F.this - 1) MOD 100H; FEFonts.GetChar(F.font, F.this, F.undo); DrawChar(F, white) END END Prev; PROCEDURE SetProbe*; VAR F: Frame; S: Texts.Scanner; BEGIN F := GetFrame(); IF F # NIL THEN OpenScanner(S); Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN DrawProbeString(F, black); COPY(S.s, F.probe); DrawProbeString(F, white) END END END SetProbe; PROCEDURE SetHeight*; VAR F: Frame; S: Texts.Scanner; BEGIN F := GetFrame(); IF F # NIL THEN OpenScanner(S); Texts.Scan(S); IF S.class = Texts.Int THEN FEFonts.SetHeight(F.font, SHORT(S.i)) ELSIF (S.class = Texts.Name) & (S.s = "default") THEN FEFonts.SetHeight(F.font, F.font.maxY - F.font.minY) END; END END SetHeight; BEGIN Texts.OpenWriter(W); DIGIT := "0123456789ABCDEF"; END FontEdit. FontEdit.Open Syntax16.Scn.Fnt