Parse Angel Code BMFont format and draw text

The BMFont format supports packed textures, varying advance per character and even kernings. It can be generated with a number of tools, inluding:

  • BMFont, free software Windows app, http://www.angelcode.com/products/bmfont/
  • Littera, a web app, http://kvazars.com/littera/

Format reference: http://www.angelcode.com/products/bmfont/doc/file_format.html

Introduced classes

class BMFont

gamnit :: BMFont

BMFont description, parsed with Text::parse_bmfont or loaded as a BMFontAsset
class BMFontAsset

gamnit :: BMFontAsset

BMFont from the assets folder
class BMFontChar

gamnit :: BMFontChar

Description of a character in a BMFont

Redefined classes

redef abstract class Text

gamnit :: bmfont $ Text

High-level abstraction for all text representations

All class definitions

class BMFont

gamnit $ BMFont

BMFont description, parsed with Text::parse_bmfont or loaded as a BMFontAsset
class BMFontAsset

gamnit $ BMFontAsset

BMFont from the assets folder
class BMFontChar

gamnit $ BMFontChar

Description of a character in a BMFont
redef abstract class Text

gamnit :: bmfont $ Text

High-level abstraction for all text representations
package_diagram gamnit::bmfont bmfont dom dom gamnit::bmfont->dom gamnit::font font gamnit::bmfont->gamnit::font parser_base parser_base dom->parser_base gamnit::flat_core flat_core gamnit::font->gamnit::flat_core ...parser_base ... ...parser_base->parser_base ...gamnit::flat_core ... ...gamnit::flat_core->gamnit::flat_core gamnit::flat flat gamnit::flat->gamnit::bmfont gamnit::more_materials more_materials gamnit::more_materials->gamnit::flat gamnit::virtual_gamepad virtual_gamepad gamnit::virtual_gamepad->gamnit::flat gamnit::more_materials... ... gamnit::more_materials...->gamnit::more_materials gamnit::virtual_gamepad... ... gamnit::virtual_gamepad...->gamnit::virtual_gamepad

Ancestors

module abstract_collection

core :: abstract_collection

Abstract collection classes and services.
module abstract_text

core :: abstract_text

Abstract class for manipulation of sequences of characters
module angles

geometry :: angles

Angle related service using Float to represent an angle in radians
module app

app :: app

app.nit is a framework to create cross-platform applications
module app_base

app :: app_base

Base of the app.nit framework, defines App
module array

core :: array

This module introduces the standard array structure.
module assets

app :: assets

Portable services to load resources from the assets folder
module aware

android :: aware

Android compatibility module
module bitset

core :: bitset

Services to handle BitSet
module boxes

geometry :: boxes

Provides interfaces and classes to represent basic geometry needs.
module bytes

core :: bytes

Services for byte streams and arrays
module c

c :: c

Structures and services for compatibility with the C language
module caching

serialization :: caching

Services for caching serialization engines
module cameras

gamnit :: cameras

Camera services producing Model-View-Projection matrices
module cameras_cache

gamnit :: cameras_cache

Cache the Matrix produced by Camera::mvp_matrix
module circular_array

core :: circular_array

Efficient data structure to access both end of the sequence.
module codec_base

core :: codec_base

Base for codecs to use with streams
module codecs

core :: codecs

Group module for all codec-related manipulations
module collection

core :: collection

This module define several collection classes.
module core

core :: core

Standard classes and methods used by default by Nit programs and libraries.
module display

gamnit :: display

Abstract display services
module dynamic_resolution

gamnit :: dynamic_resolution

Virtual screen with a resolution independent from the real screen
module engine_tools

serialization :: engine_tools

Advanced services for serialization engines
module environ

core :: environ

Access to the environment variables of the process
module error

core :: error

Standard error-management infrastructure.
module exec

core :: exec

Invocation and management of operating system sub-processes.
module file

core :: file

File manipulations (create, read, write, etc.)
module fixed_ints

core :: fixed_ints

Basic integers of fixed-precision
module fixed_ints_text

core :: fixed_ints_text

Text services to complement fixed_ints
module flat

core :: flat

All the array-based text representations
module flat_core

gamnit :: flat_core

Core services for the flat API for 2D games
module gamnit

gamnit :: gamnit

Game and multimedia framework for Nit
module gc

core :: gc

Access to the Nit internal garbage collection mechanism
module geometry

geometry :: geometry

Provides interfaces and classes to represent basic geometry needs.
module glesv2

glesv2 :: glesv2

OpenGL graphics rendering library for embedded systems, version 2.0
module hash_collection

core :: hash_collection

Introduce HashMap and HashSet.
module input

mnit :: input

Defines abstract classes for user and general inputs to the application.
module inspect

serialization :: inspect

Refine Serializable::inspect to show more useful information
module iso8859_1

core :: iso8859_1

Codec for ISO8859-1 I/O
module kernel

core :: kernel

Most basic classes and methods.
module list

core :: list

This module handle double linked lists
module math

core :: math

Mathematical operations
module matrix

matrix :: matrix

Services for matrices of Float values
module meta

meta :: meta

Simple user-defined meta-level to manipulate types of instances as object.
module more_collections

more_collections :: more_collections

Highly specific, but useful, collections-related classes.
module native

core :: native

Native structures for text and bytes
module numeric

core :: numeric

Advanced services for Numeric types
module parser

dom :: parser

XML DOM-parsing facilities
module parser_base

parser_base :: parser_base

Simple base for hand-made parsers of all kinds
module performance_analysis

performance_analysis :: performance_analysis

Services to gather information on the performance of events by categories
module points_and_lines

geometry :: points_and_lines

Interfaces and classes to represent basic geometry needs.
module poset

poset :: poset

Pre order sets and partial order set (ie hierarchies)
module programs

gamnit :: programs

Services for graphical programs with shaders, attributes and uniforms
module projection

matrix :: projection

Services on Matrix to transform and project 3D coordinates
module protocol

core :: protocol

module queue

core :: queue

Queuing data structures and wrappers
module range

core :: range

Module for range of discrete objects.
module re

core :: re

Regular expression support for all services based on Pattern
module realtime

realtime :: realtime

Services to keep time of the wall clock time
module ropes

core :: ropes

Tree-based representation of a String.
module serialization

serialization :: serialization

General serialization services
module serialization_core

serialization :: serialization_core

Abstract services to serialize Nit objects to different formats
module sorter

core :: sorter

This module contains classes used to compare things and sorts arrays.
module stream

core :: stream

Input and output streams of characters
module text

core :: text

All the classes and methods related to the manipulation of text entities
module textures

gamnit :: textures

Load textures, create subtextures and manage their life-cycle
module time

core :: time

Management of time and dates
module union_find

core :: union_find

union–find algorithm using an efficient disjoint-set data structure
module utf8

core :: utf8

Codec for UTF-8 I/O
module xml_entities

dom :: xml_entities

Basic blocks for DOM-XML representation

Parents

module dom

dom :: dom

Easy XML DOM parser
module font

gamnit :: font

Abstract font drawing services, implemented by bmfont and tileset

Children

module flat

gamnit :: flat

Simple API for 2D games, built around Sprite and App::update

Descendants

module a_star-m

a_star-m

module cardboard

gamnit :: cardboard

Update the orientation of world_camera at each frame using the head position given by android::cardboard
module depth

gamnit :: depth

Framework for 3D games in Nit
module more_materials

gamnit :: more_materials

Various material implementations
module more_models

gamnit :: more_models

Services to load models from the assets folder
module selection

gamnit :: selection

Select Actor from a screen coordinate
module stereoscopic_view

gamnit :: stereoscopic_view

Refine EulerCamera and App::frame_core_draw to get a stereoscopic view
module virtual_gamepad

gamnit :: virtual_gamepad

Virtual gamepad mapped to keyboard keys for quick and dirty mobile support
module vr

gamnit :: vr

VR support for gamnit depth, for Android only
# Parse Angel Code BMFont format and draw text
#
# The BMFont format supports packed textures, varying advance per character and
# even kernings. It can be generated with a number of tools, inluding:
# * BMFont, free software Windows app, http://www.angelcode.com/products/bmfont/
# * Littera, a web app, http://kvazars.com/littera/
#
# Format reference: http://www.angelcode.com/products/bmfont/doc/file_format.html
module bmfont

private import dom

intrude import font

# BMFont description, parsed with `Text::parse_bmfont` or loaded as a `BMFontAsset`
#
# This class flattens all the `info` and `common` data.
class BMFont

	# ---
	# info part
	#
	# How the font was generated.

	# Name of the source true type font
	var face: Text

	# Size of the source true type font
	var size: Float

	# Is the font bold?
	var bold: Bool

	# Is the font italic?
	var italic: Bool

	# Does the font uses the Unicode charset?
	var unicode: Bool

	# Padding for each character
	#
	# In the format `up,right,down,left`
	var padding: String

	# Spacing for each character
	#
	# In the format `horizontal,vertical`.
	var spacing: String

	# ---
	# common part
	#
	# Information common to all characters

	# Distance in pixels between each line of text
	var line_height: Float

	# Pixels from the top of the line to the base of the characters
	var base: Float

	# Width of the texture
	var scale_w: Float

	# Height of the texture
	var scale_h: Float

	# Textures
	var pages = new Map[String, TextureAsset]

	# Characters in the font
	var chars = new Map[Char, BMFontChar]

	# Distance between certain characters
	var kernings = new HashMap2[Char, Char, Float]

	# Additional distance between `prev_char` and `char`
	fun kerning(prev_char: nullable Char, char: Char): Float
	do
		if prev_char == null then return 0.0
		return kernings[prev_char, char] or else 0.0
	end

	redef fun to_s do return "<{class_name} {face} at {size} pt, "+
	                         "{pages.length} pages, {chars.length} chars>"

	# TODO
	#
	# # From info
	# charset
	# stretchH
	# smooth
	# aa
	# outline
	#
	# # From common
	# packed
	# alphaChnl
	# redChnl
	# greenChnl
	# blueChnl
end

# Description of a character in a `BMFont`
class BMFontChar

	# Subtexture left coordinate
	var x: Float

	# Subtexture top coordinate
	var y: Float

	# Subtexture width
	var width: Float

	# Subtexture height
	var height: Float

	# Drawing offset on X
	var xoffset: Float

	# Drawing offset on Y
	var yoffset: Float

	# Cursor advance after drawing this character
	var xadvance: Float

	# Full texture contaning this character and others
	var page: RootTexture

	# TODO Channel where the image is found
	#var chnl: Int

	# Subtexture with this character image only
	var subtexture: Texture = page.subtexture(x, y, width, height) is lazy, writable

	# Scale to apply to this char only
	var scale = 1.0 is writable
end

redef class Text

	# Parse `self` as an XML BMFont description file
	#
	# Reports only basic XML format errors, other errors may be ignored or
	# cause a crash.
	#
	# ~~~
	# var desc = """
	# <font>
	#   <info face="arial" size="72" bold="0" italic="0" charset=""
	#         unicode="1" stretchH="100" smooth="1" aa="1" padding="2,2,2,2"
	#         spacing="0,0" outline="0"/>
	#   <common lineHeight="80" base="65" scaleW="4030" scaleH="231"
	#           pages="1" packed="0"/>
	#   <pages>
	#     <page id="0" file="arial.png"/>
	#   </pages>
	#   <chars count="3">
	#     <char id="65" x="2519" y="10" width="55" height="59" xoffset="0"
	#           yoffset="13" xadvance="48" page="0" chnl="15"/>
	#     <char id="66" x="2600" y="10" width="46" height="58" xoffset="5"
	#           yoffset="13" xadvance="48" page="0" chnl="15"/>
	#     <char id="67" x="2673" y="9" width="52" height="60" xoffset="4"
	#           yoffset="12" xadvance="52" page="0" chnl="15"/>
	#   </chars>
	#   <kernings count="1">
	#     <kerning first="65" second="67" amount="-1"/>
	#   </kernings>
	# </font>
	# """
	#
	# var fnt = desc.parse_bmfont("dir_in_assets").value
	# assert fnt.to_s == "<BMFont arial at 72.0 pt, 1 pages, 3 chars>"
	# assert fnt.line_height == 80.0
	# assert fnt.kernings['A', 'C'] == -1.0
	# assert fnt.chars['A'].page.as(TextureAsset).path == "dir_in_assets/arial.png"
	# ~~~
	fun parse_bmfont(dir: String): MaybeError[BMFont, Error]
	do
		# Parse XML
		var xml = to_xml
		if xml isa XMLError then
			var msg = "XML Parse Error: {xml.message}:{xml.location or else 0}"
			return new MaybeError[BMFont, Error](maybe_error=new Error(msg))
		end

		# Basic sanity check
		var roots = xml["font"]
		if roots.is_empty then
			var msg = "Error: the XML document doesn't declare the expected `font` root"
			return new MaybeError[BMFont, Error](maybe_error=new Error(msg))
		end

		# Expect the rest of the document to be well formatted
		var root = roots.first

		var info = root["info"].first
		assert info isa XMLAttrTag
		var info_map = info.attributes_to_map

		var common = root["common"].first
		assert common isa XMLAttrTag
		var common_map = common.attributes_to_map

		var fnt = new BMFont(
			info_map["face"],
			info_map["size"].to_f,
			info_map["bold"] == "1",
			info_map["italic"] == "1",
			info_map["unicode"] == "1",
			info_map["padding"],
			info_map["spacing"],
			common_map["lineHeight"].to_f,
			common_map["base"].to_f,
			common_map["scaleW"].to_f,
			common_map["scaleH"].to_f
		)

		# Pages / pixel data files
		var xml_pages = root["pages"].first
		for page in xml_pages["page"] do
			if not page isa XMLAttrTag then continue

			var attributes = page.attributes_to_map
			var file = dir / attributes["file"]
			fnt.pages[attributes["id"]] = new TextureAsset(file)
		end

		# Char description
		for item in root["chars"].first["char"] do
			if not item isa XMLAttrTag then continue

			var attributes = item.attributes_to_map
			var id = attributes["id"].to_i.code_point

			var c = new BMFontChar(
				attributes["x"].to_f, attributes["y"].to_f,
				attributes["width"].to_f, attributes["height"].to_f,
				attributes["xoffset"].to_f, attributes["yoffset"].to_f,
				attributes["xadvance"].to_f,
				fnt.pages[attributes["page"]])

			fnt.chars[id] = c
		end

		# Kerning between two characters
		var kernings = root["kernings"]
		if kernings.not_empty then
			for item in kernings.first["kerning"] do
				if not item isa XMLAttrTag then continue

				var attributes = item.attributes_to_map
				var first = attributes["first"].to_i.code_point
				var second = attributes["second"].to_i.code_point
				var amount = attributes["amount"].to_f
				fnt.kernings[first, second] = amount
			end
		end

		return new MaybeError[BMFont, Error](fnt)
	end
end

# BMFont from the assets folder
#
# ~~~
# redef class App
#     var font = new BMFontAsset("arial.fnt")
#     var pos: Point3d[Float] = ui_camera.top_left.offset(128.0, -128.0, 0.0)
#     var ui_text = new TextSprites(font, pos)
#
#     redef fun create_scene
#     do
#         super
#
#         font.load
#         assert font.error == null
#
#         ui_text.text = "Hello world!"
#     end
# end
# ~~~
class BMFontAsset
	super Asset
	super Font

	# Font description
	#
	# Require: `error == null`
	fun desc: BMFont
	do
		# Cached results
		var cache = desc_cache
		if cache != null then return cache
		var error = error
		assert error == null else print_error error

		# Load on first access
		load
		error = self.error
		assert error == null else print_error error

		return desc_cache.as(not null)
	end

	private var desc_cache: nullable BMFont = null

	# Error at loading
	var error: nullable Error = null

	# XML description in the assets folder
	private var text_asset = new TextAsset(path) is lateinit

	# Load font description and textures from the assets folder
	#
	# Sets `error` if an error occurred, otherwise
	# the font description can be accessed via `desc`.
	fun load
	do
		var text_asset = text_asset
		text_asset.load
		var error = text_asset.error
		if error != null then
			self.error = error
			return
		end

		var desc = text_asset.to_s
		var fnt_or_error = desc.parse_bmfont(path.dirname)
		if fnt_or_error.is_error then
			self.error = fnt_or_error.error
			return
		end

		var fnt = fnt_or_error.value
		self.desc_cache = fnt

		# Load textures too
		for page_name, texture in fnt.pages do
			texture.load

			# Move up any texture loading error.
			# This algo keeps only the latest error,
			# but this isn't a problem on single page fonts.
			error = texture.error
			if error != null then self.error = error
		end
	end

	redef fun write_into(text_sprites, text)
	do
		var dx = 0.0
		var dy = 0.0
		var text_width = 0.0
		var line_sprites = new Array[Sprite]
		var height = 0.0

		# Has the current line height been added to `height`?
		var line_height_counted = false

		# TextSprite customization
		var max_width = text_sprites.max_width
		var max_height = text_sprites.max_height
		var scale = text_sprites.scale

		# Font customization
		var line_height = desc.line_height * scale
		var partial_line_skip = line_height * partial_line_mod.to_f

		# Links data
		text_sprites.links.clear
		var in_link = false
		var link_sprites = new Array[Sprite]
		var link_name = ""

		# Loop over all characters
		var prev_char = null
		var i = -1
		while i < text.length - 1 do
			i += 1
			var c = text[i]

			# Special characters
			var word_break = false
			if c == '\n' then
				justify(line_sprites, text_sprites.align, dx)
				dy -= line_height
				if max_height != null and max_height < -dy + line_height then break
				dx = 0.0
				if not line_height_counted then
					# Force to account for empty lines
					height += line_height
				end
				line_height_counted = false
				prev_char = null
				continue
			else if c == pld then
				dy -= partial_line_skip
				height += partial_line_skip
				word_break = true
				continue
			else if c == plu then
				dy += partial_line_skip
				height -= partial_line_skip # We could keep two heights and return the max
				word_break = true
				continue
			else if c.is_whitespace then
				var space_advance = if desc.chars.keys.has(' ') then
						desc.chars[' '].xadvance
					else if desc.chars.keys.has('f') then
						desc.chars['f'].xadvance
					else 16.0
				dx += space_advance * scale
				word_break = true
			else if c == '[' then
				# Open link?
				if i + 1 < text.length and text[i+1] == '[' then
					# Escape if duplicated
					i += 1
				else
					in_link = true
					continue
				end
			else if c == ']' then
				# Close link?
				if i + 1 < text.length and text[i+1] == ']' then
					# Escape if duplicated
					i += 1
				else
					# If there's a () use it as link_name
					var j = i + 1
					if j < text.length and text[j] == '(' then
						var new_name
						new_name = ""
						loop
							j += 1
							if j > text.length then
								# No closing ), abort
								new_name = null
								break
							end

							var l = text[j]
							if l == ')' then break
							new_name += l.to_s
						end
						if new_name != null then
							link_name = new_name
							i = j
						end
					end

					# Register the link for the clients
					text_sprites.links[link_name] = link_sprites

					# Prepare next link
					in_link = false
					link_sprites = new Array[Sprite]
					link_name = ""
					continue
				end
			end

			if in_link then link_name += c.to_s

			# End of a word?
			if word_break then
				# If we care about line width, check for overflow
				if max_width != null then
					# Calculate the length of the next word
					var prev_w = null
					var word_len = 0.0
					for wi in [i+1..text.length[ do
						var w = text[wi]

						if w == '\n' or w == pld or w == plu or w.is_whitespace or (in_link and w == ']') then break

						if not desc.chars.keys.has(w) then
							var rc = replacement_char
							if rc == null then continue
							w = rc
						end

						word_len += advance(prev_w, w) * scale
						prev_w = w
					end

					# Would the line be too long?
					if dx + word_len > max_width then
						justify(line_sprites, text_sprites.align, dx)
						dy -= line_height
						if max_height != null and max_height < -dy + line_height then break
						dx = 0.0
						line_height_counted = false

						if not text_sprites.wrap then
							# Cut short, skip everything until the next new line
							while c != '\n' and i < text.length - 1 do
								i += 1
								c = text[i]
							end
						end
					end
				end

				prev_char = null
				continue
			end

			# Replace or skip unknown characters
			if not desc.chars.keys.has(c) then
				var rc = replacement_char
				if rc == null then continue
				c = rc
			end

			var char_info = desc.chars[c]
			var advance = char_info.xadvance
			var kerning = desc.kerning(prev_char, c)

			var x = dx + (char_info.width/2.0  + char_info.xoffset + kerning) * scale
			var y = dy - (char_info.height/2.0 + char_info.yoffset) * scale
			var pos = text_sprites.anchor.offset(x, y, 0.0)
			var s = new Sprite(char_info.subtexture, pos)
			s.scale = scale * char_info.scale
			text_sprites.sprites.add s
			line_sprites.add s
			if in_link then link_sprites.add s

			dx += (advance + kerning) * scale
			prev_char = c

			text_width = text_width.max(dx)

			if not line_height_counted then
				# Increase `height` only once per line iff there's a caracter
				line_height_counted = true
				height += line_height
			end
		end

		justify(line_sprites, text_sprites.align, dx)

		# valign
		if text_sprites.valign != 0.0 then
			var d = (-dy+line_height) * text_sprites.valign
			for s in text_sprites.sprites do s.center.y += d
		end

		text_sprites.width = text_width.max(dx)
		text_sprites.height = height
	end

	# Character replacing other characters missing from the font
	private var replacement_char: nullable Char is lazy do
		for c in  "�?".chars do
			if desc.chars.keys.has(c) then return c
		end
		return null
	end

	private fun advance(prev_char: nullable Char, char: Char): Float
	do
		var char_info = desc.chars[char]
		var kerning = desc.kerning(prev_char, char)
		return char_info.xadvance + kerning
	end

	private fun justify(line_sprites: Array[Sprite], align: Float, line_width: Float)
	do
		var dx = -line_width*align
		for s in line_sprites do s.center.x += dx
		line_sprites.clear
	end
end
lib/gamnit/bmfont.nit:15,1--589,3