Syntax10.Scn.FntInfoElemsAllocUSyntax10.Scn.FntzStampElemsAlloc7 Oct 98J#"Title": Fonts "Author": Copyright (c) ETH Zrich, 1990-95 / jg, rc, js 19.10.95 "Abstract": Fonts provides raster data for screen fonts "Keywords": Display, Font, X-Window "Version": 2.0 "From": 19.10.95 "Until":  "Changes": 13 Oct 97 RLI Access to all X-Fonts provided. Use File Font.Map to map Oberon's fonts to X-Window fonts. 23 Oct 97 RLI mapFileName is now exported (needed in PS.Mod) 06 Nov 97 RLI Bug fix (Fonts.This returned NIL instead of Fonts.Default) 11 Nov 97 RLI Improved scanning of Fontmap "Hints": Edit.Open Fonts.Text  BalloonElemsAlloc#Syntax10.Scn.Fnt"doMap" doMap is true, if the entry in the Font.Map has the keyword map at the end of the line. If it is true, mapping is done for screen fonts in the following way: Oberon -> XWindow Oberon -> XWindow 128 196 140 232 129 214 141 238 130 220 142 242 131 228 143 249 132 246 144 233 133 252 145 235 134 226 146 239 135 234 147 231 136 238 148 225 137 244 149 241 138 251 171 223 139 224 ~ Syntax10b.Scn.Fnt   '! L8FoldElemsNew8"8_8A8Syntax10i.Scn.FntfHH4"H8#Syntax10.Scn.Fntall characters i in font88#Syntax10.Scn.FntGet character metrics88#Syntax10.Scn.Fntall characters i in font88#Syntax10.Scn.Fnt$$Copy element of perChar-array to xcs88#Syntax10.Scn.Fnt Get metrics8378#Syntax10.Scn.FntSet X-graphics context888#Syntax10.Scn.Fntall characters i in font8T+c'A8#Syntax10.Scn.FntDebugging stuffXRcg818 88,a8#Syntax10.Scn.Fnt BEGIN IF ch # eCh THEN Console.Str("Error in Fontmap. "); Console.Ch(eCh); Console.Str(" expected but got "); Console.Ch(ch); Console.Ln; Console.Int(ORD(ch)); Console.Str(" # "); Console.Int(ORD(eCh)); Console.Ln END END Expect; 8u8#Syntax10.Scn.Fntii BEGIN WHILE ~r.eof & (ch # LF) & (ch # CR) DO Files.Read (r, ch) END; Files.Read(r, ch) END NextLine; 8,8#Syntax10.Scn.Fnt VAR i, len: INTEGER; BEGIN Expect("["); Files.Read(r, ch); i := 0; len := SHORT(LEN(s)); WHILE ~r.eof & (i < len) & (ch # "]") DO s[i] := ch; INC(i); Files.Read(r, ch) END; s[i] := 0X; Expect("]"); Files.Read(r, ch) END Section; 8+8#Syntax10.Scn.Fnt11 VAR dCh: CHAR; i, len: INTEGER; BEGIN dCh := ch; IF (dCh # "'") & (dCh # '"') THEN Console.Str("Error in Fontmap. Quotation marks expected"); Console.Ln; END; len := SHORT(LEN(s)); i := 0; WHILE ~r.eof & (i < len) & (ch # dCh) DO s[i] := ch; INC(i); Files.Read(r, ch) END; s[i] := 0X END String; 8)8#Syntax10.Scn.Fnt VAR i, len: INTEGER; BEGIN len := SHORT(LEN(s)); i := 0; WHILE ~r.eof & (i < len) & (ch # " ") & (ch # LF) & (ch # CR) DO s[i] := ch; INC(i); Files.Read(r, ch) END; s[i] := 0X END Name; 8@68CSyntax10.Scn.FntSyntax10i.Scn.FntQ VAR m: ARRAY 5 OF CHAR; (* can contain "map" or "" *) BEGIN IF (ch = '"') OR (ch = "'") THEN String(s) ELSE Name(s) END; Files.Read(r, ch); IF (ch = '"') OR (ch = "'") THEN String(d) ELSE Name(d) END; WHILE (ch = " ") DO Files.Read(r, ch) END; m := ""; IF CAP(ch) = "M" THEN Name(m) END; IF (ch = "'") OR (ch = '"') THEN String(m) END; Strings.Cap(m); mmap := m = "MAP" END Entry; 88#8&8  1=88~88B8%MODULE Fonts;   IMPORT Kernel, Unix, Console, X11, Display, SYSTEM, Files, Strings; CONST FontFileId = 0DBX; maxNameLen = 64; CR = 0AX; LF = 0DX; TYPE Name* = ARRAY 32 OF CHAR; Font* = POINTER TO FontDesc; FontDesc* = RECORD name*: Name; height*, minX*, maxX*, minY*, maxY*: INTEGER; raster*: Display.Font; next: Font END; VAR Default*, First: Font; nofFonts: INTEGER; mapFileName*: ARRAY 64 OF CHAR; mapFile: Files.File; Gc: X11.GC; PROCEDURE CreateGC;  BEGIN Gc := X11.CreateGC(X11.display, X11.primary, 0, 0); IF Gc = 0 THEN HALT(45) END ; X11.SetPlaneMask(X11.display, Gc, X11.planesMask); X11.SetGraphicsExposures(X11.display, Gc, X11.True); X11.SetBackground(X11.display, Gc, X11.background) END CreateGC;  PROCEDURE Cap (ch: CHAR): CHAR;  BEGIN IF (ch >= 'a') & (ch <= 'z') THEN RETURN CHR(ORD(ch) - 32) ELSE RETURN ch END END Cap;  PROCEDURE LoadXFont (name: ARRAY OF CHAR; map: BOOLEAN): Font;  VAR list, count, adr, fWidth, i: LONGINT; f: Font; raster: X11.Font; xfs: X11.FontStructPtr; xcs: X11.CharStruct; pix: X11.Pixmap; allChar: ARRAY 257 OF CHAR; BEGIN (* --- Search Font *) list := X11.ListFonts(X11.display, SYSTEM.ADR(name), 1, count); IF (list # 0) & (count = 1) THEN (* --- Load Font *) NEW(f); NEW(raster); f.raster := SYSTEM.VAL(Display.Font, raster); (* Hack to let Display.GetChar know, whether to map this font or not *) IF map THEN raster.metrics[0].dx := - 1 ELSE raster.metrics[0].dx := 0 END; COPY(name, f.name); raster.xid := X11.LoadFont(X11.display, SYSTEM.ADR(name)); X11.FreeFontNames(list); (* --- Get Font metrics *) adr := X11.QueryFont(X11.display, raster.xid); xfs := SYSTEM.VAL(X11.FontStructPtr, adr); f.height := SHORT(xfs.ascent + xfs.descent); f.minX := xfs.minBounds.width; f.maxX := xfs.maxBounds.width; f.minY := - xfs.maxBounds.descent; f.maxY := xfs.maxBounds.ascent; (* -- sum up width of Font & get character metrics*) IF xfs.perChar = NIL THEN (* fixed width font *) (* holds: minBounds = maxBounds *) fWidth := xfs.minBounds.width * (xfs.maxChar - xfs.minChar); FOR i := xfs.minChar TO xfs.maxChar DO raster.metrics[i].dx := xfs.minBounds.width; raster.metrics[i].x := xfs.minBounds.lbearing; raster.metrics[i].y := - xfs.minBounds.descent; raster.metrics[i].p.x := (i - xfs.minChar) * xfs.minBounds.width; raster.metrics[i].p.y := 0; raster.metrics[i].p.w := xfs.minBounds.rbearing - xfs.minBounds.lbearing; raster.metrics[i].p.h := xfs.minBounds.descent + xfs.minBounds.ascent;  END ELSE (* proportional font *) fWidth := 0; FOR i := xfs.minChar TO xfs.maxChar DO SYSTEM.MOVE(SYSTEM.VAL(LONGINT, xfs.perChar) + (i - xfs.minChar) * SIZE(X11.CharStruct), SYSTEM.ADR(xcs), SIZE(X11.CharStruct));  raster.metrics[i].dx := xcs.width; raster.metrics[i].x := xcs.lbearing; raster.metrics[i].y := - xcs.descent; raster.metrics[i].p.x := fWidth; raster.metrics[i].p.y := 0; raster.metrics[i].p.w := xcs.rbearing - xcs.lbearing; raster.metrics[i].p.h := xcs.descent + xcs.ascent;  fWidth := fWidth + xcs.width END END; (* --- Create one pixmap with all characters of font *) X11.SetForeground(X11.display, Gc, X11.foreground); X11.SetBackground(X11.display, Gc, X11.background); IF X11.colorClass = X11.color THEN X11.SetFunction(X11.display, Gc, X11.GXcopy) ELSE X11.SetFunction(X11.display, Gc, X11.GXequiv) END;  pix := X11.CreatePixmap(X11.display, X11.primary, fWidth, f.height, X11.depth); X11.SetFont(X11.display, Gc, raster.xid); (* -- Create string with all defined characters in it *) FOR i := xfs.minChar TO xfs.maxChar DO allChar[i - xfs.minChar] := CHR(i) END; allChar[xfs.maxChar + 1] := 0X; (* null-terminate string, just in case *) X11.DrawString(X11.display, pix, Gc, 0, 100, SYSTEM.ADR(allChar), xfs.maxChar - xfs.minChar); (* --- Set all metrics pixmap to pix *) FOR i := 0 TO 255 DO raster.metrics[i].p.pixmap := pix END; (* Console.Int(xfs.minChar); Console.Str(" to "); Console.Int(xfs.maxChar); Console.Ln; Console.Int(xfs.ascent); Console.Str(", "); Console.Int(xfs.descent); Console.Ln; Console.Int(xfs.maxBounds.width); Console.Str(", "); Console.Int(xfs.minBounds.width); Console.Ln; Console.Int(xfs.maxBounds.ascent); Console.Str(", "); Console.Int(xfs.maxBounds.descent); Console.Ln *) ELSE f := NIL END; RETURN f END LoadXFont;  PROCEDURE This* (name: ARRAY OF CHAR): Font;  TYPE RunRec = RECORD beg, end: INTEGER END; BoxRec = RECORD dx, x, y, w, h: INTEGER END; VAR F: Font; raster: X11.Font; f: Files.File; R: Files.Rider; pixmap, pixmapX, pixmapDX, pixmapW, pixmapH, RasterBase, b, n, a: LONGINT; NofRuns, NofBoxes: INTEGER; k, l, m, w, h: INTEGER; ch: CHAR; run: ARRAY 16 OF RunRec; box: ARRAY 256 OF BoxRec; list, count: LONGINT; fileName: ARRAY 255 OF CHAR; section: ARRAY 32 OF CHAR; doMap: BOOLEAN; PROCEDURE Convert (from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR; VAR map: BOOLEAN);  (** Maps font names using a fontmap file **) VAR f: Files.File; r: Files.Rider; src, dst: ARRAY 128 OF CHAR; PROCEDURE Expect (eCh: CHAR);  PROCEDURE NextLine;  PROCEDURE Section (VAR s: ARRAY OF CHAR);  PROCEDURE String (VAR s: ARRAY OF CHAR);  PROCEDURE Name (VAR s: ARRAY OF CHAR);  PROCEDURE Entry (VAR s, d: ARRAY OF CHAR; VAR mmap: BOOLEAN);  BEGIN f := mapFile; IF f # NIL THEN Files.Set (r, f, 0); Files.Read (r, ch); REPEAT IF ch = ";" THEN NextLine ELSIF ch = "[" THEN Section(section); Strings.Cap(section) ELSIF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN Entry(src, dst, map) ELSE Files.Read(r, ch) END UNTIL r.eof OR ((section = "FONTMAP") & (src = from)); IF r.eof THEN COPY (from, to) ELSE COPY (dst, to) END ELSE COPY (from, to); Console.Str("No fontmapping."); Console.Ln; END END Convert;  PROCEDURE DummyCh (m: INTEGER);  VAR raster: X11.Font; BEGIN raster := SYSTEM.VAL(X11.Font, F.raster); raster.metrics[m].dx := 0; raster.metrics[m].x := 0; raster.metrics[m].y := 0; raster.metrics[m].p.x := 0; raster.metrics[m].p.y := 0; raster.metrics[m].p.w := 0; raster.metrics[m].p.h := 0 END DummyCh;  BEGIN IF (LEN(name) > 6) & (name[0] = "O") & (name[1] = "b") & (name[2] = "e") & (name[3] = "r") & (name[4] = "o") & (name[5] = "n") THEN name[0] := "S"; name[1] := "y"; name[2] := "n"; name[3] := "t"; name[4] := "a"; name[5] := "x" END; F := First; LOOP IF F = NIL THEN EXIT END; IF name = F.name THEN EXIT END; F := F.next END; IF F = NIL THEN Convert (name, fileName, doMap); f := Files.Old(fileName); IF f = NIL THEN F := LoadXFont(fileName, doMap); IF F = NIL THEN F := Default ELSE COPY(name, F.name); F.next := First; First := F; INC(nofFonts) END ELSE Files.Set(R, f, 0); Files.Read(R, ch); IF ch = FontFileId THEN Files.Read(R, ch); (*abstraction*) Files.Read(R, ch); (*family*) Files.Read(R, ch); (*variant*) NEW(F); Files.ReadInt(R, F.height); Files.ReadInt(R, F.minX); Files.ReadInt(R, F.maxX); Files.ReadInt(R, F.minY); Files.ReadInt(R, F.maxY); Files.ReadInt(R, NofRuns); NofBoxes := 0; k := 0; WHILE k # NofRuns DO Files.ReadInt(R, run[k].beg); Files.ReadInt(R, run[k].end); NofBoxes := NofBoxes + run[k].end - run[k].beg; INC(k) END; pixmapW := 0; l := 0; WHILE l # NofBoxes DO Files.ReadInt(R, box[l].dx); Files.ReadInt(R, box[l].x); Files.ReadInt(R, box[l].y); Files.ReadInt(R, box[l].w); Files.ReadInt(R, box[l].h); pixmapW := pixmapW + (box[l].w + 7) DIV 8; INC(l) END; pixmapH := F.maxY - F.minY; NEW(raster); F.raster := SYSTEM.VAL(Display.Font, raster); SYSTEM.NEW(SYSTEM.VAL(Font, RasterBase), pixmapW * pixmapH); (* temporary *) pixmapX := 0; k := 0; l := 0; m := 0; WHILE k < NofRuns DO WHILE m < run[k].beg DO DummyCh(m); INC(m) END; WHILE m < run[k].end DO raster.metrics[m].dx := box[l].dx; raster.metrics[m].x := box[l].x; raster.metrics[m].y := box[l].y; raster.metrics[m].p.x := pixmapX; raster.metrics[m].p.y := 0; w := box[l].w; raster.metrics[m].p.w := w; h := box[l].h; raster.metrics[m].p.h := h; pixmapDX := (w + 7) DIV 8; n := pixmapDX * h; a := RasterBase + pixmapX DIV 8; b := 0; WHILE b < n DO Files.Read(R, ch); SYSTEM.PUT(a + (h - 1 - b DIV pixmapDX) * pixmapW + b MOD pixmapDX, ch); INC(b) END; INC(l); INC(m); INC(pixmapX, 8 * pixmapDX) END; INC(k) END; WHILE m < 256 DO DummyCh(m); INC(m) END; pixmap := X11.RasterToPixmap(RasterBase, 8 * pixmapW, pixmapH); m := 0; WHILE m < 256 DO raster.metrics[m].p.pixmap := pixmap; INC(m) END ; COPY(name, F.name); INC(nofFonts); F.next := First; First := F; list := X11.ListFonts(X11.display, SYSTEM.ADR(fileName), 1, count); IF (list # 0) & (count = 1) THEN raster.xid := X11.LoadFont(X11.display, SYSTEM.ADR(fileName)); X11.FreeFontNames(list) ELSE raster.xid := 0 END END END END; RETURN F END This;  PROCEDURE SetDefault;  VAR n: POINTER TO ARRAY 256 OF CHAR; BEGIN Kernel.dlsym(0, "defaultFont", SYSTEM.VAL(LONGINT, n)); ASSERT(n^ # ""); COPY(n^, mapFileName); mapFile := Files.Old(mapFileName); Default := This("Syntax10.Scn.Fnt"); IF Default = NIL THEN Console.Str("Cannot find Oberon fonts. Is the environment variable OBERON correctly set?"); Console.Ln; Unix.Exit(1) END END SetDefault;  BEGIN Console.Ln; CreateGC; First := NIL; nofFonts := 0; SetDefault;  END Fonts.