Skip to content

Commit c4b70c5

Browse files
RetroNick2020RetroNick2020
committed
Create AmigaFont.pas
1 parent f733f82 commit c4b70c5

File tree

1 file changed

+361
-0
lines changed

1 file changed

+361
-0
lines changed

‎AmigaFont.pas‎

Lines changed: 361 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,361 @@
1+
{
2+
AmigaFont.pas - Amiga Font Reader Unit for Bitmap Font Editor
3+
4+
Reads Amiga OS 1.3/Workbench 1.3 font files (the data files like "11", "8", etc.)
5+
These are Amiga executable files with embedded font data.
6+
7+
SUPPORTED FONTS:
8+
- Fixed-width fonts (like Topaz) - WORKING
9+
- Proportional fonts (like Times, Courier) - WORKING
10+
- Italic/oblique fonts (like Emerald) - WORKING
11+
12+
TECHNICAL NOTES:
13+
- Amiga uses Motorola 68000 (big-endian byte order)
14+
- File structure: Hunk header + code stub + font structure at 0x6E
15+
- Pointers in font structure need +32 adjustment for file offsets
16+
- CharLoc format: First WORD = bit offset, Second WORD = bit width
17+
- NumChars = HiChar - LoChar + 2 (includes notdef glyph)
18+
- Bit extraction: k = location + col + row * modulo * 8
19+
20+
Based on afont.c by Mark Craig
21+
}
22+
23+
unit AmigaFont;
24+
25+
{$mode objfpc}{$H+}
26+
27+
interface
28+
29+
uses
30+
Classes, SysUtils, Graphics, Math;
31+
32+
type
33+
TAmigaCharLoc = record
34+
BitOffset: Word;
35+
BitWidth: Word;
36+
end;
37+
38+
TAmigaFont = class
39+
private
40+
FYSize: Word;
41+
FXSize: Word;
42+
FBaseline: Word;
43+
FLoChar: Byte;
44+
FHiChar: Byte;
45+
FModulo: Word;
46+
FNumChars: Word;
47+
FFontName: string;
48+
FLoaded: Boolean;
49+
50+
FCharLoc: array of TAmigaCharLoc;
51+
FCharSpace: array of SmallInt;
52+
FCharKern: array of SmallInt;
53+
FCharData: array of Byte;
54+
55+
function ReadBEWord(const Data: array of Byte; Offset: Integer): Word;
56+
function ReadBELong(const Data: array of Byte; Offset: Integer): LongWord;
57+
function GetGlyphPixel(CharIndex: Integer; Col, Row: Integer): Boolean;
58+
public
59+
constructor Create;
60+
destructor Destroy; override;
61+
62+
function LoadFromFile(const FileName: string): Boolean;
63+
function GetGlyphBitmap(CharCode: Integer; Bmp: TBitmap): Boolean;
64+
function GetCharWidth(CharCode: Integer): Integer;
65+
66+
procedure Clear;
67+
68+
property YSize: Word read FYSize;
69+
property XSize: Word read FXSize;
70+
property Baseline: Word read FBaseline;
71+
property LoChar: Byte read FLoChar;
72+
property HiChar: Byte read FHiChar;
73+
property NumChars: Word read FNumChars;
74+
property FontName: string read FFontName;
75+
property Loaded: Boolean read FLoaded;
76+
end;
77+
78+
implementation
79+
80+
constructor TAmigaFont.Create;
81+
begin
82+
inherited Create;
83+
Clear;
84+
end;
85+
86+
destructor TAmigaFont.Destroy;
87+
begin
88+
Clear;
89+
inherited Destroy;
90+
end;
91+
92+
procedure TAmigaFont.Clear;
93+
begin
94+
FYSize := 0;
95+
FXSize := 0;
96+
FBaseline := 0;
97+
FLoChar := 32;
98+
FHiChar := 127;
99+
FModulo := 0;
100+
FNumChars := 0;
101+
FFontName := '';
102+
FLoaded := False;
103+
SetLength(FCharLoc, 0);
104+
SetLength(FCharSpace, 0);
105+
SetLength(FCharKern, 0);
106+
SetLength(FCharData, 0);
107+
end;
108+
109+
function TAmigaFont.ReadBEWord(const Data: array of Byte; Offset: Integer): Word;
110+
begin
111+
if Offset + 1 <= High(Data) then
112+
Result := (Word(Data[Offset]) shl 8) or Data[Offset + 1]
113+
else
114+
Result := 0;
115+
end;
116+
117+
function TAmigaFont.ReadBELong(const Data: array of Byte; Offset: Integer): LongWord;
118+
begin
119+
if Offset + 3 <= High(Data) then
120+
Result := (LongWord(Data[Offset]) shl 24) or
121+
(LongWord(Data[Offset + 1]) shl 16) or
122+
(LongWord(Data[Offset + 2]) shl 8) or
123+
LongWord(Data[Offset + 3])
124+
else
125+
Result := 0;
126+
end;
127+
128+
function TAmigaFont.GetGlyphPixel(CharIndex: Integer; Col, Row: Integer): Boolean;
129+
var
130+
K, Pos, Ind: Integer;
131+
BitOffset: Integer;
132+
begin
133+
Result := False;
134+
135+
if (CharIndex < 0) or (CharIndex >= Length(FCharLoc)) then Exit;
136+
if (Col < 0) or (Col >= FCharLoc[CharIndex].BitWidth) then Exit;
137+
if (Row < 0) or (Row >= FYSize) then Exit;
138+
139+
BitOffset := FCharLoc[CharIndex].BitOffset;
140+
141+
// Amiga bit extraction formula:
142+
// k = location + col + row * modulo * 8
143+
K := BitOffset + Col + Row * FModulo * 8;
144+
Pos := K div 8;
145+
Ind := 7 - (K mod 8);
146+
147+
if Pos < Length(FCharData) then
148+
Result := (FCharData[Pos] and (1 shl Ind)) <> 0;
149+
end;
150+
151+
function TAmigaFont.LoadFromFile(const FileName: string): Boolean;
152+
var
153+
FS: TFileStream;
154+
FileData: array of Byte;
155+
FileSize: Int64;
156+
FontOffset: Integer;
157+
CharDataPtr, CharLocPtr, CharSpacePtr, CharKernPtr: LongWord;
158+
CharDataOffset, CharLocOffset, CharSpaceOffset, CharKernOffset: Integer;
159+
I: Integer;
160+
DataSize: Integer;
161+
MaxBitOffset: Integer;
162+
HunkType: LongWord;
163+
begin
164+
Result := False;
165+
Clear;
166+
167+
if not FileExists(FileName) then Exit;
168+
169+
try
170+
FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
171+
try
172+
FileSize := FS.Size;
173+
if FileSize < 32 then Exit;
174+
175+
SetLength(FileData, FileSize);
176+
FS.ReadBuffer(FileData[0], FileSize);
177+
finally
178+
FS.Free;
179+
end;
180+
except
181+
Exit;
182+
end;
183+
184+
// Check for Amiga HUNK_HEADER
185+
HunkType := ReadBELong(FileData, 0);
186+
if HunkType <> $000003F3 then
187+
Exit;
188+
189+
// Font structure is at offset 0x6E (after hunk header + code stub + name)
190+
FontOffset := $6E;
191+
192+
if FontOffset + 32 >= FileSize then
193+
Exit;
194+
195+
// Parse the TextFont structure
196+
FYSize := ReadBEWord(FileData, FontOffset);
197+
// Style at offset 2 (byte), Flags at offset 3 (byte)
198+
FXSize := ReadBEWord(FileData, FontOffset + 4);
199+
FBaseline := ReadBEWord(FileData, FontOffset + 6) + 1;
200+
// BoldSmear at offset 8
201+
// Accessors at offset 10
202+
FLoChar := FileData[FontOffset + 12];
203+
FHiChar := FileData[FontOffset + 13];
204+
// Modulo is at offset 18
205+
FModulo := ReadBEWord(FileData, FontOffset + 18);
206+
207+
// Validate parsed values
208+
if (FYSize < 4) or (FYSize > 64) or
209+
(FXSize < 1) or (FXSize > 64) or
210+
(FLoChar > FHiChar) then
211+
Exit;
212+
213+
// NumChars includes the "notdef" glyph at the end
214+
FNumChars := FHiChar - FLoChar + 2;
215+
216+
// Get CharLoc offset from pointer + 32
217+
CharLocPtr := ReadBELong(FileData, FontOffset + 20);
218+
CharLocOffset := CharLocPtr + 32;
219+
220+
// Get CharData offset from pointer + 32
221+
CharDataPtr := ReadBELong(FileData, FontOffset + 14);
222+
CharDataOffset := CharDataPtr + 32;
223+
224+
// Validate offsets
225+
if (CharLocOffset < 0) or (CharLocOffset + FNumChars * 4 > FileSize) then
226+
Exit;
227+
if (CharDataOffset < 0) or (CharDataOffset > FileSize) then
228+
Exit;
229+
230+
// Load CharLoc table
231+
SetLength(FCharLoc, FNumChars);
232+
MaxBitOffset := 0;
233+
234+
for I := 0 to FNumChars - 1 do
235+
begin
236+
// CharLoc format: first word = bit offset, second word = bit width
237+
FCharLoc[I].BitOffset := ReadBEWord(FileData, CharLocOffset + I * 4);
238+
FCharLoc[I].BitWidth := ReadBEWord(FileData, CharLocOffset + I * 4 + 2);
239+
240+
if FCharLoc[I].BitOffset + FCharLoc[I].BitWidth > MaxBitOffset then
241+
MaxBitOffset := FCharLoc[I].BitOffset + FCharLoc[I].BitWidth;
242+
end;
243+
244+
// Validate/calculate Modulo
245+
if (FModulo = 0) or (FModulo < (MaxBitOffset + 7) div 8) then
246+
FModulo := (MaxBitOffset + 7) div 8;
247+
248+
// Load CharSpace table (proportional fonts only)
249+
CharSpacePtr := ReadBELong(FileData, FontOffset + 24);
250+
if CharSpacePtr <> 0 then
251+
begin
252+
CharSpaceOffset := CharSpacePtr + 32;
253+
if (CharSpaceOffset > 0) and (CharSpaceOffset + FNumChars * 2 <= FileSize) then
254+
begin
255+
SetLength(FCharSpace, FNumChars);
256+
for I := 0 to FNumChars - 1 do
257+
FCharSpace[I] := SmallInt(ReadBEWord(FileData, CharSpaceOffset + I * 2));
258+
end;
259+
end;
260+
261+
// Load CharKern table (proportional fonts only)
262+
CharKernPtr := ReadBELong(FileData, FontOffset + 28);
263+
if CharKernPtr <> 0 then
264+
begin
265+
CharKernOffset := CharKernPtr + 32;
266+
if (CharKernOffset > 0) and (CharKernOffset + FNumChars * 2 <= FileSize) then
267+
begin
268+
SetLength(FCharKern, FNumChars);
269+
for I := 0 to FNumChars - 1 do
270+
FCharKern[I] := SmallInt(ReadBEWord(FileData, CharKernOffset + I * 2));
271+
end;
272+
end;
273+
274+
// Load bitmap data
275+
DataSize := FModulo * FYSize;
276+
277+
if CharDataOffset + DataSize > FileSize then
278+
DataSize := FileSize - CharDataOffset;
279+
280+
if DataSize > 0 then
281+
begin
282+
SetLength(FCharData, DataSize);
283+
Move(FileData[CharDataOffset], FCharData[0], DataSize);
284+
end
285+
else
286+
Exit;
287+
288+
FFontName := ChangeFileExt(ExtractFileName(FileName), '');
289+
FLoaded := (Length(FCharData) > 0) and (Length(FCharLoc) > 0);
290+
Result := FLoaded;
291+
end;
292+
293+
function TAmigaFont.GetGlyphBitmap(CharCode: Integer; Bmp: TBitmap): Boolean;
294+
var
295+
CharIndex, X, Y, CharWidth: Integer;
296+
begin
297+
Result := False;
298+
299+
if not FLoaded then Exit;
300+
if (CharCode < FLoChar) or (CharCode > FHiChar) then Exit;
301+
302+
CharIndex := CharCode - FLoChar;
303+
if CharIndex >= Length(FCharLoc) then Exit;
304+
305+
CharWidth := FCharLoc[CharIndex].BitWidth;
306+
if CharWidth = 0 then
307+
begin
308+
// Use CharSpace if available, or XSize
309+
if (Length(FCharSpace) > CharIndex) and (FCharSpace[CharIndex] > 0) then
310+
CharWidth := FCharSpace[CharIndex]
311+
else
312+
CharWidth := FXSize;
313+
end;
314+
315+
if CharWidth <= 0 then Exit;
316+
317+
Bmp.Width := CharWidth;
318+
Bmp.Height := FYSize;
319+
Bmp.Canvas.Brush.Color := clWhite;
320+
Bmp.Canvas.FillRect(0, 0, Bmp.Width, Bmp.Height);
321+
322+
// Only draw if we have bitmap data for this char
323+
if FCharLoc[CharIndex].BitWidth > 0 then
324+
begin
325+
for Y := 0 to FYSize - 1 do
326+
begin
327+
for X := 0 to FCharLoc[CharIndex].BitWidth - 1 do
328+
begin
329+
if GetGlyphPixel(CharIndex, X, Y) then
330+
Bmp.Canvas.Pixels[X, Y] := clBlack;
331+
end;
332+
end;
333+
end;
334+
335+
Result := True;
336+
end;
337+
338+
function TAmigaFont.GetCharWidth(CharCode: Integer): Integer;
339+
var
340+
CharIndex: Integer;
341+
begin
342+
Result := 0;
343+
if not FLoaded then Exit;
344+
if (CharCode < FLoChar) or (CharCode > FHiChar) then Exit;
345+
346+
CharIndex := CharCode - FLoChar;
347+
348+
// For proportional fonts, use CharSpace (spacing advance)
349+
if (Length(FCharSpace) > CharIndex) and (FCharSpace[CharIndex] > 0) then
350+
Result := FCharSpace[CharIndex]
351+
else if CharIndex < Length(FCharLoc) then
352+
Result := FCharLoc[CharIndex].BitWidth
353+
else
354+
Result := FXSize;
355+
356+
// Ensure minimum width
357+
if Result <= 0 then
358+
Result := FXSize;
359+
end;
360+
361+
end.

0 commit comments

Comments
 (0)