Font Module for games

[coco2]

I've created a small font module that takes either installed fonts or a font file and converts it to sprites for use in games. It is a bit limited in that you can't change the colour or size of the font unless you create a whole other set of sprites in that colour or size. To optimise this I have allowed the creation of only selected parts of the font like the numbers only or uppercase etc, or even just selected characters. My only problem with it is that is a bit slow. Does anyone know how to optimise DisplayStringSprite in particular?

UPDATED 20231127: added optimisation for displaying strings (20-25% improvement)
UPDATED 20231129: added further optimisation for displaying strings (further 20-25% improvement)

Module:

Code: Select all

EnableExplicit

DeclareModule Fonts
  
  #Max_Fonts = 10
  #Font_Num_ASCII_Characters = 125
  
  #Font_Num_Characters = 95
  #Font_Num_Characters_Numbers = 10
  #Font_Num_Characters_Uppercase = 26
  #Font_Num_Characters_Lowercase = 26
  #Font_Num_Characters_Symbol = 33
  
  #Font_Characters_Select = 1 ; used if you just want to select a few
  #Font_Characters_Numbers = 2
  #Font_Characters_Uppercase = 4
  #Font_Characters_Lowercase = 8
  #Font_Characters_Symbol_1 = 16
  #Font_Characters_Symbol_2 = 32
  #Font_Characters_Symbol_3 = 64
  #Font_Characters_Symbol_4 = 128
  #Font_Characters_All = 256
  
  Structure Text_Array_Structure
    Index.u[0]
  EndStructure
  
  Structure Font_Character_Structure
    Sprite_ID.i
    Image_ID.i
    Width.i
    Height.i
    Loaded.i
  EndStructure
  
  Structure Font_Structure
    Name.s
    Filename.s
    Size.i
    Character.Font_Character_Structure[#Font_Num_Characters]
    Crop_Top_Ratio.d
    Crop_Bottom_Ratio.d
    Crop_Left_Ratio.d
    Crop_Right_Ratio.d    
    Colour.i
    Back_Colour.i
    Available.i ; 0 = select, 1 = numbers, 2 = uppercase, 4 = lowercase, 8 = symbol 1, 16 = symbol 2, 32 = symbol 3, 64 = symbol 4, 128 = all
    Select_Available.s
    Border.i
    Border_Colour.i
    Loaded.i
  EndStructure
  
  Dim *Fonts.Font_Structure(#Max_Fonts)
  Global Dim Characters.i(#Font_Num_ASCII_Characters)
    
  Declare Initialise(Array *Fonts.Font_Structure(1))
  Declare.s GetChar(Char.i)
  Declare.i GetCharNum(Char.s)
  Declare.i GetNum(ASCII.i)
  Declare.i CreateFont(Array *Fonts.Font_Structure(1), Font_ID.i, Flags.i=0)
  Declare.i GetCharacterWidth(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s)
  Declare.i GetCharacterHeight(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s)
  Declare DisplayCharacterSprite(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s, x.i, y.i)
  Declare DisplayCharacterImage(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s, x.i, y.i)
  Declare DisplayStringSprite(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s, x.i, y.i, Spacing.i=0)
  Declare DisplayStringImage(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s, x.i, y.i, Spacing.i=0)
  Declare.i GetStringWidth(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s)
  Declare Shutdown(Array *Fonts.Font_Structure(1))
  
EndDeclareModule

Module Fonts
  
  Procedure Initialise(Array *Fonts.Font_Structure(1))
    Protected.i c
    Protected.i Ch
    For c = 0 To #Max_Fonts
      *Fonts(c) = AllocateStructure(Font_Structure)
    Next c
    Restore Font_Character_ASCII_Map
    For c = 0 To #Font_Num_ASCII_Characters
      Read.i Ch
      Characters(c) = Ch
    Next c
  EndProcedure
  
  Procedure.s GetChar(Char.i)
    Select Char
      Case 0 To 9: ProcedureReturn(Chr(48+Char))
      Case 10 To 35: ProcedureReturn(Chr(55+Char))
      Case 36 To 61: ProcedureReturn(Chr(61+Char))  
      Case 62 To 77: ProcedureReturn(Chr(Char-30))
      Case 78 To 84: ProcedureReturn(Chr(Char-20))
      Case 85 To 90: ProcedureReturn(Chr(6+Char))
      Case 91 To 94: ProcedureReturn(Chr(32+Char))
    EndSelect
  EndProcedure 
  
  Procedure.i GetCharNum(Char.s)
    Protected ASCII.i = Asc(Char)
    Select ASCII
      Case 48 To 57:ProcedureReturn(ASCII-48)
      Case 65 To 90:ProcedureReturn(ASCII-55)
      Case 97 To 122:ProcedureReturn(ASCII-61)
      Case 32 To 47:ProcedureReturn(ASCII+30)
      Case 58 To 64:ProcedureReturn(ASCII+20)
      Case 91 To 96:ProcedureReturn(ASCII-6)
      Case 123 To 126:ProcedureReturn(ASCII-32)
    EndSelect
  EndProcedure 
  
  Procedure.i GetNum(ASCII.i)
    Select ASCII
      Case 48 To 57:ProcedureReturn(ASCII-48)
      Case 65 To 90:ProcedureReturn(ASCII-55)
      Case 97 To 122:ProcedureReturn(ASCII-61)
      Case 32 To 47:ProcedureReturn(ASCII+30)
      Case 58 To 64:ProcedureReturn(ASCII+20)
      Case 91 To 96:ProcedureReturn(ASCII-6)
      Case 123 To 126:ProcedureReturn(ASCII-32)
    EndSelect
  EndProcedure    
  
  Procedure.i CheckCreateCharacter(Array *Fonts.Font_Structure(1), Font_ID.i, c.i)
    ; Checks whether to create the character based on the settings provided
    Protected.i Result = 0
    If *Fonts(Font_ID)\Available & #Font_Characters_Select
      If FindString(*Fonts(Font_ID)\Select_Available, GetChar(c)):Result = 1:EndIf
    EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Numbers And c>=0 And c<=9:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Uppercase And c>=10 And c<=35:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Lowercase And c>=36 And c<=61:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Symbol_1 And c>=62 And c<=77:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Symbol_2 And c>=78 And c<=84:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Symbol_3 And c>=85 And c<=90:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_Symbol_4 And c>=91 And c<=94:Result = 1:EndIf
    If *Fonts(Font_ID)\Available & #Font_Characters_All:Result = 1:EndIf
    ProcedureReturn Result
  EndProcedure  
  
  Procedure.i CreateFont(Array *Fonts.Font_Structure(1), Font_ID.i, Flags.i=0)
    Protected Char.s
    Protected c.i
    Protected Crop_Left.i
    Protected Crop_Right.i
    Protected Crop_Top.i
    Protected Crop_Bottom.i    
    If *Fonts(Font_ID)\Filename <> ""
      If FileSize(*Fonts(Font_ID)\Filename) = -1
        Debug "Font file does not exist: " + *Fonts(Font_ID)\Filename
        ProcedureReturn 0
      EndIf
      RegisterFontFile(*Fonts(Font_ID)\Filename)
    EndIf
    LoadFont(Font_ID, *Fonts(Font_ID)\Name, *Fonts(Font_ID)\Size, Flags)
    Restore Font_Characters_Numbers
    For c = 0 To #Font_Num_Characters-1
      Read.s Char
      If CheckCreateCharacter(*Fonts(), Font_ID, c)
        ; create temp image so that the font can be selected
        Temp_Image = CreateImage(#PB_Any, 1, 1, 32)
        StartDrawing(ImageOutput(Temp_Image))
        DrawingFont(FontID(Font_ID))
        *Fonts(Font_ID)\Character[c]\Width = TextWidth(Char)
        *Fonts(Font_ID)\Character[c]\Height = TextHeight(Char)
        StopDrawing()
        FreeImage(Temp_Image)
        If *Fonts(Font_ID)\Crop_Top_Ratio > 0  And *Fonts(Font_ID)\Crop_Top_Ratio < 1
          Crop_Top = *Fonts(Font_ID)\Character[c]\Height * *Fonts(Font_ID)\Crop_Top_Ratio
        EndIf
        If *Fonts(Font_ID)\Crop_Bottom_Ratio > 0  And *Fonts(Font_ID)\Crop_Bottom_Ratio < 1
          Crop_Bottom = *Fonts(Font_ID)\Character[c]\Height * *Fonts(Font_ID)\Crop_Bottom_Ratio
        EndIf
        If *Fonts(Font_ID)\Crop_Left_Ratio > 0  And *Fonts(Font_ID)\Crop_Left_Ratio < 1
          Crop_Left = *Fonts(Font_ID)\Character[c]\Width * *Fonts(Font_ID)\Crop_Left_Ratio
        EndIf
        If *Fonts(Font_ID)\Crop_Right_Ratio > 0 And *Fonts(Font_ID)\Crop_Right_Ratio < 1
          Crop_Right = *Fonts(Font_ID)\Character[c]\Width * *Fonts(Font_ID)\Crop_Right_Ratio
        EndIf
        *Fonts(Font_ID)\Character[c]\Width = *Fonts(Font_ID)\Character[c]\Width - (Crop_Left + Crop_Right)
        *Fonts(Font_ID)\Character[c]\Height = *Fonts(Font_ID)\Character[c]\Height - (Crop_Top + Crop_Bottom)        
        *Fonts(Font_ID)\Character[c]\Sprite_ID = CreateSprite(#PB_Any, *Fonts(Font_ID)\Character[c]\Width, *Fonts(Font_ID)\Character[c]\Height, #PB_Sprite_AlphaBlending)
        If Not *Fonts(Font_ID)\Character[c]\Sprite_ID
          Debug "CreateFont: sprite creation failed"
          Debug "It must be run after the following:"
          Debug "- InitSprite()"
          Debug "- OpenScreen() or OpenWindowedScreen()"
          ProcedureReturn 0
        EndIf
        If StartDrawing(SpriteOutput(*Fonts(Font_ID)\Character[c]\Sprite_ID))
          DrawingMode(#PB_2DDrawing_AllChannels)
          DrawingFont(FontID(Font_ID))
          DrawText(-Crop_Left, -Crop_Top, Char, *Fonts(Font_ID)\Colour, *Fonts(Font_ID)\Back_Colour)
          If *Fonts(Font_ID)\Border
            DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
            Box(0, 0, *Fonts(Font_ID)\Character[c]\Width, *Fonts(Font_ID)\Character[c]\Height, *Fonts(Font_ID)\Border_Colour)
          EndIf
          StopDrawing()
        EndIf  
        *Fonts(Font_ID)\Character[c]\Image_ID = CreateImage(#PB_Any, *Fonts(Font_ID)\Character[c]\Width, *Fonts(Font_ID)\Character[c]\Height, 32)          
        If StartDrawing(ImageOutput(*Fonts(Font_ID)\Character[c]\Image_ID))
          DrawingMode(#PB_2DDrawing_AllChannels)
          DrawingFont(FontID(Font_ID))
          DrawText(-Crop_Left, -Crop_Top, Char, *Fonts(Font_ID)\Colour, *Fonts(Font_ID)\Back_Colour)
          If *Fonts(Font_ID)\Border
            DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
            Box(0, 0, *Fonts(Font_ID)\Character[c]\Width, *Fonts(Font_ID)\Character[c]\Height, *Fonts(Font_ID)\Border_Colour)
          EndIf
          StopDrawing()          
        EndIf
        *Fonts(Font_ID)\Character[c]\Loaded = 1
      EndIf
      *Fonts(Font_ID)\Loaded = 1
    Next c
    ProcedureReturn 1
  EndProcedure
  
  Procedure DisplayCharacterSprite(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s, x.i, y.i)
    Protected ASCII.i = Asc(Char)
    Protected.i CharNum = GetCharNum(Char)
    If *Fonts(Font_ID)\Character[CharNum]\Loaded
      DisplayTransparentSprite(*Fonts(Font_ID)\Character[CharNum]\Sprite_ID, x, y)
    EndIf
  EndProcedure
  
  Procedure DisplayCharacterImage(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s, x.i, y.i)
    ; draws a character to the output as an image
    Protected.i ASCII = Asc(Char)
    Protected.i CharNum = GetCharNum(Char)
    If *Fonts(Font_ID)\Character[CharNum]\Loaded
      DrawAlphaImage(ImageID(*Fonts(Font_ID)\Character[CharNum]\Image_ID), x, y)
    EndIf
  EndProcedure  
  
  Procedure.i GetCharacterWidth(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s)
    Protected.i ASCII = Asc(Char)
    Protected.i Return_Width = 0
    Protected.i CharNum = GetCharNum(Char)
    If *Fonts(Font_ID)\Character[CharNum]\Loaded
      Return_Width = *Fonts(Font_ID)\Character[CharNum]\Width
    Else
      Return_Width = 0
    EndIf
    ProcedureReturn Return_Width
  EndProcedure
  
  Procedure.i GetCharacterHeight(Array *Fonts.Font_Structure(1), Font_ID.i, Char.s)
    Protected.i ASCII = Asc(Char)
    Protected.i CharNum = GetCharNum(Char)
    Protected.i Return_Height = 0
    If *Fonts(Font_ID)\Character[CharNum]\Loaded
      Return_Height = *Fonts(Font_ID)\Character[CharNum]\Height
    Else
      Return_Height = 0
    EndIf
    ProcedureReturn Return_Height
  EndProcedure    
  
  Procedure DisplayStringSprite(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s, x.i, y.i, Spacing.i=0)
    ; Displays the string on the screen using sprites
    ; Spacing is used to monospace the text
    Protected.i ASCII
    Protected.i Width
    Protected.i CharNum
    Protected.i i
    Protected *Text_Array.Text_Array_Structure = @Text
    For i = 0 To Len(Text)-1
      ASCII = *Text_Array\Index[i]
      ;CharNum = GetNum(ASCII)
      ;Debug Chr(ASCII) + " - " + ASCII
      CharNum = Characters(ASCII)
      If *Fonts(Font_ID)\Character[CharNum]\Loaded
        DisplayTransparentSprite(*Fonts(Font_ID)\Character[CharNum]\Sprite_ID, x, y)
        Width = *Fonts(Font_ID)\Character[CharNum]\Width
      EndIf
      If Spacing > 0
        x = x + Spacing
      Else
        x = x + Width
      EndIf
    Next i
  EndProcedure
  
  Procedure DisplayStringImage(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s, x.i, y.i, Spacing.i=0)
    ; Displays the string to the output using images
    ; Spacing is used to monospace the text
    Protected.s Char
    Protected.i Width
    Protected.i CharNum
    Protected *Text_Array.Text_Array_Structure = @Text    
    For i = 1 To Len(Text)
      ;Char = Mid(Text, i, 1)
      ASCII = *Text_Array\Index[i]
      CharNum = GetNum(ASCII)
      If *Fonts(Font_ID)\Character[CharNum]\Loaded
        DrawAlphaImage(ImageID(*Fonts(Font_ID)\Character[CharNum]\Image_ID), x, y)
        Width = *Fonts(Font_ID)\Character[CharNum]\Width
      EndIf
      If Spacing > 0
        x = x + Spacing
      Else
        x = x + Width
      EndIf
    Next i    
  EndProcedure 
  
  Procedure.i GetStringWidth(Array *Fonts.Font_Structure(1), Font_ID.i, Text.s)
    Protected.i Return_Width = 0
    Protected.s Char
    Protected.i CharNum
    Protected.i i
    Return_Width = 0
    For i = 1 To Len(Text)
      Char = Mid(Text, i, 1)
      CharNum = GetCharNum(Char)      
      If *Fonts(Font_ID)\Character[CharNum]\Loaded
        Return_Width = Return_Width + *Fonts(Font_ID)\Character[CharNum]\Width
      EndIf
    Next i
    ProcedureReturn Return_Width
  EndProcedure  
  
  Procedure Shutdown(Array *Fonts.Font_Structure(1))
    ; Note: the screen needs to be open for this to work
    Protected.i c1
    Protected.i c2
    For c1 = 0 To #Max_Fonts
      For c2 = 0 To #Font_Num_Characters-1
        If *Fonts(c1)\Character[c2]\Loaded
          FreeSprite(*Fonts(c1)\Character[c2]\Sprite_ID)
          FreeImage(*Fonts(c1)\Character[c2]\Image_ID)
        EndIf
      Next c2
      If *Fonts(c1)\Loaded:FreeFont(c1):EndIf
      FreeStructure(*Fonts(c1))
    Next c1
  EndProcedure
  
  CompilerIf #PB_Compiler_IsMainFile
    ; Test code
    Define.i Window_Width = 800
    Define.i Window_Height = 800
    Define.i Char_Height
    Initialise(*Fonts())
    InitSprite()
    If OpenWindow(0, 0, 0, Window_Width, Window_Height, "Fonts Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
      If OpenWindowedScreen(WindowID(0), 0, 0, Window_Width*DesktopResolutionX(), Window_Height*DesktopResolutionY())
        With *Fonts(0)
          \Name = "Arial" ; if you don't specify a filename it will use an inbuilt font by the nearest name given
          \Size = 24
          \Colour = RGBA(0, 128, 255, 255)
          \Back_Colour = RGBA(0, 0, 0, 0)
          \Available = #Font_Characters_All
          \Border = 0
          \Border_Colour = RGBA(255, 255, 255, 255)
        EndWith
        If CreateFont(*Fonts(), 0, #PB_Font_Bold)
          Char_Height = GetCharacterHeight(*Fonts(), 0, "A")
          DisplayStringSprite(*Fonts(), 0, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", 0, 0)
          DisplayStringSprite(*Fonts(), 0, "abcdefghijklmnopqrstuvwxyz !"+#DQUOTE$+"#$%&'()*+,-./", 0, Char_Height)
          DisplayStringSprite(*Fonts(), 0, ":;<=>?@[\]^_`{|}", 0, 2*Char_Height)
          ;StartDrawing(ScreenOutput())
          ;DisplayStringImage(*Fonts(), 0, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", 0, 0)
          ;StopDrawing()
        EndIf  
        ;With *Fonts(1)
        ;  \Name = "Afacad Bold"
        ;  \Filename = "Data\Fonts\Afacad\fonts\ttf\Afacad-Bold.ttf"        
        ;  \Size = 24
        ;  \Colour = RGBA(255, 128, 0, 255)
        ;  \Back_Colour = RGBA(0, 0, 0, 0)
        ;  \Available = #Font_Characters_All
        ;  ;\Available = #Font_Characters_Select
        ;  ;\Select_Available = "123"
        ;  \Border = 0
        ;  \Border_Colour = RGBA(255, 255, 255, 255)
        ;EndWith
        ;If CreateFont(*Fonts(), 1)
        ;  DisplayStringSprite(*Fonts(), 1, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", 0, 40)
        ;EndIf
		    Repeat
			    Event = WaitWindowEvent()
		    Until Event = #PB_Event_CloseWindow
	    EndIf
    EndIf
    Shutdown(*Fonts())
    CloseScreen()
  CompilerEndIf
  
  DataSection
    Font_Characters_Numbers:
    Data.s "0","1","2","3","4","5","6","7","8","9" ; 0-9
    Font_Characters_Alphabetic_Uppercase:
    Data.s "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z" ; 10-35
    Font_Characters_Alphabetic_Lowercase:
    Data.s "a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z" ; 36-61
    Font_Characters_Symbol_1:
    Data.s " ","!",#DQUOTE$,"#","$","%","&","'","(",")","*","+",",","-",".","/" ; 62-77
    Font_Characters_Symbol_2:
    Data.s ":",";","<","=",">","?","@" ; 78-84
    Font_Characters_Symbol_3:
    Data.s "[","\","]","^","_","`" ; 85-90
    Font_Characters_Symbol_4:
    Data.s "{","|","}","~" ; 91-94
    Font_Character_ASCII_Map:
    Data.i 000, 000, 000, 000, 000, 000, 000, 000, 000, 000 ;9
    Data.i 000, 000, 000, 000, 000, 000, 000, 000, 000, 000 ;19
    Data.i 000, 000, 000, 000, 000, 000, 000, 000, 000, 000 ;29
    Data.i 000, 000, 062, 063, 064, 065, 066, 067, 068, 069 ;39
    Data.i 070, 071, 072, 073, 074, 075, 076, 077, 000, 001 ;49
    Data.i 002, 003, 004, 005, 006, 007, 008, 009, 078, 079 ;59
    Data.i 080, 081, 082, 083, 084, 010, 011, 012, 013, 014 ;69
    Data.i 015, 016, 017, 018, 019, 020, 021, 022, 023, 024 ;79
    Data.i 025, 026, 027, 028, 029, 030, 031, 032, 033, 034 ;89
    Data.i 035, 085, 086, 087, 088, 089, 090, 036, 037, 038 ;99
    Data.i 039, 040, 041, 042, 043, 044, 045, 046, 047, 048 ;109
    Data.i 049, 050, 051, 052, 053, 054, 055, 056, 057, 058 ;119
    Data.i 059, 060, 061, 091, 092, 093, 094 ;126
    
  EndDataSection
  
EndModule

Speed testing:

Code: Select all

; Test font speed
EnableExplicit
XIncludeFile "..\Fonts.pb"
Define.i Width = 800
Define.i Height = 800
Define.i Event
Define.i c
Define.i x
Define.q Time_Start
Define.i Str_Width
Define.i Str_Height
Define.q Time
Define.d Total_Time
Define.d Average_Time
Fonts::Initialise(Fonts::*Fonts())
InitSprite()
If OpenWindow(0, 0, 0, Width, Height, "Test Debug", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If OpenWindowedScreen(WindowID(0), 0, 0, Width*DesktopResolutionX(), Height*DesktopResolutionY(), #False, 0, 0, #PB_Screen_WaitSynchronization)
    With Fonts::*Fonts(0)
      \Name = "Arial"
      ;\Filename = ""        
      \Size = 36
      \Colour = RGBA(255, 0, 0, 255)
      \Back_Colour = RGBA(0, 0, 0, 0)
      \Available = Fonts::#Font_Characters_All
      \Border = 0
    EndWith
    With Fonts::*Fonts(1)
      \Name = "Arial"
      ;\Filename = ""        
      \Size = 36
      \Colour = RGBA(0, 255, 0, 255)
      \Back_Colour = RGBA(0, 0, 0, 0)
      \Available = Fonts::#Font_Characters_All
      \Border = 0
    EndWith
    With Fonts::*Fonts(2)
      \Name = "Arial"
      ;\Filename = ""        
      \Size = 36
      \Colour = RGBA(0, 0, 255, 255)
      \Back_Colour = RGBA(0, 0, 0, 0)
      \Available = Fonts::#Font_Characters_All
      \Border = 0
    EndWith    
    Fonts::CreateFont(Fonts::*Fonts(), 0, #PB_Font_Bold)
    Fonts::CreateFont(Fonts::*Fonts(), 1, #PB_Font_Bold)
    Fonts::CreateFont(Fonts::*Fonts(), 2, #PB_Font_Bold)
    Str_Width = Fonts::GetStringWidth(Fonts::*Fonts(), 0, "0123456789")
    Str_Height = Fonts::GetCharacterHeight(Fonts::*Fonts(), 0, "0")      
    Time_Start = ElapsedMilliseconds()
    For c = 1 To 2000
      Fonts::DisplayStringSprite(Fonts::*Fonts(), Random(2, 0), "0123456789", Random(Width-Str_Width, 0),  Random(Height-Str_Height, 0))  
    Next c
    Time = ElapsedMilliseconds() - Time_Start
    Debug "Time: " + Str(Time) + " ms"
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    Fonts::Shutdown(Fonts::*Fonts())
    CloseScreen()
  EndIf
EndIf

[idle]

Get rid of mid use a structure array

Code: Select all

structure arA
  Index.u[0]
EndStructure

*ar.arA = @string 

 X  = *ar\index[pos]

loop while *ar\index[pos] <> 0

I'm on phone can fix in morning

[coco2]

Thank you, I implemented it and got 27% speed increase.

[idle]

Probably a lot more you can do to. 27% is Already a good improvement

[coco2]

It's good but I actually wish it could be better. When I display a "debug" panel on my game with a lot of text it struggles on slower systems, even pushing it below 60 FPS.

[idle]

You can get it a lot faster, I will look in the morning.

[STARGÅTE]

When I look to your example, you try to render 20000 sprites (10 for each string in the for-loop).
This is a lot, when they are drawn individually instead of a mesh like in 3D engines. Decreasing frame rate is normal I guess.

[idle]

it looks ok but why not just use and array of 256 elements for a direct mapping so a valid char returns the sprite or 0
getting rid of the select an If's will give you a lot more speed.

[coco2]

Do you mean map the array to ASCII values?

[idle]

I mean just make it, *Character.Font_Character_Structure[#Font_Characters_All]
and allocate the pointer for the valid characters allocatememory(sizeof(Font_Character_Structure))
then you look up is simply the if font\Character.Font_Character_Structure[char]

Code: Select all

Structure Font_Character_Structure
    Sprite_ID.i
    Image_ID.i
    Width.i
    Height.i
    Loaded.i
  EndStructure
  
  Structure Font_Structure
    Name.s
    Filename.s
    Size.i
    *Character.Font_Character_Structure[256]
    Crop_Top_Ratio.d
    Crop_Bottom_Ratio.d
    Crop_Left_Ratio.d
    Crop_Right_Ratio.d    
    Colour.i
    Back_Colour.i
    Available.i ; 0 = select, 1 = numbers, 2 = uppercase, 4 = lowercase, 8 = symbol 1, 16 = symbol 2, 32 = symbol 3, 64 = symbol 4, 128 = all
    Select_Available.s
    Border.i
    Border_Colour.i
    Loaded.i
  EndStructure
  
  Global Dim Fonts.Font_Structure(10)
  
  For a = 32 To 56 
    fonts(0)\Character[a] = AllocateMemory(SizeOf(Font_Character_Structure))   
    fonts(0)\Character[a]\Sprite_ID  = a *100    ;create the sprite and set its info 
  Next 
  For a = 65 To 89  
    fonts(0)\Character[a] = AllocateMemory(SizeOf(Font_Character_Structure)) 
    fonts(0)\Character[a]\Sprite_ID  = a *100    
  Next   
     
  str.s = "ABC123abcEFG !$<>"     ;input string abc arn't valid  
  
  *pchar.Unicode= @str             ;parse the sting by pointer 
    
  While *pchar\u <> 0                ;loop until null char 
    If fonts(0)\Character[*pchar\u] 
      Debug fonts(0)\Character[*pchar\u]\Sprite_ID 
      Debug Chr(*pchar\u) 
    EndIf 
    *pchar + 2 
  Wend   
  

this way you don't need to mess about with getnum(ascii) just look it up in the pointer array

[idle]

The actual limit you have is DisplayTransparentSprite itself, the sting manipulation is only a small proportion of it.
so test case and doing 2,000 iterations the optimized version is 24ms vs 34ms, 10ms difference isn't really going to make any real difference as you not going to display 20,000 sprites at once.

[coco2]

On a 3D game with a 2D overlay you aren't going to use more than about 300 characters in realtime (ie when you switch to dialog it doesn't matter what the frame rate is, but I'm talking about 2D overlays while playing in 3D). Even with just 300 characters on a slower laptop it really struggles, I'm not sure where the bottleneck is.

[STARGÅTE]

Even with just 300 characters on a slower laptop it really struggles, I'm not sure where the bottleneck is.

Your code struggles with just 300 characters?
When I run your code, it takes 12 ms to display your 20000 characters. However, I use a modern desktop PC.

You can also try to use my code Typeface - Sprite-based font include/module. In this thread I also performed a benchmark, showing 80 FPS while showing 18000 characters [here].

[Kuron]

Even with just 300 characters on a slower laptop it really struggles, I'm not sure where the bottleneck is.

Damn, even on my lower end laptop with some code I have been playing with in another language, that I wrote 9+ years back, purely using GDI, I have 100,000 sprites bouncing around and I am getting 25 FPS. Speed boost is because I am using ASM to do the blitting. I can do 500,000 sprites on the same system and get 12 FPS. No DX, No GL, No GDI+. Pure GDI & ASM for blitting.

[coco2]

I implemented the Character array and it got a further 23% speed increase. I'm surprised just a regular procedure returning a value causes that much slowness.

EDIT: just to give you an idea of the speed of my lower end laptop, it does 20,000 characters in 463 ms but my desktop PC does it in 30 ms. So I am trying to get as much performance as possible when drawing a lot of characters for the lower end PCs.