MODULE WMDefaultFont;	 (** AUTHOR "TF"; PURPOSE "Embedded Oberon font"; *)
(* this font is used on diskless devices *)
IMPORT
	KernelLog, Streams, Graphics := WMGraphics, Raster;

TYPE
	Glyph = RECORD
		img : Graphics.Image;
		available : BOOLEAN;
		dx, x, y, w, h : LONGINT;
	END;

	Font = OBJECT(Graphics.Font)
	VAR glyphs : ARRAY 256 OF Glyph;
		placeholderimg : Graphics.Image;
		height : LONGINT;

		PROCEDURE &Init*;
		VAR mode : Raster.Mode; pix : Raster.Pixel;
		BEGIN
			Init^;
			NEW(placeholderimg); Raster.Create(placeholderimg, 16, 16, Raster.A1);
			Raster.InitMode(mode, Raster.srcCopy);
			Raster.SetRGBA(pix, 0, 0, 0, 0);
			Raster.Fill(placeholderimg, 0, 0, 15, 15, pix, mode)
		END Init;

		(* map unicode to oberon *)
		PROCEDURE MapChars(VAR ch : LONGINT);
		BEGIN

			CASE ch OF
				0C4H :	 ch := 128;
			|	0D6H :	 ch := 129;
			|	0DCH :	 ch := 130;
			|	0E4H :	 ch := 131;
			|	0F6H :	 ch := 132;
			|	0FCH :	 ch := 133;
			|	0E2H :	 ch := 134;
			|	0EAH :	 ch := 135;
			|	0EEH :	 ch := 136;
			|	0F4H :	 ch := 137;
			|	0FBH :	 ch := 138;
			|	0E0H :	 ch := 139;
			|	0E8H :	 ch := 140;
			|	0ECH :	 ch := 141;
			|	0F2H :	 ch := 142;
			|	0F9H :	 ch := 143;
			|	0E9H :	 ch := 144;
			|	0EBH :	 ch := 145;
			|	0EFH :	 ch := 146;
			|	0E7H :	 ch := 147;
			|	0E1H :	 ch := 148;
			|	0F1H :	 ch := 149;
			|	0DFH :	 ch := 150;
			|	0A3H :	 ch := 151;
			|	0B6H :	 ch := 152;
			|	0C7H :	 ch := 153;
			ELSE
				IF ch = 2030H THEN ch := 154
				ELSIF ch = 2013H THEN ch := 155
				END
			END;

		END MapChars;

		PROCEDURE HasChar*(code : LONGINT) : BOOLEAN;
		BEGIN
			MapChars(code);
			RETURN (code >= 0) & (code < 256) & (glyphs[code].available)
		END HasChar;

		PROCEDURE GetGlyphMap*(code : LONGINT; VAR map : Graphics.Image);
		BEGIN
			MapChars(code);
			IF (code >= 0) & (code < 256) & (glyphs[code].available) & (glyphs[code].img # NIL) THEN
				map := glyphs[code].img
			ELSE map := placeholderimg
			END
		END GetGlyphMap;

		PROCEDURE GetGlyphSpacings*(code : LONGINT; VAR glyphSpacings : Graphics.GlyphSpacings);
		BEGIN
			MapChars(code);
			IF (code >= 0) & (code < 256) & (glyphs[code].available) THEN
				glyphSpacings.width := glyphs[code].w;
				glyphSpacings.bearing.l := glyphs[code].x;
				glyphSpacings.bearing.r := glyphs[code].dx - (glyphs[code].w + glyphs[code].x);

				glyphSpacings.height := glyphs[code].h;
				glyphSpacings.dy := ascent - glyphs[code].h - glyphs[code].y
			ELSE glyphSpacings.width := 3; glyphSpacings.height := 15; glyphSpacings.ascent := 16;
			END
		END GetGlyphSpacings;
	END Font;

VAR
	bit: ARRAY 100H, 8 OF BOOLEAN;	(* Bit[b, i] means bit i in byte b is set *)
	buffer: ARRAY 2500 OF CHAR;
	nof : LONGINT;
	f : Font;

PROCEDURE LoadDefaultFont*() : Font;
VAR r : Streams.StringReader;
BEGIN
	IF f = NIL THEN
		NEW(r, 2500);
		r.SetRaw(buffer, 0, 2500);
		f := StreamLoad(r)
	END;
	RETURN f
END LoadDefaultFont;

PROCEDURE StreamLoad(r : Streams.Reader) : Font;
VAR
	font : Font;
	famch, varch, idch, typech, ch : CHAR;
	t, height, minX, maxX, minY, maxY, nofRuns, rbeg, rend : INTEGER;

	runs : ARRAY 32 OF RECORD beg, end : LONGINT END;

	nofGlyphs, i, j, run, bits, b, pos, xw : LONGINT;
	p1 : Raster.Pixel;
	mode : Raster.Mode;

BEGIN
	Raster.SetRGBA(p1, 255, 0, 0, 255);
	Raster.InitMode(mode, Raster.srcCopy);

	NEW(font);
	r.Char(idch); (* id *)
	r.Char(typech); (* metric or font *)
	r.Char(famch); (* family *)
	r.Char(varch); (* variant *)
	r.RawInt(height);
	r.RawInt(minX);
	r.RawInt(maxX);
	r.RawInt(minY);
	r.RawInt(maxY);
	r.RawInt(nofRuns);
	font.ascent := maxY; font.descent := -minY;

	nofGlyphs := 0; i := 0;
	WHILE i < nofRuns DO
		r.RawInt(rbeg); runs[i].beg := rbeg;
		r.RawInt(rend); runs[i].end := rend;
		nofGlyphs := nofGlyphs + rend - rbeg;
		INC(i)
	END;

	run := 0;
	i := runs[run].beg;
	FOR j := 0 TO nofGlyphs  - 1 DO
		r.RawInt(t); font.glyphs[i].dx := t;
		r.RawInt(t); font.glyphs[i].x := t;
		r.RawInt(t); font.glyphs[i].y := t;
		r.RawInt(t); font.glyphs[i].w := t;
		r.RawInt(t); font.glyphs[i].h := t;
		font.glyphs[i].available := TRUE;
		INC(i);
		IF i >= runs[run].end THEN INC(run); i := runs[run].beg END
	END;

	FOR i := 0 TO 255 DO
		IF font.glyphs[i].available THEN
			xw := ((font.glyphs[i].w + 7) DIV 8) * 8;
			j := xw * font.glyphs[i].h DIV 8;
			IF xw *  font.glyphs[i].h > 0 THEN
				NEW(font.glyphs[i].img); Raster.Create(font.glyphs[i].img, xw, font.glyphs[i].h, Raster.A1);
				pos := 0;
				WHILE j > 0 DO
					r.Char(ch); bits := ORD(ch); DEC(j);
					FOR b := 0 TO 7 DO
						IF bit[ORD(ch), b]  THEN
							Raster.Put(font.glyphs[i].img, pos MOD xw, font.glyphs[i].h - pos DIV xw - 1, p1, mode);
						ELSE
						END;
						INC(pos)
					END
				END
			END
		END
	END;
	RETURN font
END StreamLoad;

PROCEDURE InitBitTable;
VAR b, i: LONGINT;
BEGIN
	FOR b := 0 TO 0FFH DO
		FOR i := 0 TO 7 DO
			bit[b, i] := ODD(ASH(b, -i))
		END
	END
END InitBitTable;

PROCEDURE A(hv :HUGEINT);
VAR v: LONGINT;
BEGIN
	v := SHORT(hv);
	buffer[nof] := CHR(v MOD 100H); INC(nof);
	buffer[nof] := CHR(v DIV 100H MOD 100H); INC(nof);
	buffer[nof] := CHR(v DIV 10000H MOD 100H); INC(nof);
	buffer[nof] := CHR(v DIV 1000000H); INC(nof);
END A;

PROCEDURE DefaultFont;
BEGIN
	A(0005300DBH); A(00000000CH); A(0FFFD000AH); A(000060009H); A(000010000H); A(0000A0009H);
	A(0007F001AH); A(000970080H); A(0009C009BH); A(000A0009FH); A(000010008H); A(000060000H);
	A(0000C0009H); A(00H); A(00H); A(000020008H); A(000050000H); A(000080009H);
	A(000000002H); A(000090005H); A(000010008H); A(000060000H); A(000080006H); A(000000001H);
	A(000060006H); A(000010008H); A(000050000H); A(000080009H); A(000000001H); A(000090005H);
	A(000000003H); A(00H); A(000040000H); A(000000002H); A(000080001H); A(000010005H);
	A(000030005H); A(000070003H); A(000000001H); A(000080005H); A(000000006H); A(00005FFFFH);
	A(00008000AH); A(000000001H); A(000080006H); A(000000006H); A(000050000H); A(000030008H);
	A(000050001H); A(000030001H); A(000010004H); A(00003FFFEH); A(00004000BH); A(0FFFE0000H);
	A(0000B0003H); A(000010006H); A(000050001H); A(000060005H); A(000010001H); A(000050005H);
	A(000010003H); A(00001FFFEH); A(000060004H); A(000030001H); A(000010005H); A(000010003H);
	A(000010000H); A(000060002H); A(000000001H); A(000080004H); A(000000006H); A(000050000H);
	A(000060008H); A(000000001H); A(000080003H); A(000010006H); A(000050000H); A(000060008H);
	A(000000001H); A(000080004H); A(000000006H); A(000060000H); A(000060008H); A(000000001H);
	A(000080004H); A(000000006H); A(000050000H); A(000060008H); A(00H); A(000080005H);
	A(000000006H); A(000050000H); A(000060008H); A(00H); A(000080005H); A(000010003H);
	A(000010000H); A(000030006H); A(0FFFE0001H); A(000080001H); A(000000006H); A(000060000H);
	A(000060006H); A(000020001H); A(000030005H); A(000000006H); A(000060000H); A(000050006H);
	A(000000001H); A(000080004H); A(00001000AH); A(00008FFFEH); A(00007000AH); A(00H);
	A(000080007H); A(000010007H); A(000050000H); A(000060008H); A(000000001H); A(000080005H);
	A(000010008H); A(000060000H); A(000060008H); A(000000001H); A(000080004H); A(000010005H);
	A(000040000H); A(000070008H); A(00H); A(000080006H); A(000010007H); A(000050000H);
	A(000030008H); A(000000001H); A(000080001H); A(000000003H); A(000020000H); A(000060008H);
	A(000000001H); A(000080005H); A(000010005H); A(000040000H); A(000090008H); A(00H);
	A(000080009H); A(000010008H); A(000060000H); A(000090008H); A(000000001H); A(000080007H);
	A(000010006H); A(000050000H); A(000090008H); A(0FFFE0001H); A(0000A0007H); A(000010007H);
	A(000050000H); A(000060008H); A(000000001H); A(000080004H); A(000000005H); A(000050000H);
	A(000070008H); A(000000001H); A(000080005H); A(000000006H); A(000060000H); A(0000A0008H);
	A(00H); A(00008000AH); A(000010007H); A(000050000H); A(000050008H); A(00H);
	A(000080005H); A(000010006H); A(000040000H); A(000040008H); A(0FFFE0001H); A(0000B0003H);
	A(000010006H); A(00004FFFFH); A(000040008H); A(0FFFE0000H); A(0000B0003H); A(000010006H);
	A(000050000H); A(000030007H); A(000030000H); A(000010003H); A(000010005H); A(000020007H);
	A(000060002H); A(000000001H); A(000060004H); A(000010006H); A(000040000H); A(000050009H);
	A(000000001H); A(000060004H); A(000010006H); A(000040000H); A(000060009H); A(000000001H);
	A(000060004H); A(000000003H); A(000030000H); A(000060009H); A(0FFFD0001H); A(000090005H);
	A(000010006H); A(000040000H); A(000030009H); A(000000001H); A(000080001H); A(000000003H);
	A(00002FFFDH); A(00005000BH); A(000000001H); A(000090004H); A(000010003H); A(000010000H);
	A(000090009H); A(000000001H); A(000060007H); A(000010006H); A(000040000H); A(000060006H);
	A(000000001H); A(000060004H); A(000010006H); A(00004FFFDH); A(000060009H); A(0FFFD0001H);
	A(000090004H); A(000010004H); A(000030000H); A(000040006H); A(000000001H); A(000060003H);
	A(000000004H); A(000040000H); A(000060008H); A(000000001H); A(000060004H); A(000000005H);
	A(000050000H); A(000090006H); A(00H); A(000060009H); A(000010006H); A(000040000H);
	A(000050006H); A(0FFFD0000H); A(000090005H); A(000000004H); A(000040000H); A(000040006H);
	A(0FFFE0000H); A(0000B0003H); A(000020005H); A(00001FFFEH); A(00004000BH); A(0FFFE0001H);
	A(0000B0003H); A(000000006H); A(000060002H); A(000070002H); A(00H); A(000090007H);
	A(000010009H); A(000070000H); A(000070009H); A(000000001H); A(000080005H); A(000010006H);
	A(000040000H); A(000060008H); A(000000001H); A(000080004H); A(000010006H); A(000040000H);
	A(000060008H); A(000000001H); A(000090004H); A(000010006H); A(000040000H); A(000030009H);
	A(00H); A(000090003H); A(000010006H); A(000040000H); A(000060009H); A(000000001H);
	A(000090004H); A(000010006H); A(000040000H); A(000060009H); A(000000001H); A(000090004H);
	A(000010003H); A(000020000H); A(000060009H); A(000000001H); A(000090004H); A(000010006H);
	A(000040000H); A(000060009H); A(000000001H); A(000090004H); A(000010006H); A(000040000H);
	A(000030008H); A(00H); A(000080003H); A(000010005H); A(00004FFFDH); A(000060009H);
	A(000000001H); A(000090004H); A(000010006H); A(000040000H); A(000070009H); A(000000001H);
	A(000090005H); A(000000006H); A(000060003H); A(000060001H); A(00H); A(00H);
	A(02121213FH); A(021212121H); A(00503013FH); A(005091109H); A(003010103H); A(00F1F0F07H);
	A(03F010307H); A(021212121H); A(03F3F3F3FH); A(0103F3F3FH); A(011121418H); A(010181412H);
	A(01E1C1810H); A(0181C1E1FH); A(000000110H); A(001010101H); A(005050501H); A(00A1F0A0AH);
	A(00A0A1F0AH); A(014140F04H); A(00505060CH); A(02A1A041EH); A(00D0B342CH); A(00D1B1615H);
	A(00A040A19H); A(001010C0AH); A(002020401H); A(001010101H); A(004020201H); A(004020201H);
	A(004040404H); A(00A010202H); A(00A041F04H); A(0041F0404H); A(001010104H); A(001011F01H);
	A(002020101H); A(008080404H); A(01111110EH); A(00E111111H); A(004040404H); A(004060504H);
	A(00402011FH); A(007080804H); A(008080807H); A(007080807H); A(03F080808H); A(0080C0A09H);
	A(008080807H); A(00E020107H); A(01311110EH); A(01C02010DH); A(004040202H); A(01F100808H);
	A(01111110EH); A(00E11110EH); A(016100807H); A(00E111119H); A(000000101H); A(001010101H);
	A(000000101H); A(00C300101H); A(0300C0303H); A(0031F001FH); A(00C30300CH); A(002000203H);
	A(008080402H); A(06D021C07H); A(0A5A5A5B5H); A(0413C42B9H); A(0143E2241H); A(00F080814H);
	A(00F111111H); A(01C0F1111H); A(001010102H); A(00F1C0201H); A(021212111H); A(00F0F1121H);
	A(00F010101H); A(0010F0101H); A(00F010101H); A(03C0F0101H); A(001212122H); A(0111C0201H);
	A(01F111111H); A(001111111H); A(001010101H); A(003010101H); A(002020202H); A(011020202H);
	A(003030509H); A(00F110905H); A(001010101H); A(011010101H); A(011011101H); A(0AA00AA01H);
	A(04400AA00H); A(031004400H); A(025292931H); A(01C232325H); A(041414122H); A(0011C2241H);
	A(00F010101H); A(0600F1111H); A(041221C10H); A(022414141H); A(00911111CH); A(011110F05H);
	A(00808070FH); A(001010204H); A(00404040EH); A(004040404H); A(011110E1FH); A(011111111H);
	A(0120C0C11H); A(021211212H); A(084008421H); A(04A014A00H); A(031014A01H); A(031023102H);
	A(00A111102H); A(0110A0404H); A(004040411H); A(0110A0A04H); A(002010F11H); A(008040402H);
	A(00101070FH); A(001010101H); A(007010101H); A(004040808H); A(001010202H); A(004040407H);
	A(004040404H); A(004070404H); A(015040404H); A(00207040AH); A(0090D0B01H); A(0070E090EH);
	A(00B090909H); A(00101010DH); A(001010907H); A(00D0B0E01H); A(00E090909H); A(007080808H);
	A(0090F0109H); A(00202020EH); A(002070202H); A(009070602H); A(007020E09H); A(0091E0909H);
	A(00B090909H); A(00101010DH); A(001010101H); A(001000101H); A(002020201H); A(002020202H);
	A(009020002H); A(005030305H); A(001010109H); A(001010101H); A(001010101H); A(049494901H);
	A(0096D5B49H); A(00B090909H); A(00909070DH); A(0010E0909H); A(009070101H); A(00D0B0909H);
	A(00B080808H); A(00909090DH); A(00101010EH); A(003050701H); A(001030604H); A(0020A0606H);
	A(0020F0202H); A(0090D0B02H); A(004090909H); A(0110A0A04H); A(044004411H); A(0AA00AA00H);
	A(011011100H); A(006090901H); A(001090906H); A(004040202H); A(011110A0AH); A(00402010FH);
	A(002040F08H); A(001020202H); A(002020202H); A(001010104H); A(001010101H); A(001010101H);
	A(002020201H); A(002020402H); A(019010202H); A(022414126H); A(00814143EH); A(0221C2208H);
	A(041414141H); A(00E221C22H); A(011111111H); A(00B151511H); A(0090E090DH); A(0070A000EH);
	A(009090909H); A(00B0A000EH); A(00909090DH); A(00B090009H); A(0090E090DH); A(0040A000EH);
	A(00F010907H); A(00A000E09H); A(002020204H); A(000020202H); A(009070205H); A(00E090909H);
	A(00B060900H); A(00909090DH); A(006090009H); A(00E090D0BH); A(004000E09H); A(001090702H);
	A(0000E090FH); A(001010204H); A(001010101H); A(007010200H); A(009090909H); A(00204000EH);
	A(009090D0BH); A(004000909H); A(001090702H); A(0000E090FH); A(009070804H); A(00E090F01H);
	A(002020A00H); A(002020202H); A(006040500H); A(001090700H); A(00B0E0101H); A(0090E090DH);
	A(00804000EH); A(009090909H); A(005000D0BH); A(011110D0AH); A(009050911H); A(0003F0609H);
	A(00H)
END DefaultFont;

PROCEDURE Load*;
END Load;

BEGIN
	InitBitTable;
	nof := 0;
	DefaultFont;
	Graphics.InstallDefaultFont(LoadDefaultFont());
	KernelLog.String("Default font installed");
END WMDefaultFont.


System.Free WMDefaultFont ~
Aos.Call WMDefaultFont.Load ~