Hallo
STARGÅTE,
danke für die neue Version, sieht super aus!
Schön, das ich dich animieren konnte das alte Projekt nochmal anzufassen.
Ich habe noch zwei Wünsche:
1.) Fonts die auch grösser als 128 Pixel sein können (1024 genügt mir)
2.) Die Möglichkeit die Fonts auch aus der DataSection zu laden nennen wir es "
CatchTypeface".
Ich weiss, Nachladen geht prima, aber manchmal möchte man es eben in einer Datei haben.
Ich hänge hier ein Beispiel von mir an, das ich im Wesentlichen aus LoadTypeface(Typeface.i, FileName.s) umgewandelt habe.
Bei mir funktioniert es prima mit einem 128pixel-Font.
Vielleicht kannst du das ja einfach integrieren, der Filename wäre auch zum Auswählen in der DataSection denkbar.
Grüsse vom Pforzheimer
Code:
; Lädt die angegebene 'Typeface' aus der angegebenen DataSection, FileName ist optional
; Loads the 'Typeface' from the XML file in the DataSection, FileName is optional
Procedure.i CatchTypeface(Typeface.i, FileName.s="")
Protected fontpointer = ?Font_1_xml
Protected fontpointer_len = ?Font_1_xml_end -?Font_1_xml
Protected *Typeface.Typeface
Protected XML.i = CatchXML(#PB_Any, fontpointer , fontpointer_len ,#PB_XML_StreamStart , #PB_UTF8)
Protected *MainNode, *Node, Index.i, *SourceNode, *OutlayNode
Protected *CurrentKerningPair.Typeface_KerningPair, Hash.i, Left.u, Right.u
If Not XML
ProcedureReturn #False
EndIf
*MainNode = MainXMLNode(XML)
*Typeface = Typeface_Create(Typeface)
;*Typeface\CharacterSet\Sprite = LoadSprite(#PB_Any, GetXMLAttribute(*MainNode, "Image"), #PB_Sprite_AlphaBlending)
*Typeface\CharacterSet\Sprite = CatchSprite(#PB_Any, ?Font_1_Sprite, #PB_Sprite_AlphaBlending)
*Node = ChildXMLNode(*MainNode)
While *Node
If XMLNodeType(*Node) <> #PB_XML_Normal
*Node = NextXMLNode(*Node)
Continue
EndIf
Select GetXMLNodeName(*Node)
Case "KerningPair"
Left = Val(GetXMLAttribute(*Node, "Left"))
Right = Val(GetXMLAttribute(*Node, "Right"))
If (Left <= 255 And Right <= 255) Or #PB_Compiler_Unicode
AddElement(*Typeface\CharacterSet\Elements\KerningPair())
With *Typeface\CharacterSet\Elements\KerningPair()
\CharacterPair = Left | Right<<16
\Amount = Val(GetXMLAttribute(*Node, "Amount"))
Hash = \CharacterPair % #Typeface_KerningSlots
*CurrentKerningPair = *Typeface\CharacterSet\KerningPair(Hash)
If *CurrentKerningPair
While *CurrentKerningPair\NextPair
*CurrentKerningPair = *CurrentKerningPair\NextPair
Wend
*CurrentKerningPair\NextPair = @*Typeface\CharacterSet\Elements\KerningPair()
Else
*Typeface\CharacterSet\KerningPair(Hash) = @*Typeface\CharacterSet\Elements\KerningPair()
EndIf
EndWith
EndIf
Case "Character"
Index = Val(GetXMLAttribute(*Node, "Index"))
If Index <= 255 Or #PB_Compiler_Unicode
*SourceNode = XMLNodeFromPath(*Node, "Source")
*OutlayNode = XMLNodeFromPath(*Node, "Outlay")
*Typeface\CharacterSet\Character(Index) = AddElement(*Typeface\CharacterSet\Elements\Character())
With *Typeface\CharacterSet\Elements\Character()
\Source\X = Val(GetXMLAttribute(*SourceNode, "X"))
\Source\Y = Val(GetXMLAttribute(*SourceNode, "Y"))
\Source\Width = Val(GetXMLAttribute(*SourceNode, "Width"))
\Source\Height = Val(GetXMLAttribute(*SourceNode, "Height"))
\Outlay\x = Val(GetXMLAttribute(*OutlayNode, "X"))
\Outlay\y = Val(GetXMLAttribute(*OutlayNode, "Y"))
\Outlay\Width = Val(GetXMLAttribute(*OutlayNode, "Width"))
\Outlay\Height = Val(GetXMLAttribute(*OutlayNode, "Height"))
EndWith
EndIf
EndSelect
*Node = NextXMLNode(*Node)
Wend
FreeXML(XML)
ProcedureReturn *Typeface
EndProcedure
DataSection
Font_1_xml:
IncludeBinary "Fonts\Something.128.xml"
Font_1_xml_end:
Font_1_Sprite:
IncludeBinary "Fonts\Something.128.xml.png"
EndDataSection