|
Post by bplus on May 6, 2024 14:46:35 GMT
i have now investigated that link to cobalt code, it works! it is very complicated and involves 4 files 1 the charset.h file goes in same folder as your qb64.exe program, probably best to test all 4 files from same folder to avoid further complexity
extern uint8 charset8x8[256][8][8]; extern uint8 charset8x16[256][16][8];
void Charset_8x16 (ptrszint offset){ memcpy(charset8x16,(void*)offset,sizeof(charset8x16)); }
void Charset_8x8 (ptrszint offset){ memcpy(charset8x8,(void*)offset,sizeof(charset8x8)); }
2 the demo file, the file that actaually uses the the whole setup to print special edit characters
DECLARE LIBRARY "charset" SUB Charset_8x8 (BYVAL o AS _OFFSET) SUB Charset_8x16 (BYVAL o AS _OFFSET) END DECLARE DIM SHARED c16(7, 15, 255) AS _UNSIGNED _BYTE, charload AS _UNSIGNED _BYTE 'Usage: Load_BIOS_Font "yourfontfile.fnt" Charset_8x16 _OFFSET(c16(0, 0, 0)) test$ = chr$(1) + chr$(2) + chr$(3) ' print the first 3 characters edited after 0 = chr$(0) which might not work print test$ SUB Load_BIOS_Font (Font$) OPEN Font$ FOR BINARY AS #1 FOR c% = 0 TO 255 FOR y% = 0 TO 15 GET #1, , charload FOR x% = 0 TO 7 IF _READBIT(charload, x%) THEN c16(7 - x%, y%, c%) = 1 'any non-0 value should work NEXT NEXT NEXT CLOSE #1 END SUB
3 the editor that actually is used to create the characters, it is very old and tedious does not use mouse and who works with screen 7 anymore?
DECLARE SUB char (ch%, sx%, sy%) DECLARE FUNCTION getXY! (c%, x%, y%) DIM SHARED fot(255) AS STRING * 16 xp% = 1: yp% = 1 cb$ = STRING$(16, 0) Show: ON ERROR GOTO 0 SCREEN 7, , 1, 1 CLS COLOR 4, 0 PRINT "FONT EDIT v1.0 by Davey W Taylor" LOCATE 25, 1: PRINT "Press 'H' for help"; LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 15, B ch% = 0 FOR y% = 1 TO 8 FOR x% = 1 TO 32 sx% = (x% - 1) * 10 sy% = y% * 20 ch% = ch% + 1 char ch%, sx%, sy% NEXT x% NEXT y% ml: ON ERROR GOTO 0 DO in$ = INKEY$ SELECT CASE in$ CASE "h", "H" SCREEN 7, , 0, 0 CLS COLOR 15, 0 PRINT "Keys:" PRINT " Left/Right/Up/Down - Change character" PRINT " ENTER - Edit character" PRINT " L - Load font" PRINT " S - Save font" PRINT " ESC - Quit" PRINT PRINT "Press any key" DO: LOOP UNTIL INKEY$ <> "" SCREEN 7, , 1, 1 CASE CHR$(0) + "K" 'Lt LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 0, B IF xp% > 1 THEN xp% = xp% - 1 LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 15, B CASE CHR$(0) + "M" 'Rt LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 0, B IF xp% < 32 THEN xp% = xp% + 1 LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 15, B CASE CHR$(0) + "H" 'Up LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 0, B IF yp% > 1 THEN yp% = yp% - 1 LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 15, B CASE CHR$(0) + "P" 'Dn LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 0, B IF yp% < 8 THEN yp% = yp% + 1 LINE ((xp% - 1) * 10, (yp% * 20))-(9 + (xp% - 1) * 10, 17 + (yp% * 20)), 15, B CASE "l", "L" SCREEN 7, , 0, 0 CLS COLOR 15, 0 PRINT "Load font-file: "; LINE INPUT "", f$ ON ERROR GOTO nofile OPEN f$ FOR INPUT AS #1 IF LOF(1) = 256 * 16 THEN er% = 0 ELSE er% = 1 CLOSE #1 ON ERROR GOTO 0 IF er% THEN PRINT "A font-file must be exactly 256 * 16 bytes long!" DO: LOOP UNTIL INKEY$ <> "" SCREEN 7, , 1, 1 GOTO ml END IF OPEN f$ FOR BINARY ACCESS READ AS #1 FOR ch% = 0 TO 255 GET #1, , fot(ch%) NEXT ch% CLOSE #1 GOTO Show CASE "s", "S" SCREEN 7, , 0, 0 CLS COLOR 15, 0 PRINT "Save font-file: "; LINE INPUT "", f$ chf% = 0 ON ERROR GOTO fc OPEN f$ FOR INPUT AS #1 CLOSE #1 ON ERROR GOTO 0 IF chf% = 0 THEN PRINT "File exists, overwrite? "; DO: in$ = UCASE$(INKEY$): LOOP UNTIL in$ = "Y" OR in$ = "N" IF in$ = "N" THEN SCREEN 7, , 1, 1 GOTO ml END IF END IF ON ERROR GOTO diskfull OPEN f$ FOR OUTPUT AS #1 CLOSE #1 OPEN f$ FOR BINARY ACCESS WRITE AS #1 FOR n% = 0 TO 255 PUT #1, , fot(n%) NEXT n% CLOSE #1 ON ERROR GOTO 0 SCREEN 7, , 1, 1 CASE CHR$(13) SCREEN 7, , 0, 0 CLS ch% = (xp% - 1) + (32 * (yp% - 1)) xe% = 1: ye% = 1 upd: FOR y% = 1 TO 16 FOR x% = 1 TO 8 xs% = 1 + (x% - 1) * 10 ys% = 1 + (y% - 1) * 10 IF getXY(ch%, x%, y%) THEN LINE (xs%, ys%)-(xs% + 8, ys% + 8), 14, BF ELSE LINE (xs%, ys%)-(xs% + 8, ys% + 8), 1, BF END IF NEXT x% NEXT y% LOCATE 1, 15: PRINT "up/dn/lt/rt - move cursor" LOCATE 2, 15: PRINT "space - toggle pixel" LOCATE 3, 15: PRINT "enter - when done" LOCATE 4, 15: PRINT "H - flip horizontal" LOCATE 5, 15: PRINT "V - flip vertical" LOCATE 6, 15: PRINT "I - invert" LOCATE 7, 15: PRINT "C - copy" LOCATE 8, 15: PRINT "P - paste" LOCATE 9, 15: PRINT "X - clear" LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 12, B DO in$ = INKEY$ SELECT CASE in$ CASE CHR$(0) + "K" 'Lt LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 0, B IF xe% > 1 THEN xe% = xe% - 1 LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 12, B CASE CHR$(0) + "M" 'Rt LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 0, B IF xe% < 8 THEN xe% = xe% + 1 LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 12, B CASE CHR$(0) + "H" 'Up LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 0, B IF ye% > 1 THEN ye% = ye% - 1 LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 12, B CASE CHR$(0) + "P" 'Dn LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 0, B IF ye% < 16 THEN ye% = ye% + 1 LINE ((xe% - 1) * 10, (ye% - 1) * 10)-(10 + (xe% - 1) * 10, 10 + (ye% - 1) * 10), 12, B CASE " " xv% = 2 ^ (8 - xe%) IF getXY(ch%, xe%, ye%) THEN MID$(fot(ch%), ye%, 1) = CHR$(ASC(MID$(fot(ch%), ye%, 1)) - xv%) ELSE MID$(fot(ch%), ye%, 1) = CHR$(ASC(MID$(fot(ch%), ye%, 1)) + xv%) END IF xs% = 1 + (xe% - 1) * 10 ys% = 1 + (ye% - 1) * 10 IF getXY(ch%, xe%, ye%) THEN LINE (xs%, ys%)-(xs% + 8, ys% + 8), 14, BF ELSE LINE (xs%, ys%)-(xs% + 8, ys% + 8), 1, BF END IF CASE "v", "V" v$ = fot(ch%) FOR n% = 1 TO 16 MID$(fot(ch%), n%, 1) = MID$(v$, 17 - n%, 1) NEXT n% GOTO upd CASE "h", "H" v$ = STRING$(16, 0) FOR y% = 1 TO 16 FOR x% = 1 TO 8 xv% = 2 ^ (x% - 1) IF getXY(ch%, x%, y%) THEN MID$(v$, y%, 1) = CHR$(ASC(MID$(v$, y%, 1)) + xv%) END IF NEXT x% NEXT y% fot(ch%) = v$ GOTO upd CASE "i", "I" v$ = fot(ch%) FOR n% = 1 TO 16 MID$(fot(ch%), n%, 1) = CHR$(255 - ASC(MID$(v$, n%, 1))) NEXT n% GOTO upd CASE "c", "C" cb$ = fot(ch%) CASE "p", "P" fot(ch%) = cb$ GOTO upd CASE "x", "X" fot(ch%) = STRING$(16, 0) GOTO upd END SELECT LOOP UNTIL in$ = CHR$(13) SCREEN 7, , 1, 1 sx% = (xp% - 1) * 10 sy% = yp% * 20 char ch% + 1, sx%, sy% CASE CHR$(27) SCREEN 7, , 0, 0 CLS COLOR 15, 0 PRINT "Save your work first? "; DO: in$ = UCASE$(INKEY$): LOOP UNTIL in$ = "N" OR in$ = "Y" IF in$ = "Y" THEN PRINT "Y" PRINT "Save font-file: "; LINE INPUT "", f$ chf% = 0 ON ERROR GOTO fc OPEN f$ FOR INPUT AS #1 CLOSE #1 ON ERROR GOTO 0 IF chf% = 0 THEN PRINT "File exists, overwrite? "; DO: in$ = UCASE$(INKEY$): LOOP UNTIL in$ = "Y" OR in$ = "N" IF in$ = "N" THEN SCREEN 7, , 1, 1 GOTO ml END IF END IF ON ERROR GOTO diskfull OPEN f$ FOR OUTPUT AS #1 CLOSE #1 OPEN f$ FOR BINARY ACCESS WRITE AS #1 FOR n% = 0 TO 255 PUT #1, , fot(n%) NEXT n% CLOSE #1 ON ERROR GOTO 0 END IF END END SELECT LOOP nofile: CLOSE #1 PRINT "Can't find file!" DO: LOOP UNTIL INKEY$ <> "" SCREEN 7, , 1, 1 RESUME ml fc: hm% = ERR SELECT CASE ERR CASE 76, 75, 64, 52 PRINT "Invalid filename!" DO: LOOP UNTIL INKEY$ <> "" SCREEN 7, , 1, 1 RESUME ml CASE ELSE chf% = 1 RESUME NEXT END SELECT diskfull: CLOSE #1 PRINT "The disk is full!" DO: LOOP UNTIL INKEY$ <> "" SCREEN 7, , 1, 1 RESUME ml SUB char (ch%, sx%, sy%) FOR uy% = 1 TO 16 x% = ASC(MID$(fot(ch% - 1), uy%, 1)) x% = 256 * (x% + (256 * (x% > 127))) LINE (sx% + 1, sy% + uy%)-(sx% + 8, sy% + uy%), 1 LINE (sx% + 1, sy% + uy%)-(sx% + 8, sy% + uy%), 14, , x% NEXT uy% END SUB FUNCTION getXY (c%, x%, y%) xv% = 2 ^ (8 - x%) B% = ASC(MID$(fot(c%), y%, 1)) getXY = SGN(B% AND xv%) END FUNCTION
4 is the file you create with the character editor that you have to load in file 2 change this line to the file you saved with the char editor ie 'myfont.fnt' after creating 3 charcters in the 1,2,3 positions skipping the top left chr$(0) position. what really sucks about this system is that no base characters are set ie normal a, b, c.... so you have to make / edit every single character with this most tedious of editors to show any printed text.
but by george it does work as advertised though as i said extremely complex and tedious
|
|