Syntax10.Scn.FntSyntax10i.Scn.FntO      l$".   W+"{-e- &-Nd:Syntax10b.Scn.FntZF5)(R B=0  ]ParcElemsAlloc.  #Courier10.Scn.Fnt6lw6;.MODULE FontComp; (* MH *) (* Converts Oberon Fonts to Windows Raster Fonts; see docu at end of module *) IMPORT Log, S := SYSTEM, Oberon, Texts, Files; CONST Version- = "Ver 1.1 (MH Oct 7 1993)"; FontFileId = 0DBX; SPC = 20X; normal = 0; italic = 1; bold = 2; medium = 3; (* style *) TYPE FontInfo = RECORD (* Version 2.0 *) version: INTEGER; size: LONGINT; copyright: ARRAY 60 OF CHAR; type: INTEGER; points: INTEGER; vertRes, horizRes: INTEGER; ascent: INTEGER; internalLeading, externalLeading: INTEGER; italic, underline, strikeOut: CHAR; weight: INTEGER; charSet: CHAR; pixWidth, pixHeight: INTEGER; pitchAndFamily: CHAR; avgWidth, maxWidth: INTEGER; firstChar, lastChar, defaultChar, breakChar: CHAR; widthBytes: INTEGER; device: LONGINT; face: LONGINT; bitsPointer: LONGINT; bitsOffset: LONGINT; res: CHAR; END ; CharEntry = RECORD width: INTEGER; offs: INTEGER; END ; VAR Info: FontInfo; CharTab: ARRAY 257 OF CharEntry; (* one dummy entry at the end *) PowTwo: ARRAY 9 OF INTEGER; (* 2^0 .. 2^8 *) PROCEDURE Do (VAR R, out: Files.Rider; face: ARRAY OF CHAR; size: INTEGER; style: INTEGER; res: INTEGER); CONST True = 1X; False = 0X; TYPE RunRec = RECORD beg, end: INTEGER END ; BoxRec = RECORD dx, x, y, w, h: INTEGER END ; VAR height, minX, maxX, minY, maxY, maxDX: INTEGER; NofRuns, NofBoxes: INTEGER; i, j, k, l, m, n, r, dx, x, y, w, h: INTEGER; ascii: INTEGER; run: ARRAY 16 OF RunRec; box: ARRAY 256 OF BoxRec; ch, raster: CHAR; map: POINTER TO ARRAY OF ARRAY OF CHAR; (* raster font bitmap *) bitmapH: INTEGER; (* height of map in pixels *) bitmapW: INTEGER; (* width of map in bytes *) bitmapX: INTEGER; (* current offset in map from left, in bytes *) charW: INTEGER; bitY, bitX: INTEGER; fix: Files.Rider; sizePos, facePos, bitsPos, mapPos: LONGINT; (* fixup positions in output file *) BEGIN Info.version := 200H; (* Version 2.0 *) Info.copyright := "Copyright (c) ETH Zuerich, Switzerland"; Info.type := 0; Info.device := 0; Info.bitsPointer := 0; Files.Read(R, ch); Files.Read(R, ch); Files.Read(R, ch); (* abstraction, family, variant *) Files.ReadInt(R, height); (* line spacing *) Files.ReadInt(R, minX); Files.ReadInt(R, maxX); Files.ReadInt(R, minY); Files.ReadInt(R, maxY); bitmapH := maxY - minY; Info.points := size; Info.vertRes := res; Info.horizRes := res; Info.ascent := maxY; Info.internalLeading := 0; Info.externalLeading := height - (maxY - minY); IF style = italic THEN Info.italic := True ELSE Info.italic := False END ; Info.underline := False; Info.strikeOut := False; IF style = bold THEN Info.weight := 700 ELSIF style = medium THEN Info.weight := 600 ELSE Info.weight := 400 END ; Info.charSet := 0X; (* ANSI_CHARSET *) Info.pixWidth := 0; (* proportional raster font *) Info.pixHeight := bitmapH; (* height of map *) Info.pitchAndFamily := CHR(1 (* variable pitch *) + 0 (* FF_DONTCARE *)); k := 0; WHILE k < 257 DO CharTab[k].width := 0; CharTab[k].offs := 0; INC(k) END ; Files.ReadInt(R, NofRuns); NofBoxes := 0; r := 0; WHILE r # NofRuns DO Files.ReadInt(R, run[r].beg); Files.ReadInt(R, run[r].end); NofBoxes := NofBoxes + run[r].end - run[r].beg; INC(r) END ; Info.firstChar := 0X; Info.lastChar := 0FFX; Info.defaultChar := SPC; Info.breakChar := SPC; l := 0; maxDX := MIN(INTEGER); bitmapW := 0; WHILE l # NofBoxes DO Files.ReadInt(R, dx); box[l].dx := dx; IF maxDX < dx THEN maxDX := dx END ; bitmapW := bitmapW + (dx + 7) DIV 8; Files.ReadInt(R, box[l].x); Files.ReadInt(R, box[l].y); Files.ReadInt(R, box[l].w); Files.ReadInt(R, box[l].h); INC(l) END ; bitmapW := bitmapW +1 (*dummy character CharTab[256]*) + (-bitmapW) MOD 2; (* bitmap width must be even *) Info.widthBytes := bitmapW; Info.maxWidth := maxDX; Info.avgWidth := Info.maxWidth; (* patched with width of letter X later *) NEW(map, bitmapH, bitmapW); FOR i := 0 TO bitmapH - 1 DO FOR j := 0 TO bitmapW - 1 DO map[i, j] := 0X END ; END ; r := 0; l := 0; m := 0; bitmapX := 0; ascii := 0; WHILE r < NofRuns DO m := run[r].beg; (* fill in the gap between runs *) WHILE ascii < m DO CharTab[ascii].width := 0; CharTab[ascii].offs := bitmapX * bitmapH; INC(ascii) END ; WHILE m < run[r].end DO dx := box[l].dx; x := box[l].x; y := box[l].y; w := box[l].w; h := box[l].h; CharTab[ascii].width := dx; IF ascii = ORD("X") THEN Info.avgWidth := dx END ; CharTab[ascii].offs := bitmapX * bitmapH; charW := (dx + 7) DIV 8; (* width of Windows character box in bytes *) i := 0; n := (w + 7) DIV 8; WHILE i < h DO j := 0; bitY := bitmapH - (-minY + y + i) - 1; (* y coord of bit in Windows character box *) WHILE j < n DO Files.Read(R, raster); k := 0; WHILE k < 8 DO IF (j*8 + k) < w THEN IF ODD(ORD(raster) DIV PowTwo[k]) THEN (* bit k is set *) bitX := -minX + x + j*8 + k; (* x coord of bit in Windows character box *) ch := map[bitY, bitmapX + (bitX DIV 8)]; ch := CHR(ORD(ch) + PowTwo[7 - (bitX MOD 8)]); map[bitY, bitmapX + (bitX DIV 8)] := ch; END ; END ; INC(k); END ; INC(j); END ; INC(i); END ; INC(bitmapX, charW); INC(l); INC(m); INC(ascii); END ; INC(r) END ; WHILE ascii < 256 DO CharTab[ascii].width := 0; CharTab[ascii].offs := bitmapX*bitmapH; INC(ascii) END ; CharTab[256].width := 8; CharTab[256].offs := (bitmapW-1)*bitmapH; (* dummy entry *) (* write Windows font file *) Files.WriteInt(out, Info.version); sizePos := Files.Pos(out); Files.WriteLInt(out, Info.size); Files.WriteBytes(out, Info.copyright, 60); Files.WriteInt(out, Info.type); Files.WriteInt(out, Info.points); Files.WriteInt(out, Info.vertRes); Files.WriteInt(out, Info.horizRes); Files.WriteInt(out, Info.ascent); Files.WriteInt(out, Info.internalLeading); Files.WriteInt(out, Info.externalLeading); Files.Write(out, Info.italic); Files.Write(out, Info.underline); Files.Write(out, Info.strikeOut); Files.WriteInt(out, Info.weight); Files.Write(out, Info.charSet); Files.WriteInt(out, Info.pixWidth); Files.WriteInt(out, Info.pixHeight); Files.Write(out, Info.pitchAndFamily); Files.WriteInt(out, Info.avgWidth); Files.WriteInt(out, Info.maxWidth); Files.Write(out, Info.firstChar); Files.Write(out, Info.lastChar); Files.Write(out, Info.defaultChar); Files.Write(out, Info.breakChar); Files.WriteInt(out, Info.widthBytes); Files.WriteLInt(out, Info.device); facePos := Files.Pos(out); Files.WriteLInt(out, Info.face); Files.WriteLInt(out, Info.bitsPointer); bitsPos := Files.Pos(out); Files.WriteLInt(out, Info.bitsOffset); Files.Write(out, Info.res); mapPos := Files.Pos(out) + 257*SIZE(CharEntry); FOR i := 0 TO 256 DO Files.WriteInt(out, CharTab[i].width); Files.WriteInt(out, SHORT(CharTab[i].offs + mapPos)); END ; (* character bitmaps *) Files.Set(fix, Files.Base(out), bitsPos); Files.WriteLInt(fix, Files.Pos(out)); FOR i := 0 TO Info.widthBytes - 1 DO FOR j := 0 TO Info.pixHeight - 1 DO Files.Write(out, map[j, i]) END ; END ; Files.Set(fix, Files.Base(out), facePos); Files.WriteLInt(fix, Files.Pos(out)); i := 0; WHILE face[i] # 0X DO Files.Write(out, face[i]); INC(i) END ; Files.Write(out, 0X); Files.Set(fix, Files.Base(out), sizePos); Files.WriteLInt(fix, Files.Pos(out)); END Do; PROCEDURE ParseName (VAR name, faceName: ARRAY OF CHAR; VAR res, size, style: INTEGER); VAR i, j: INTEGER; fonttype: ARRAY 6 OF CHAR; BEGIN (* face name in Windows raster font is Oberon font name *) COPY(name, faceName); i := 0; WHILE ("A" <= CAP(name[i])) & (CAP(name[i]) <= "Z") DO INC(i) END ; size := 0; IF ("0" <= name[i]) & (name[i] <= "9") THEN size := ORD(name[i]) - ORD("0"); INC(i); IF ("0" <= name[i]) & (name[i] <= "9") THEN size := 10*size + ORD(name[i]) - ORD("0"); INC(i); END ; END ; style := normal; IF ("A" <= CAP(name[i])) & (CAP(name[i]) <= "Z") THEN CASE CAP(name[i]) OF | "I": style := italic; | "B": style := bold; | "M": style := medium; ELSE style := normal; END ; INC(i); END ; j := 0; WHILE j < 4 DO fonttype[j] := name[i]; INC(j); INC(i) END ; fonttype[4] := 0X; IF fonttype = ".Scn" THEN res := 96; ELSIF fonttype = ".Pr3" THEN res := 300; ELSE HALT(100) END ; END ParseName; PROCEDURE Convert*; (** { OberonFontFile => [Path]WindowsFontFile } ~ **) VAR F, f: Files.File; R, r: Files.Rider; i, size, res, style: INTEGER; ch: CHAR; face, oname, wname: ARRAY 64 OF CHAR; S: Texts.Scanner; text: Texts.Text; beg, end, time: LONGINT; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time); IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END ; END ; LOOP IF S.class # Texts.Name THEN EXIT END ; COPY(S.s, oname); Texts.Scan(S); IF (S.class # Texts.Char) OR (S.c # "=") THEN EXIT END ; Texts.Scan(S); IF (S.class # Texts.Char) OR (S.c # ">") THEN EXIT END ; Texts.Scan(S); IF S.class # Texts.Name THEN EXIT END ; COPY(S.s, wname); ParseName(oname, face, res, size, style); Log.Str(face); F := Files.Old(oname); IF F # NIL THEN Files.Set(R, F, 0); Files.Read(R, ch); IF ch = FontFileId THEN f := Files.New(wname); IF f # NIL THEN Log.Str(" => "); Files.Set(r, f, 0); Do(R, r, face, size, style, res); Files.Register(f); Log.Str(wname); Log.Ln; END ELSE Log.Str(" not a font"); Log.Ln; END ; Files.Close(F) ELSE Log.Str(" not found"); Log.Ln; END ; Texts.Scan(S) END END Convert; BEGIN Log.Str("Oberon to Windows Font Conversion Utility "); Log.Str(Version); Log.Ln; PowTwo[0] := 1; PowTwo[1] := 2; PowTwo[2] := 4; PowTwo[3] := 8; PowTwo[4] := 16; PowTwo[5] := 32; PowTwo[6] := 64; PowTwo[7] := 128; PowTwo[8] := 256; END FontComp. FontComp.Convert Compiles an Oberon screen font to the Windows .FNT font format (version 2.0). The Windows .FNT file format is documented in the Microsoft Windows Programmer's Reference, Vol. 4, Chapter 4: Font File Format. The generated .FNT font files must be compiled to .FON resources under Windows 3.1 Syntax: FontComp.Convert { OberonFontFile => [Path]WindowsFontFile } ~ Example: FontComp.Convert Syntax8.Scn.Fnt => c:\fonts\&Synta8.Fnt ~ Naming Convention: The name of a .FNT file consists of 4 parts: NNNNNSSF.FNT where  NNNNN first five letters of font family name (e.g. Synta for Syntax, Math for Math) SS maximum two digits for font size F optional character for face style (b = bold, i = italics, m = medium) .FNT standard name extension This naming convention is hard-coded into module Fonts. It allows module Fonts to search for Windows font resources belonging to an Oberon font. Further information about converting Oberon fonts to .FON resources Makefile to convert the .FNT files to .FON resources: ------------------------------------------------------ # Makefile for creating font ressource # MH 20.10.1993 # Syntax: nmake FONT= # Example: nmake FONT=Synta10 target: $(FONT).FON font.rc: type <