Confusing Chr$ explanation

[SagaraS]

Another possibility would be to use a raster font. But the whole thing doesn't work in Screen 0 mode.

http://orangetide.com/fonts/DOS/

The File "cp850.f16" on this site is that what you search. F16 stand for 8x16 raster font.
Screen mode must use 8x16 fonts. e.g.: Screen 11 or 12
Screen Mode 12 would be similar to Screen 0

or much better is

Code: (Select All)

SCREEN _NEWIMAGE(640, 400, 256) ' <- Screen 0 Resolution

WIDTH 80, 25 '                    <-- Colums and Rows from Screen 0 

Here a picture of my raster font editor with this font.



You can load this raster font into an array and have the array indexed. As a CHR$ replacement.
Example:

Sorry for the font comments.
Originally I used the whole thing for 8x8 raster fonts.
Just modified it for 8x16.

Code: (Select All)

REDIM SHARED FontMEM(0) AS _UNSIGNED _BYTE '  Font Memory for 8x8 raster fonts. 1024 or 2048 Bytes



SCREEN 12



CALL LoadFNT("cp850.f16")



' instructs the compiler to require variable declaration

OPTION _EXPLICIT



' Control function off to set all characters

_CONTROLCHR OFF



' dimension variables

DIM winX AS _UNSIGNED INTEGER

DIM winY AS _UNSIGNED INTEGER

DIM i AS _UNSIGNED _BYTE

DIM x AS _UNSIGNED _BYTE

DIM y AS _UNSIGNED _BYTE

DIM selx AS _UNSIGNED _BYTE

DIM sely AS _UNSIGNED _BYTE

DIM keyin AS STRING

DIM col1 AS _UNSIGNED _BYTE

DIM col2 AS _UNSIGNED _BYTE



' Create window area with colors

COLOR 4, 7

winX = 14

winY = 4

FOR y = winY + 0 TO winY + 16

  FOR x = winX + 0 TO winX + 16 * 3

    LOCATE y, x: PRINT SPACE$(2);

  NEXT x

NEXT y



' Create table info

FOR i = 0 TO 15

  LOCATE winY, winX + (i * 3) + 3: PRINT "0" + HEX$(i);

  LOCATE winY + i + 1, winX: PRINT HEX$(i) + "0";

NEXT i



' Create ASCII characters

' Init values for the table of ASCII chars

COLOR 0, 7

winX = winX + 1

winY = winY + 1



DO

  ' Output of all ASCII characters in the table

  x = 0

  y = winY

  FOR i = 0 TO 255

    'IF selx = x AND sely = y - winY THEN COLOR 7, 2 ELSE COLOR 0, 7

    'LOCATE y, winX + (x * 3) + 3: PRINT CHR$(i);

    IF selx = x AND sely = y - winY THEN col1 = 7: col2 = 2 ELSE col1 = 0: col2 = 7

    FPRINT winX + (x * 3) + 3, y, CHR$(i), col1, col2

    x = x + 1

    IF x = 16 THEN

      x = 0

      y = y + 1

    END IF

  NEXT i



  ' Output of decimal and hex value of current char

  COLOR 0, 7

  LOCATE winY + 16, winX - 1: PRINT SPACE$(25);

  LOCATE winY + 16, winX - 1: PRINT "ASCII:  DEC(" + LTRIM$(STR$(sely * 16 + selx)) + ")  HEX(" + HEX$(sely * 16 + selx) + ")";



  ' Key Input

  DO

    keyin = INKEY$

  LOOP WHILE keyin = ""



  ' Arrowkeys to select the current char

  IF keyin = CHR$(0) + CHR$(77) THEN IF selx >= 15 THEN selx = 0 ELSE selx = selx + 1

  IF keyin = CHR$(0) + CHR$(75) THEN IF selx <= 0 THEN selx = 15 ELSE selx = selx - 1

  IF keyin = CHR$(0) + CHR$(80) THEN IF sely >= 15 THEN sely = 0 ELSE sely = sely + 1

  IF keyin = CHR$(0) + CHR$(72) THEN IF sely <= 0 THEN sely = 15 ELSE sely = sely - 1



  ' ESC to end the program

LOOP WHILE keyin <> CHR$(27)





SUB LoadFNT (file AS STRING)

  ' Loading 8x8 Raster Font in the Font Memory

  ' If File > 1024 then Font Memory = 2048 Byte else 1024 Byte

  OPEN file FOR BINARY ACCESS READ AS #1

  IF LOF(1) > 2048 THEN

    REDIM FontMEM(4095) AS _UNSIGNED _BYTE

  ELSE

    REDIM FontMEM(2047) AS _UNSIGNED _BYTE

  END IF

  GET #1, , FontMEM()

  CLOSE #1

END SUB



SUB FPRINT (x AS _UNSIGNED INTEGER, y AS _UNSIGNED INTEGER, Text AS STRING, col1 AS _UNSIGNED _BYTE, col2 AS _UNSIGNED _BYTE)

  ' The same as the PRINT funtion in QB64

  ' but it use the own Font

  DIM px AS _UNSIGNED INTEGER

  DIM py AS _UNSIGNED INTEGER

  DIM i AS _UNSIGNED INTEGER

  DIM lowBase AS _UNSIGNED _BYTE

  DIM idx AS _UNSIGNED LONG



  px = (x - 1) * 8

  py = (y - 1) * 16



  IF UBOUND(FontMEM) <= 2047 THEN lowBase = 1



  FOR i = 1 TO LEN(Text)

    idx = ASC(MID$(Text, i, 1))

    CALL FONTprint(idx, lowBase, px, py, col1, col2)

    px = px + 8

  NEXT i

END SUB



SUB FONTprint (idx AS _UNSIGNED _BYTE, lowBase AS _UNSIGNED _BYTE, px AS _UNSIGNED INTEGER, py AS _UNSIGNED INTEGER, col1 AS _UNSIGNED _BYTE, col2 AS _UNSIGNED _BYTE)

  DIM t AS _UNSIGNED _BYTE

  DIM dx AS _UNSIGNED INTEGER

  DIM dy AS _UNSIGNED INTEGER

  DIM dcol AS _UNSIGNED _BYTE



  ' Critical Error FIX, when PX > 320 or PY >200

  IF px >= 640 THEN

    px = px - 8

    EXIT SUB

  END IF

  IF py >= 400 THEN

    py = py - 16

    EXIT SUB

  END IF



  ' Draw Font

  IF idx > 127 AND lowBase = 1 THEN ' If Font idx > 127 and the Fontfile < 1024 then print empty CHAR

    FOR dy = 0 TO 15

      FOR dx = 0 TO 7

        PSET (px + dx, py + dy), col2

      NEXT dx

    NEXT dy

  ELSE '                              else draw Font idx from the FONT Memory

    FOR dy = 0 TO 15

      t = &H80

      FOR dx = 0 TO 7

        IF (FontMEM(idx * 16 + (dy)) AND t) / t = 1 THEN dcol = col1 ELSE dcol = col2

        PSET (px + dx, py + dy), dcol

        t = t / 2

      NEXT dx

    NEXT dy

  END IF

END SUB

Your output will then be as follows:



A raster font is much more accurate and faithful than TrueType fonts.


Here's another raster font as proof. "scrwl~~~.f16"