Graph2: Load Font Info

src/Dir.Mod

@@ -94,6 +94,11 @@ BEGIN
   END
 END Rewind;
 
+PROCEDURE FileExists*(name: ARRAY OF CHAR): BOOLEAN;
+VAR s: ARRAY 2048 OF SYSTEM.CHAR8;
+BEGIN Utf8.Encode(name, s)
+RETURN Platform.FileExists(s) END FileExists;
+
 PROCEDURE IsDir*(name: ARRAY OF CHAR): BOOLEAN;
 VAR s: ARRAY 2048 OF SYSTEM.CHAR8;
 BEGIN Utf8.Encode(name, s)

src/FreeOberon.Mod

@@ -1174,6 +1174,7 @@ BEGIN
   success := FALSE;
   ParseArgs(fs, sw, w, h, fnames);
   T.Settings(106, 25, {T.resizable, T.window(*, T.center*)});
+  T.Settings(240, 65, {T.resizable, T.window(*, T.center*)});
   T.SetTitle('Free Oberon');
   T.Init;
   IF T.Done THEN

src/Graph2.Mod

@@ -1,5 +1,5 @@
 MODULE Graph2;
-IMPORT Out, Al := Allegro5, Utf8, Files, Strings, SYSTEM;
+IMPORT Out, Al := Allegro5, Utf8, Files, Dir, Strings, SYSTEM;
 
 CONST
   fontPlanes = 4; (*!TODO*)
@@ -268,14 +268,16 @@ TYPE
 
   Font* = POINTER TO FontDesc;
   FontDesc* = RECORD
+    fname: ARRAY 256 OF CHAR;
     handle: PROCEDURE (font: Font; VAR msg: FontMessage);
-    draw: PROCEDURE (font: Font; VAR msg: FontDrawMsg)
+    draw: PROCEDURE (font: Font; VAR msg: FontDrawMsg);
+    loaded*: BOOLEAN
   END;
 
   MonoFont* = POINTER TO MonoFontDesc;
   MonoFontDesc* = RECORD(FontDesc)
     bmp: Bitmap;
-    charW, charH: INTEGER;
+    charW*, charH*: INTEGER;
     rows, cols: INTEGER
   END;
 
@@ -1254,9 +1256,54 @@ BEGIN m := f(MonoFont)
   (*!TODO*)
 END MonoFontHandle;
 
-PROCEDURE LoadFont*(fname: ARRAY OF CHAR): Font;
-VAR f: MonoFont;
-  bmp: Bitmap;
+PROCEDURE ReadWord(VAR r: Files.Rider; VAR s: ARRAY OF CHAR);
+VAR ch: CHAR;
+  i: INTEGER;
+BEGIN
+  Files.ReadChar(r, ch);
+  WHILE ~r.eof & (ch <= ' ') DO Files.ReadChar(r, ch) END;
+
+  i := 0;
+  WHILE ~r.eof & (ch > ' ') DO
+    IF (i # LEN(s) - 1) THEN s[i] := ch; INC(i) END;
+    Files.ReadChar(r, ch)
+  END;
+  s[i] := 0X
+END ReadWord;
+
+PROCEDURE ReadInt(VAR r: Files.Rider; VAR n: INTEGER);
+VAR ch: CHAR;
+  i: INTEGER;
+BEGIN
+  Files.ReadChar(r, ch);
+  WHILE ~r.eof & (ch <= ' ') DO Files.ReadChar(r, ch) END;
+
+  n := 0;
+  WHILE ~r.eof & ('0' <= ch) & (ch <= '9') DO
+    n := n * 10 + ORD(ch) - ORD('0');
+    Files.ReadChar(r, ch)
+  END
+END ReadInt;
+
+PROCEDURE ReadFontInfo(VAR r: Files.Rider): Font;
+VAR f: Font;
+  mf: MonoFont;
+  s: ARRAY 4096 OF CHAR;
+BEGIN f := NIL;
+  ReadWord(r, s);
+  IF s = 'mono' THEN
+    NEW(mf); mf.bmp := NIL;
+    ReadInt(r, mf.charW); ReadInt(r, mf.charH);
+    IF (mf.charW > 0) & (mf.charH > 0) THEN
+      mf.cols := 16; mf.rows := 16 * fontPlanes
+    ELSE mf := NIL
+    END;
+    f := mf
+  END
+RETURN f END ReadFontInfo;
+
+PROCEDURE LoadFontInfo*(fname: ARRAY OF CHAR): Font;
+VAR f: Font;
   F: Files.File;
   r: Files.Rider;
   s: ARRAY 4096 OF CHAR;
@@ -1264,17 +1311,32 @@ BEGIN f := NIL;
   s := fname; Strings.Append('.ofi', s);
   F := Files.Old(s);
   IF F # NIL THEN
-    Files.Close(F); (*!TODO*)
     s := fname; Strings.Append('.png', s);
-    bmp := LoadBitmap(s);
-    IF bmp # NIL THEN
-      NEW(f); f.bmp := bmp;
-      f.cols := 16; f.rows := 16 * fontPlanes;
-      f.charW := bmp.w DIV f.cols; f.charH := bmp.h DIV f.rows;
-      f.draw := MonoFontDraw;
-      f.handle := MonoFontHandle
+    IF Dir.FileExists(s) THEN
+      Files.Set(r, F, 0);
+      f := ReadFontInfo(r);
+      IF f # NIL THEN
+        f.loaded := FALSE;
+        f.fname := fname;
+        f.draw := MonoFontDraw;
+        f.handle := MonoFontHandle
+      END
     END
   END
+RETURN f END LoadFontInfo;
+
+PROCEDURE LoadFontBitmap*(f: Font);
+VAR s: ARRAY 4096 OF CHAR;
+BEGIN
+  s := ''; Strings.Append(f.fname, s); Strings.Append('.png', s);
+  f(MonoFont).bmp := LoadBitmap(s);
+  IF f(MonoFont).bmp # NIL THEN f.loaded := TRUE END
+END LoadFontBitmap;
+
+PROCEDURE LoadFont*(fname: ARRAY OF CHAR): Font;
+VAR f: Font;
+BEGIN f := LoadFontInfo(fname);
+  IF f # NIL THEN LoadFontBitmap(f) END
 RETURN f END LoadFont;
 
 (* Clipboard *)
@@ -1399,6 +1461,14 @@ BEGIN
   ResetDefaults
 END Close;
 
+PROCEDURE Diagnose*;
+VAR n: INTEGER;
+BEGIN
+  Out.String('Graph2 DIAGNOSE'); Out.Ln;
+  n := Al.get_display_option(screen.display, Al.renderMethod);
+  Out.String('  renderMethod = '); Out.Int(n, 0); Out.Ln;
+END Diagnose;
+
 BEGIN Done := FALSE;
   MakeCol(black, 0, 0, 0);
   ResetDefaults

src/OV.Mod

@@ -2530,6 +2530,7 @@ BEGIN
     ELSIF E.type = T.quit THEN app.quit := TRUE
     END;
     IF app.needRedraw THEN DrawApp(app); T.Flush END
+    ;T.Diagnose;;;;;;
   UNTIL app.quit
 END RunApp;
 

src/TermBox.Mod

@@ -386,7 +386,7 @@ BEGIN
     fg := cell.fg; bg := cell.bg
   ELSE fg := InvertColor(cell.fg); bg := InvertColor(cell.bg)
   END;
-  G.GetMonoFontSize(font, w, h); X := x * w; Y := y * h;
+  w := font.charW; h := font.charH; X := x * w; Y := y * h;
   G.FillRect(X, Y, X + w - 1, Y + h - 1, colors[bg MOD nofcolors]);
   G.DrawChar(cell.ch, X, Y, font, colors[fg MOD nofcolors]);
   IF cursorShown & (x = curX) & (y = curY) THEN
@@ -395,9 +395,8 @@ BEGIN
 END DrawCell;
 
 PROCEDURE GetMousePos(e: G.Event; VAR x, y: INTEGER);
-VAR fw, fh: INTEGER;
-BEGIN G.GetMonoFontSize(font, fw, fh);
-  x := e.x DIV fw; y := e.y DIV fh;
+BEGIN
+  x := e.x DIV font.charW; y := e.y DIV font.charH;
   IF x < 0 THEN x := 0 ELSIF x >= buffer.w THEN x := buffer.w - 1 END;
   IF y < 0 THEN y := 0 ELSIF y >= buffer.h THEN y := buffer.h - 1 END
 END GetMousePos;
@@ -516,9 +515,9 @@ BEGIN p.redraw := TRUE;
 END ResizePart;
 
 PROCEDURE InitBuffer;
-VAR W, H, fw, fh: INTEGER;
-BEGIN G.GetScreenSize(W, H); G.GetMonoFontSize(font, fw, fh);
-  buffer.w := W DIV fw; buffer.h := H DIV fh;
+VAR W, H: INTEGER;
+BEGIN G.GetScreenSize(W, H);
+  buffer.w := W DIV font.charW; buffer.h := H DIV font.charH;
   IF buffer.w > partW THEN buffer.w := partW END; (*!FIXME*)
   IF buffer.h > partH THEN buffer.h := partH END;
   buffer.first := NewPart(buffer.w, buffer.h);
@@ -526,9 +525,9 @@ BEGIN G.GetScreenSize(W, H); G.GetMonoFontSize(font, fw, fh);
 END InitBuffer;
 
 PROCEDURE ResizeBuffer;
-VAR W, H, fw, fh, nw, nh: INTEGER;
-BEGIN G.GetScreenSize(W, H); G.GetMonoFontSize(font, fw, fh);
-  nw := W DIV fw; nh := H DIV fh;
+VAR W, H, nw, nh: INTEGER;
+BEGIN G.GetScreenSize(W, H);
+  nw := W DIV font.charW; nh := H DIV font.charH;
   IF nw > partW THEN nw := partW END; (*!FIXME*)
   IF nh > partH THEN nh := partH END;
   IF (nw # buffer.w) OR (nh # buffer.h) THEN
@@ -585,8 +584,8 @@ BEGIN
       event.mod := e.mod
     END
   ELSIF e.type = G.resize THEN
-    event.type := resize; G.GetMonoFontSize(font, fw, fh);
-    event.w := e.w DIV fw; event.h := e.h DIV fh;
+    event.type := resize;
+    event.w := e.w DIV font.charW; event.h := e.h DIV font.charH;
     ResizeBuffer;
     Sync
   ELSIF e.type = G.quit THEN event.type := quit
@@ -728,10 +727,10 @@ BEGIN
   G.Close
 END Close;
 
-PROCEDURE LoadFont(): BOOLEAN;
+PROCEDURE PreloadFont(): BOOLEAN;
 VAR f: G.Font;
 BEGIN
-  f := G.LoadFont(fontFile);
+  f := G.LoadFontInfo(fontFile);
   IF f # NIL THEN 
     IF f IS G.MonoFont THEN font := f(G.MonoFont)
     ELSE Out.String('The font is not monospaced.'); Out.Ln
@@ -739,7 +738,7 @@ BEGIN
   ELSE Out.String('Could not load font "');
     Out.String(fontFile); Out.String('".'); Out.Ln
   END
-RETURN font # NIL END LoadFont;
+RETURN font # NIL END PreloadFont;
 
 PROCEDURE ExpandColor(color: INTEGER; VAR r, g, b: INTEGER);
 BEGIN
@@ -814,9 +813,9 @@ BEGIN
 END InitIcon;
 
 PROCEDURE InitScreen;
-VAR W, H, dw, dh, fw, fh: INTEGER;
-BEGIN G.GetMonoFontSize(font, fw, fh); G.GetDesktopResolution(dw, dh);
-  W := wantW * fw; H := wantH * fh;
+VAR W, H, dw, dh: INTEGER;
+BEGIN G.GetDesktopResolution(dw, dh);
+  W := wantW * font.charW; H := wantH * font.charH;
 
   IF (wantScaleX # 0.0) & (wantScaleY # 0.0) THEN
     G.SetScale(wantScaleX, wantScaleY)
@@ -825,7 +824,7 @@ BEGIN G.GetMonoFontSize(font, fw, fh); G.GetDesktopResolution(dw, dh);
     G.SetScale(5/6, 1.0)
   END;
 
-  G.SetSizeStep(fw, fh);
+  G.SetSizeStep(font.charW, font.charH);
   screen := G.NewWindow(-1, -1, W, H, wantTitle, MakeGraphSettings());
   G.ShowMouse(noMouse IN settings);
   G.SetWindowFullscreenSize(screen, W, H);
@@ -854,17 +853,21 @@ BEGIN Done := FALSE;
   IF noMouse IN settings THEN opt := {G.noMouse} ELSE opt := {} END;
   G.Settings(-1, -1, opt + {G.manual});
   G.Init;
-  IF G.Done & LoadFont() THEN
+  IF G.Done & PreloadFont() THEN
     InitScreen;
-    InitColors;
-    InitBuffer;
-    InitTimers;
-    mouseDown := FALSE;
-    mouseShown := ~(noMouse IN settings);
-    skipEnter := FALSE;
-    needFlip := 0;
-    processingEvent := FALSE;
-    Done := TRUE
+    G.LoadFontBitmap(font);
+    IF font.loaded THEN
+      InitColors;
+      InitBuffer;
+      InitTimers;
+      mouseDown := FALSE;
+      mouseShown := ~(noMouse IN settings);
+      skipEnter := FALSE;
+      needFlip := 0;
+      processingEvent := FALSE;
+      Done := TRUE
+    ELSE G.CloseWindow(screen)
+    END
   END
 END Init;
 
@@ -890,6 +893,10 @@ PROCEDURE SetFontFile*(s: ARRAY OF CHAR);
 BEGIN fontFile := s
 END SetFontFile;
 
+PROCEDURE Diagnose*;
+BEGIN G.Diagnose
+END Diagnose;
+
 BEGIN wantW := stdW; wantH := stdH; wantScaleX := 0.0; wantScaleY := 0.0;
   settings := {fullscreen}; Done := FALSE;
   iconFile := 'Data/Images/Icon.png';