Proportional VGA font: freebasic code

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
lassar
Posts: 306
Joined: Jan 17, 2006 1:35

Proportional VGA font: freebasic code

Post by lassar »

For this demo you will need the following

Download libxbr dll
Download WIN-VAR.F16 VGA font
Download Win-Var.fnt (font spacing)

To edit a font in Defend Reloaded. (using dosbox)

Download 2l8fe122.zip (dos program to edit VGA font)


Here is the demo

Code: Select all

'-------------------------------------------------------------
'
'                        By Randall Glass
'
'                 Donated to Public Domain
'
'-------------------------------------------------------------

#LANG "fblite"

#include once "fbgfx.bi"
DEFINT A-Z
ON ERROR GOTO Problem:


DECLARE SUB LoadVarFont(FontFile$)
DECLARE SUB LoadVarFnt(FontFntFile$)
DECLARE SUB YXPrint (BYVAL Y%,BYVAL X%,BYVAL Colour AS UINTEGER,Txt$)
DECLARE SUB Sync()
DECLARE SUB CCLS(BYVAL COLOUR%)

DIM SHARED VirtualScreen AS ANY PTR
DIM SHARED BufferPtr AS ANY PTR , VideoPtr AS Any PTR

DIM SHARED FontVar(4095) AS UBYTE = ANY
DIM SHARED FontVarOff AS ANY PTR

DIM SHARED FontVarLen(0 TO 255) AS UBYTE = ANY
DIM SHARED FontVarLenPtr AS UBYTE PTR
DIM SHARED Black%,Blue%,Green%,Cyan%,Red%,Magenta%,Brown%,White%,Gray%
DIM SHARED LightBlue%,LightGreen%,LightCyan%,LightRed%,LightMagenta%,Yellow%,BrightWhite%

Black% = RGB(0,0,0)
Blue% = RGB(0,0,168)
Green% = RGB(0,110,0)
Cyan% = RGB(151,187,187)
Red% = RGB(168,0,0)
Magenta% = RGB(168,0,168)
Brown% = RGB(132,84,40)

White% = RGB(168,168,168)
Gray% = RGB(84,84,84)
LightBlue% = RGB(84,84,252)
LightGreen% = RGB(84,252,84)
LightCyan% = RGB(127,255,255)
LightRed% = RGB(36,24,12)
LightMagenta% = RGB(252,84,252)
LightWhite% = RGB(180,180,180)
Yellow% = RGB(64,40,16)
BrightWhite% = RGB(252,252,252)

Yellow2% = RGB(184,186,39)
LightBlue2% = RGB(185,185,218)




LoadVarFont "FONTS/WIN-VAR.F16"
LoadVarFnt "FONTS/Win-Var.fnt"

FontVarOff = VARPTR(FontVar(0))
FontVarLenPtr = VARPTR(FontVarLen(0))


BufferPtr = VideoPtr

TYPE xbr_data
   rgbtoyuv(16777216) AS ULONG
END TYPE

TYPE xbr_params
    xbrinput AS UBYTE PTR
    xbroutput AS UBYTE PTR
    inWidth AS INTEGER
    inHeight AS INTEGER
    inPitch AS INTEGER
    outPitch AS INTEGER
    Rgb2Yuv AS xbr_data PTR
END TYPE

DIM SHARED RgbData AS xbr_data
DIM SHARED MyXbrData AS ANY PTR
DIM SHARED XbrParm AS xbr_params 
DIM SHARED XbrParmPtr AS ANY PTR


MyXbrData = @RgbData
XbrParm.Rgb2Yuv = MyXbrData
XbrParmPtr = @XbrParm

Declare function dylibsymbol ( byval libhandle as integer, symbol as string ) as any ptr
DIM DllPTR AS ANY PTR

DIM SHARED xbr_init_data As SUB stdcall(BYVAL MyXbrData AS ANY PTR)
DIM SHARED xbr_filter_xbr2x As SUB stdcall(BYVAL MyXbrParms AS ANY PTR)
DIM SHARED xbr_filter_hq2x AS SUB stdcall(BYVAL MyXbrParms AS ANY PTR)

DllPTR = DyLibLoad("libxbr.dll")
If DllPTR = 0 Then
  Print "Unable to load libxbr.dll"
  SLEEP
  END
END IF


xbr_init_data = DyLibSymbol ( DllPTR, "xbr_init_data" )
xbr_filter_xbr2x = DyLibSymbol ( DllPTR, "xbr_filter_xbr2x" )

xbr_init_data(XbrParm.Rgb2Yuv)


SCREENRES 1280,960,32,,&H01


VirtualScreen = Imagecreate(640,480,,32)
ImageInfo VirtualScreen,,,,,VideoPtr
BufferPtr = VideoPtr

XbrParm.xbrinput = VideoPtr
XbrParm.xbroutput = Screenptr
XbrParm.inWidth = 640
XbrParm.inHeight = 480
XbrParm.inPitch = 2560
XbrParm.outPitch = 5120

CCLS LightCyan%
PRINT "Hello there. Be still my soul. This is a test."
YXPrint 200,15,Black%, "Hello there. Be still my soul. This is a test."
SLEEP
SCREENSYNC
SCREENLOCK
xbr_filter_xbr2x( XbrParmPtr)
SCREENUNLOCK

SLEEP
END

SUB YXPrint (BYVAL Y%,BYVAL X%,BYVAL Colour AS UINTEGER,Txt$)
    DIM YAdress AS UINTEGER
    DIM ESI_Temp AS ULONG
    DIM EBX_Temp AS ULONG
    DIM ECX_Temp AS ULONG
    SCREENLOCK

    ASM
        MOV     EBX,[Txt$]
        MOV     ECX,[EBX+4]
        CMP     ECX,0
        JNE     ZSprintContinue
        JMP     ZExitPrint
        ZSprintContinue:

        MOV     ESI,[EBX]          'ESI contains String Adress

        '  Change this to: YAdress = (Y * 640) * 4 + BufferPtr


        mov     EBX, [Y%]           ' EBX = Y
        shl     EBX, 7
        mov     EAX, EBX            ' EAX = Y * 128
        shl     EBX, 2              ' EBX = Y * 512
        add     EBX, EAX            ' EBX = Y * (512 + 128)
        shl     EBX, 2              ' adjust for 32 bit colour
        add     EBX,[BufferPtr]
        mov     [YAdress], EBX
        '  End of Change
        MOV     EBX, 0

        ZGetChar:
        MOV     EDI,[YAdress]
        MOV     EAX,[X%]
        SHL     EAX, 2              ' adjust for 32 bit colour
        ADD     EDI,EAX             ' Add X to Address
        MOV     EAX, 0
        MOV     AL,[ESI]
        MOV     [ESI_Temp],ESI
        MOV     [EBX_Temp],EBX
        MOV     [ECX_Temp],ECX
        
        mov     ESI,FontVarOff        'ESI now contains Offset pointer to char data

        ZNextCheck4:
        'Character location = Font Offset + Character * 16 + Row
        mov     EBX,EAX
        SHL     EBX, 4
        ADD     ESI,EBX
        mov     ECX,16
        ADD     EDI,28              ' add 7 * 4 bytes per pixel
        ZPrintRow:
        mov     al,[ESI]     'move the pixel into ah
        Zbit0:
        test    Al,&B00000001             'IF bit(Pixel,0) THEN
        jz      Zbit1
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit1:
        SUB     EDI,4                     ' subtract 4 bytes per pixel
        test    Al,&B00000010             'IF bit(Pixel,0) THEN
        jz      Zbit2
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit2:
        SUB     EDI,4
        test    Al,&B00000100             'IF bit(Pixel,0) THEN
        jz      Zbit3
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit3:
        SUB     EDI,4
        test    Al,&B00001000             'IF bit(Pixel,0) THEN
        jz      Zbit4
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit4:
        SUB     EDI,4
        test    Al,&B00010000             'IF bit(Pixel,0) THEN
        jz      Zbit5
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit5:
        SUB     EDI,4
        test    Al,&B00100000             'IF bit(Pixel,0) THEN
        jz      Zbit6
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit6:
        SUB     EDI,4
        test    Al,&B01000000             'IF bit(Pixel,0) THEN
        jz      Zbit7
        mov     EBX,[Colour]
        mov     [EDI],EBX
        Zbit7:
        SUB     EDI,4
        test    Al,&B10000000             'IF bit(Pixel,0) THEN
        jz      ZEndRow
        mov     EBX,[Colour]
        mov     [EDI],EBX
        ZEndRow:
        inc     ESI
        ADD     EDI,2588           'add 647 * 4 four bytes per pixel
    Loop    ZPrintRow
    ZExitPut:

    MOV     EBX,[EBX_Temp]
    MOV     ECX,[ECX_Temp]
    
    INC     EBX
    CMP     EBX,ECX
    JZ      ZExitPrint
    MOV     [EBX_Temp],EBX
    MOV     EBX,[FontVarLenPtr]
    MOV     ESI,[ESI_Temp]
    MOV     EAX,0
    MOV     AL,[ESI]
    ADD     EBX,EAX
    MOV     al,[EBX]
    ADD     [X%], EAX
    'ADD     [X%], DWORD PTR 9    
    MOV     EBX,[EBX_Temp]
    MOV     ESI,[ESI_Temp%]
    INC     ESI
    JMP     ZGetChar
    ZExitPrint:
END ASM
SCREENUNLOCK
END SUB

SUB LoadVarFont(FontFile$)
    FF& = FREEFILE
    OPEN FontFile$ FOR BINARY AS #FF&
    GET #FF&,,FontVar()
    CLOSE #FF&
END SUB

SUB LoadVarFnt(FontFile$)
    FF& = FREEFILE
    OPEN FontFile$ FOR BINARY AS #FF&
    GET #FF&,,FontVarLen()
    CLOSE #FF&
END SUB

SUB Sync()
IF FullScreen% = 1 THEN
    SCREENSYNC
    SCREENLOCK
    xbr_filter_xbr2x(XbrParmPtr)
    SCREENUNLOCK
END IF
END SUB

SUB CCLS(BYVAL COLOUR%)
    SCREENLOCK

    ASM
        CLD
        MOV     EDI,[VideoPtr]
        Mov     ECX, 307200
        Mov     EAX,[Colour%]
        rep     stosd
    END ASM
    SCREENSYNC
    SCREENUNLOCK
END SUB


Problem:
ErrorNumber% = ERR
ErrorLine% = ERL
DIM ProgError$(17)

ProgError$(0) = "No error"
ProgError$(1) = "Illegal function call"
ProgError$(2) = "File not found signal"
ProgError$(3) = "File I/O error"
ProgError$(4) = "Out of memory"
ProgError$(5) = "Illegal resume"
ProgError$(6) = "Out of bounds array access"
ProgError$(7) = "Null Pointer Access"
ProgError$(8) = "No privileges"
ProgError$(9) = "interrupted signal"
ProgError$(10) = "illegal instruction signal"
ProgError$(11) = "floating point error signal "
ProgError$(12) = "segmentation violation signal"
ProgError$(13) = "Termination request signal"
ProgError$(14) = "abnormal termination signal"
ProgError$(15) = "quit request signal"
ProgError$(16) = "return without gosub"
ProgError$(17) = "end of file"


LogFile% = FREEFILE
OPEN "WinTutor-Error.log" FOR APPEND AS #LogFile%
PRINT #LogFile%,"ERROR = ";ProgError$(ErrorNumber%); " on line ";ErrorLine%
Print #LogFile%,"Error Function: "; *Erfn()
CLOSE #LogFile%
CLS

PRINT "ERROR = ";ProgError$(ErrorNumber%); " on line ";ErrorLine%
Print "Error Function: "; *Erfn()

SLEEP

END

Code to fine tune the font spacing.

Code: Select all

'-------------------------------------------------------------
'
'                        By Randall Glass
'
'                 Donated to Public Domain
'
'-------------------------------------------------------------

#LANG "fblite"

DIM Font(0 TO 255) AS UBYTE

FOR I% = 0 TO 175    
    Font(I%) = 9
NEXT I%

FOR I% = 176 TO 223
    Font(I%) = 8
NEXT I% 

FOR I% = 224 TO 255
    Font(I%) = 9
NEXT I% 



Font(ASC("I")) = 5
Font(ASC("T")) = 7
Font(ASC("Y")) = 7
Font(ASC("a")) = 8
Font(ASC("f")) = 7
Font(ASC("i")) = 6
Font(ASC("j")) = 7
Font(ASC("i")) = 6
Font(ASC("j")) = 7
Font(ASC("l")) = 6
Font(ASC("v")) = 10
Font(ASC("!")) = 7
Font(ASC("'")) = 6
Font(ASC("(")) = 7
Font(ASC(")")) = 7
Font(ASC(",")) = 6
Font(ASC(".")) = 7
Font(ASC(":")) = 7
Font(ASC(" ")) = 7


FF& = FREEFILE
OPEN "Win-Var.fnt" FOR BINARY AS #FF&
PUT #FF&,,Font()
CLOSE #FF&

Post Reply