Structure TypefaceDX9Vertex
 x.f
 y.f
 z.f
 rhw.f
 Color.l
 tu.f
 tv.f
EndStructure  

Structure TypefaceDX9
 TexRes.i
 Vertice.TypefaceDX9Vertex[4]
 TmpVertice.TypefaceDX9Vertex[4]
 Width.l
 Height.l
 RealWidth.l
 RealHeight.l
 Angle.f
 Transformed.l
EndStructure

Structure TypefaceCharacterArea
 x.i
 y.i
 Width.i
 Height.i
EndStructure

Structure TypefaceCharacterCorner
 x1.f
 y1.f
 x2.f
 y2.f
 Width.i
 Height.i
EndStructure

Structure TypefaceCharacter
 Exists.i
 Outlay.TypefaceCharacterArea
 Source.TypefaceCharacterCorner
EndStructure

Structure TypefaceCharacterSet
 Sprite.i
 Sprite3D.i
 *DX9.TypefaceDX9
 Character.TypefaceCharacter[256]
EndStructure

Structure TypefaceStyle
 Size.f
 Transparency.i
 Color.i
 Angle.f
 Turn.f
 Align.f
 VAlign.f
 Italic.f
EndStructure

Structure Typeface
 Variation.i
 Typeface.i
 *CharacterSet.TypefaceCharacterSet
 Style.TypefaceStyle
EndStructure

Structure TypefaceBuffer
 Index.w
 OutlayX.w
 OutlayY.w
 OutlayWidth.w
 OutlayHeight.w
 SourceX.w
 SourceY.w
 SourceWidth.w
 SourceHeight.w
EndStructure




Global NewList TypefaceCharacterSet.TypefaceCharacterSet()

Global NewList Typeface.Typeface()
Global Dim *Typeface.Typeface(0)



#TypefaceMagicNumber  = $7C30302E317C8354 ; PeekQ(@"Tƒ|1.00|")

#MaxTypefaceNumber = $FFFF
#NotTypefaceNumber = ~#MaxTypefaceNumber



 
Procedure.i TypefaceID(Typeface.i)
 If Typeface & #NotTypefaceNumber
  ProcedureReturn Typeface
 Else
  ProcedureReturn *Typeface(Typeface)
 EndIf
EndProcedure
 
 
   
Procedure.i FreeTypeface(Typeface.i)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 With *Typeface
  If Not \Typeface & #NotTypefaceNumber
   *Typeface(\Typeface) = 0
  EndIf
  If Not \Variation
   ChangeCurrentElement(TypefaceCharacterSet(), \CharacterSet)
   FreeSprite3D(\CharacterSet\Sprite3D)
   FreeSprite(\CharacterSet\Sprite)
   DeleteElement(TypefaceCharacterSet())
  EndIf   
  ChangeCurrentElement(Typeface(), *Typeface)
  DeleteElement(Typeface())
 EndWith   
EndProcedure
 
 
 
Procedure.i CreateTypefaceVariation(Typeface.i, MasterTypeface.i)
 Protected *Typeface.Typeface = AddElement(Typeface())
 If Typeface = #PB_Any
  Typeface = *Typeface
 ElseIf Typeface & #NotTypefaceNumber
  ProcedureReturn #False
 Else
  If ArraySize(*Typeface()) < Typeface 
   ReDim *Typeface(Typeface)
  ElseIf *Typeface(Typeface)
   FreeTypeface(*Typeface(Typeface))
  EndIf
  *Typeface(Typeface) = *Typeface
 EndIf
 Protected *MasterTypeface.Typeface = TypefaceID(MasterTypeface)
 With *Typeface
  CopyStructure(*MasterTypeface\Style, \Style, TypefaceStyle)
  \CharacterSet = *MasterTypeface\CharacterSet
  \Variation = #True
  \Typeface = Typeface
 EndWith
 ProcedureReturn *Typeface
EndProcedure



Procedure.i CatchTypeface(Typeface.i, *MemoryBuffer.TypefaceBuffer)
 If PeekQ(*MemoryBuffer) <> #TypefaceMagicNumber
  ProcedureReturn #False
 Else
  *MemoryBuffer + SizeOf(Quad)
 EndIf
 Protected *Typeface.Typeface = AddElement(Typeface())
 Protected Index
 If Typeface = #PB_Any
  Typeface = *Typeface
 ElseIf Typeface & #NotTypefaceNumber
  ProcedureReturn #False
 Else
  If ArraySize(*Typeface()) < Typeface 
   ReDim *Typeface(Typeface)
  ElseIf *Typeface(Typeface)
   FreeTypeface(*Typeface(Typeface))
  EndIf
  *Typeface(Typeface) = *Typeface
 EndIf
 With *Typeface
  \Typeface = Typeface
  \Variation = #False
  \CharacterSet = AddElement(TypefaceCharacterSet())
 EndWith
 With *Typeface\Style
  \Size          = 1.0
  \Color         = $FFFFFF
  \Transparency  = 255
  \Angle         = 0
  \Turn          = 0
  \Align         = 0
  \VAlign        = 0
 EndWith
 While *MemoryBuffer\Index
  With *Typeface\CharacterSet\Character[*MemoryBuffer\Index]
   \Exists        = #True
   \Outlay\x      = *MemoryBuffer\OutlayX
   \Outlay\y      = *MemoryBuffer\OutlayY
   \Outlay\Width  = *MemoryBuffer\OutlayWidth
   \Outlay\Height = *MemoryBuffer\OutlayHeight
   \Source\x1     = *MemoryBuffer\SourceX
   \Source\y1     = *MemoryBuffer\SourceY
   \Source\x2     = *MemoryBuffer\SourceX + *MemoryBuffer\SourceWidth
   \Source\y2     = *MemoryBuffer\SourceY + *MemoryBuffer\SourceHeight
   \Source\Width  = *MemoryBuffer\SourceWidth
   \Source\Height = *MemoryBuffer\SourceHeight
  EndWith
  *MemoryBuffer + SizeOf(TypefaceBuffer)
 Wend
 With *Typeface\CharacterSet
  \Sprite   = CatchSprite(#PB_Any, *MemoryBuffer+SizeOf(Word), #PB_Sprite_Texture|#PB_Sprite_AlphaBlending)
  \Sprite3D = CreateSprite3D(#PB_Any, \Sprite)
  \DX9 = IsSprite3D(\Sprite3D)
  For Index = 0 To 255
   \Character[Index]\Source\x1 / SpriteWidth(\Sprite)
   \Character[Index]\Source\x2 / SpriteWidth(\Sprite)
   \Character[Index]\Source\y1 / SpriteHeight(\Sprite)
   \Character[Index]\Source\y2 / SpriteHeight(\Sprite)
  Next
 EndWith
 ProcedureReturn *Typeface
EndProcedure
 
 
 
Procedure.i LoadTypeface(Typeface.i, FileName$)
 Protected File, *FileBuffer, *Typeface
 File = ReadFile(#PB_Any, FileName$)
 If File
  *FileBuffer = AllocateMemory(Lof(File))
  If *FileBuffer
   ReadData(File, *FileBuffer, Lof(File))
   *Typeface = CatchTypeface(Typeface, *FileBuffer)
   FreeMemory(*FileBuffer)
   ProcedureReturn *Typeface
  EndIf
  CloseFile(File)
 EndIf
EndProcedure
 

 
Procedure TypefaceColor(Typeface.i, Color.i)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Color = Color
EndProcedure

Procedure TypefaceSize(Typeface.i, Size.f)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Size = Size
EndProcedure

Procedure TypefaceAngle(Typeface.i, Angle.f)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Angle = Angle
EndProcedure

Procedure TypefaceTurn(Typeface.i, Turn.f)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Turn = Turn
EndProcedure

Procedure TypefaceTransparency(Typeface.i, Transparency.i)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Transparency = Transparency
EndProcedure

Procedure TypefaceItalic(Typeface.i, Italic.f)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 *Typeface\Style\Italic = Italic
EndProcedure



Procedure DisplayTypeface(Typeface.i, x.f, y.f, Text$, Transparency.i=#PB_Ignore, Color.i=#PB_Ignore, Size.f=#PB_Ignore, Italic.f=#PB_Ignore)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 Protected *Character.Character = @Text$
 Protected Cos.f, Sin.f
 Protected *DX9.TypefaceDX9 = *Typeface\CharacterSet\DX9
 With *Typeface\Style
  If Transparency < 0 : Transparency = \Transparency : EndIf
  If Size < 0 : Size = \Size : EndIf
  If Color < 0 : Color = \Color : EndIf
  Protected Angle.f = Radian(\Angle)
  Protected Turn.f = Radian(\Turn)
  If Italic < 0 : Italic = \Italic : EndIf : Italic.f = Tan(Radian(Italic))
 EndWith
 Color = Color&$00FF00 + (Color&$FF)<<16 + (Color&$FF0000)>>16
 x - 0.5 : y - 0.5 
 *DX9\Vertice[0]\Color = Color
 *DX9\Vertice[1]\Color = Color
 *DX9\Vertice[2]\Color = Color
 *DX9\Vertice[3]\Color = Color
 *DX9\Transformed = 1
 If Angle Or Turn
  Cos = Cos(Angle)
  Sin = Sin(Angle)
  While *Character\c
   With *Typeface\CharacterSet\Character[*Character\c]
    If \Exists
     *DX9\Vertice[0]\tu = \Source\x1
     *DX9\Vertice[0]\tv = \Source\y1
     *DX9\Vertice[1]\tu = \Source\x2
     *DX9\Vertice[1]\tv = \Source\y1
     *DX9\Vertice[2]\tu = \Source\x1
     *DX9\Vertice[2]\tv = \Source\y2 
     *DX9\Vertice[3]\tu = \Source\x2
     *DX9\Vertice[3]\tv = \Source\y2
     *DX9\Vertice[0]\x = x + ( Cos*(\Outlay\x+\Outlay\Height*Italic) - Sin*\Outlay\y ) * Size
     *DX9\Vertice[0]\y = y + ( Sin*(\Outlay\x+\Outlay\Height*Italic) + Cos*\Outlay\y ) * Size
     *DX9\Vertice[1]\x = *DX9\Vertice[0]\x + \Source\Width*Size*Cos
     *DX9\Vertice[1]\y = *DX9\Vertice[0]\y + \Source\Width*Size*Sin
     *DX9\Vertice[2]\x = x + ( Cos*(\Outlay\x+(\Outlay\Height-\Source\Height)*Italic) - Sin*\Outlay\y ) * Size - \Source\Height*Size*Sin
     *DX9\Vertice[2]\y = y + ( Sin*(\Outlay\x+(\Outlay\Height-\Source\Height)*Italic) + Cos*\Outlay\y ) * Size + \Source\Height*Size*Cos
     *DX9\Vertice[3]\x = *DX9\Vertice[2]\x + \Source\Width*Size*Cos
     *DX9\Vertice[3]\y = *DX9\Vertice[2]\y + \Source\Width*Size*Sin
     DisplaySprite3D(*Typeface\CharacterSet\Sprite3D, 0, 0, Transparency)
    EndIf
    x + \Outlay\Width*Size*Cos
    y + \Outlay\Width*Size*Sin 
    If Turn
     Angle + Turn*\Outlay\Width/\Outlay\Height*Size
     Cos = Cos(Angle)
     Sin = Sin(Angle)
    EndIf
   EndWith
   *Character + SizeOf(Character)
  Wend   
 Else
  While *Character\c
   With *Typeface\CharacterSet\Character[*Character\c]
    If \Exists
     *DX9\Vertice[0]\tu = \Source\x1
     *DX9\Vertice[0]\tv = \Source\y1
     *DX9\Vertice[1]\tu = \Source\x2
     *DX9\Vertice[1]\tv = \Source\y1
     *DX9\Vertice[2]\tu = \Source\x1
     *DX9\Vertice[2]\tv = \Source\y2 
     *DX9\Vertice[3]\tu = \Source\x2
     *DX9\Vertice[3]\tv = \Source\y2
     *DX9\Vertice[0]\x = x+(\Outlay\x+\Outlay\Height*Italic)*Size
     *DX9\Vertice[0]\y = y+\Outlay\y*Size
     *DX9\Vertice[1]\x = *DX9\Vertice[0]\x + \Source\Width*Size
     *DX9\Vertice[1]\y = *DX9\Vertice[0]\y
     *DX9\Vertice[2]\x = x+(\Outlay\x+(\Outlay\Height-\Source\Height)*Italic)*Size
     *DX9\Vertice[2]\y = *DX9\Vertice[0]\y + \Source\Height*Size
     *DX9\Vertice[3]\x = *DX9\Vertice[2]\x + \Source\Width*Size
     *DX9\Vertice[3]\y = *DX9\Vertice[2]\y
     DisplaySprite3D(*Typeface\CharacterSet\Sprite3D, 0, 0, Transparency)
    EndIf
    x + \Outlay\Width*Size
   EndWith
   *Character + SizeOf(Character)
  Wend 
 EndIf
EndProcedure



Procedure TypefaceWidth(Typeface.i, Text$, Size.f=#PB_Ignore)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 Protected *Character.Character = @Text$
 Protected Width.f
 With *Typeface\Style
  If Size = #PB_Ignore : Size = \Size : EndIf
 EndWith
 While *Character\c
  With *Typeface\CharacterSet\Character[*Character\c]
   If \Exists
    Width + \Outlay\Width*Size
   EndIf
  EndWith
  *Character + SizeOf(Character)
 Wend
 ProcedureReturn Width
EndProcedure


Procedure TypefaceHeight(Typeface.i, Text$, Size.f=#PB_Ignore)
 Protected *Typeface.Typeface = TypefaceID(Typeface)
 Protected *Character.Character = @Text$
 Protected Height.f
 With *Typeface\Style
  If Size = #PB_Ignore : Size = \Size : EndIf
 EndWith
 While *Character\c
  With *Typeface\CharacterSet\Character[*Character\c]
   If \Exists
    If \Outlay\Height*Size > Height
     Height = \Outlay\Height*Size
    EndIf     
   EndIf
  EndWith
  *Character + SizeOf(Character)
 Wend
 ProcedureReturn Height
EndProcedure


; IDE Options = PureBasic 4.51 RC 1 (Windows - x86)
; CursorPosition = 249
; FirstLine = 338
; EnableXP
; DisableDebugger