try again

This commit is contained in:
visionmercer 2026-05-28 14:07:51 +02:00
commit 684e3d1b0c
10 changed files with 484 additions and 59 deletions

238
include/bgifnt.bm Normal file
View file

@ -0,0 +1,238 @@
FUNCTION LoadBGIFont (filename AS STRING)
LoadBGIFont = __BGI_Internal(1, 0, 0, 0, 0, filename, 0)
END FUNCTION
SUB UnloadBGIFont (fontHandle AS INTEGER)
DIM discard AS LONG
discard = __BGI_Internal(2, fontHandle, 0, 0, 0, "", 0)
END SUB
SUB DisplayBGIText (fontHandle AS INTEGER, startX AS SINGLE, startY AS SINGLE, text AS STRING, fontSize AS SINGLE, col AS LONG)
DIM discard AS LONG
discard = __BGI_Internal(3, fontHandle, startX, startY, fontSize, text, col)
END SUB
FUNCTION __BGI_Internal (mode AS INTEGER, handle AS INTEGER, arg1 AS SINGLE, arg2 AS SINGLE, arg3 AS SINGLE, textData AS STRING, col AS LONG)
DIM filename AS STRING
DIM fNum AS INTEGER
DIM slot AS INTEGER
DIM i AS LONG
DIM c AS INTEGER
DIM d AS STRING
DIM header_size_pos AS LONG
DIM header_size AS INTEGER
DIM stroke_header_start AS LONG
DIM strokes_offset AS INTEGER
DIM asc_temp AS INTEGER
DIM base_temp AS INTEGER
DIM desc_temp AS INTEGER
DIM char_offsets_pos AS LONG
DIM widths_pos AS LONG
DIM startX AS SINGLE
DIM startY AS SINGLE
DIM fontSize AS SINGLE
DIM text AS STRING
DIM font_height AS INTEGER
DIM scale AS SINGLE
DIM x AS SINGLE
DIM ch AS INTEGER
DIM stroke_pos AS LONG
DIM cur_x AS SINGLE
DIM cur_y AS SINGLE
DIM byte1 AS INTEGER
DIM byte2 AS INTEGER
DIM op1 AS INTEGER
DIM op2 AS INTEGER
DIM m AS INTEGER
DIM dx_raw AS INTEGER
DIM dx AS INTEGER
DIM dy_raw AS INTEGER
DIM dy AS INTEGER
DIM new_x AS SINGLE
DIM new_y AS SINGLE
STATIC init AS INTEGER
STATIC __bgi_fontdata() AS STRING
STATIC __bgi_metrics() AS LONG
CONST MAX_FONTS = 10
CONST M_INUSE = 1
CONST M_FIRSTCHAR = 2
CONST M_NUMCHARS = 3
CONST M_ASCENDER = 4
CONST M_BASELINE = 5
CONST M_DESCENDER = 6
CONST M_STROKESSTART = 7
CONST METRICS_SIZE = 521
IF NOT init THEN
REDIM __bgi_fontdata(1 TO MAX_FONTS) AS STRING
REDIM __bgi_metrics(1 TO MAX_FONTS, 1 TO METRICS_SIZE) AS LONG
init = -1
END IF
SELECT CASE mode
CASE 1 ' --- LOAD FONT ---
filename = textData
IF _FILEEXISTS(filename) = 0 THEN
PRINT "File not found: "; filename
__BGI_Internal = 0
EXIT FUNCTION
END IF
slot = 0
FOR i = 1 TO MAX_FONTS
IF __bgi_metrics(i, M_INUSE) = 0 THEN
slot = i
EXIT FOR
END IF
NEXT i
IF slot = 0 THEN
PRINT "BGI Font Error: Maximum loaded font limit reached."
__BGI_Internal = 0
EXIT FUNCTION
END IF
' Extract stream data safely
fNum = FREEFILE
OPEN filename FOR BINARY AS #fNum
__bgi_fontdata(slot) = SPACE$(LOF(fNum))
GET #fNum, , __bgi_fontdata(slot)
CLOSE #fNum
d = __bgi_fontdata(slot)
' Validate signature header identity
IF MID$(d, 1, 2) <> "PK" OR ASC(MID$(d, 3, 1)) <> 8 OR ASC(MID$(d, 4, 1)) <> 8 OR MID$(d, 5, 4) <> "BGI " THEN
PRINT "Not a valid Borland BGI .CHR font file: "; filename
__bgi_fontdata(slot) = ""
__BGI_Internal = 0
EXIT FUNCTION
END IF
' Track string end parsing marker
i = 9
WHILE i <= LEN(d) AND ASC(MID$(d, i, 1)) <> 26
i = i + 1
WEND
IF i > LEN(d) THEN
PRINT "Invalid font format: Missing description terminator."
__bgi_fontdata(slot) = ""
__BGI_Internal = 0
EXIT FUNCTION
END IF
header_size_pos = i + 1
header_size = CVI(MID$(d, header_size_pos, 2))
stroke_header_start = header_size + 1
IF ASC(MID$(d, stroke_header_start, 1)) <> ASC("+") THEN
PRINT "Not a stroked font."
__bgi_fontdata(slot) = ""
__BGI_Internal = 0
EXIT FUNCTION
END IF
__bgi_metrics(slot, M_NUMCHARS) = CVI(MID$(d, stroke_header_start + 1, 2))
__bgi_metrics(slot, M_FIRSTCHAR) = ASC(MID$(d, stroke_header_start + 4, 1))
strokes_offset = CVI(MID$(d, stroke_header_start + 5, 2))
' Signed Int8 layout mappings
asc_temp = ASC(MID$(d, stroke_header_start + 8, 1))
IF asc_temp > 127 THEN __bgi_metrics(slot, M_ASCENDER) = asc_temp - 256 ELSE __bgi_metrics(slot, M_ASCENDER) = asc_temp
base_temp = ASC(MID$(d, stroke_header_start + 9, 1))
IF base_temp > 127 THEN __bgi_metrics(slot, M_BASELINE) = base_temp - 256 ELSE __bgi_metrics(slot, M_BASELINE) = base_temp
desc_temp = ASC(MID$(d, stroke_header_start + 10, 1))
IF desc_temp > 127 THEN __bgi_metrics(slot, M_DESCENDER) = desc_temp - 256 ELSE __bgi_metrics(slot, M_DESCENDER) = desc_temp
' Assign vector stroke references
char_offsets_pos = stroke_header_start + 16
FOR c = 0 TO __bgi_metrics(slot, M_NUMCHARS) - 1
__bgi_metrics(slot, 8 + __bgi_metrics(slot, M_FIRSTCHAR) + c) = CVI(MID$(d, char_offsets_pos + c * 2, 2))
NEXT c
' Map character layout metrics width boundaries
widths_pos = char_offsets_pos + __bgi_metrics(slot, M_NUMCHARS) * 2
FOR c = 0 TO __bgi_metrics(slot, M_NUMCHARS) - 1
__bgi_metrics(slot, 265 + __bgi_metrics(slot, M_FIRSTCHAR) + c) = ASC(MID$(d, widths_pos + c, 1))
NEXT c
__bgi_metrics(slot, M_STROKESSTART) = stroke_header_start + strokes_offset
__bgi_metrics(slot, M_INUSE) = -1
__BGI_Internal = slot
CASE 2 ' --- UNLOAD FONT ---
IF handle >= 1 AND handle <= MAX_FONTS THEN
__bgi_metrics(handle, M_INUSE) = 0
__bgi_fontdata(handle) = ""
END IF
CASE 3 ' --- DISPLAY TEXT ---
IF handle < 1 OR handle > MAX_FONTS THEN EXIT FUNCTION
IF __bgi_metrics(handle, M_INUSE) = 0 THEN EXIT FUNCTION
startX = arg1
startY = arg2
fontSize = arg3
text = textData
font_height = __bgi_metrics(handle, M_ASCENDER) - __bgi_metrics(handle, M_DESCENDER)
IF font_height = 0 THEN font_height = 1
scale = fontSize / font_height
x = startX
FOR ch = 1 TO LEN(text)
c = ASC(MID$(text, ch, 1))
IF c < __bgi_metrics(handle, M_FIRSTCHAR) OR c >= __bgi_metrics(handle, M_FIRSTCHAR) + __bgi_metrics(handle, M_NUMCHARS) OR __bgi_metrics(handle, 8 + c) = 0 THEN
x = x + 8 * scale
_CONTINUE
END IF
stroke_pos = __bgi_metrics(handle, M_STROKESSTART) + __bgi_metrics(handle, 8 + c)
cur_x = x
cur_y = startY
DO
byte1 = ASC(MID$(__bgi_fontdata(handle), stroke_pos, 1))
byte2 = ASC(MID$(__bgi_fontdata(handle), stroke_pos + 1, 1))
stroke_pos = stroke_pos + 2
op1 = (byte1 AND 128) \ 128
op2 = (byte2 AND 128) \ 128
m = op1 + op1 + op2
IF m = 0 THEN EXIT DO
IF m = 1 THEN _CONTINUE
dx_raw = byte1 AND 127
dx = dx_raw
IF dx > 63 THEN dx = dx - 128
dy_raw = byte2 AND 127
dy = dy_raw
IF dy > 63 THEN dy = dy - 128
dy = -dy
new_x = x + dx * scale
new_y = startY + dy * scale
IF m = 2 THEN
cur_x = new_x
cur_y = new_y
ELSEIF m = 3 THEN
LINE (cur_x, cur_y)-(new_x, new_y), col
cur_x = new_x
cur_y = new_y
END IF
LOOP
x = x + __bgi_metrics(handle, 265 + c) * scale
NEXT ch
END SELECT
END FUNCTION