#include once "iso_plog.bi"
#include once "iso_font.bi"
#include once "iso_display.bi"

#include once "freetype2/freetype.bi"

dim shared as FT_Library library
dim shared as FT_Face face

'from Anson on the mailing list:
'http://lists.nongnu.org/archive/html/freetype/2005-06/msg00033.html
function DeriveDesignHeightFromMaxHeight(byval aFace as FT_Face, byval aMaxHeightInPixel as integer) as integer

	dim as integer boundingBoxHeightInFontUnit = aFace->bbox.yMax - aFace->bbox.yMin
	' TODO next line should probably be \ not /
	dim as integer designHeightInPixels = ( ( aMaxHeightInPixel * aFace->units_per_EM ) / boundingBoxHeightInFontUnit )
	dim as integer maxHeightInFontUnit = aMaxHeightInPixel shl 6
	FT_Set_Pixel_Sizes( aFace, designHeightInPixels, designHeightInPixels )
	dim as integer currentMaxHeightInFontUnit = FT_MulFix( boundingBoxHeightInFontUnit, aFace->size->metrics.y_scale )
	
	while currentMaxHeightInFontUnit < maxHeightInFontUnit
		designHeightInPixels += 1
		FT_Set_Pixel_Sizes( aFace, designHeightInPixels, designHeightInPixels )
		currentMaxHeightInFontUnit = FT_MulFix( boundingBoxHeightInFontUnit, aFace->size->metrics.y_scale )
	wend
	
	while currentMaxHeightInFontUnit > maxHeightInFontUnit
		designHeightInPixels -= 1
		FT_Set_Pixel_Sizes( aFace, designHeightInPixels, designHeightInPixels )
		currentMaxHeightInFontUnit = FT_MulFix( boundingBoxHeightInFontUnit, aFace->size->metrics.y_scale )
	wend
	
	return designHeightInPixels

end function

function font_print_char _
	( _
		byval draw_x as integer, _
		byval draw_y as integer, _
		byref char   as ubyte, _
		byval colour as uinteger _
	) as integer

	dim as integer n = char

	if FT_Load_Char( face, n, FT_LOAD_RENDER ) then
		die( "Unable to load and render char" )
	end if

	draw_x += face->Glyph->Bitmap_Left
	draw_y -= face->Glyph->Bitmap_Top

	dim as ubyte ptr fp = face->Glyph->Bitmap.Buffer

	for y as integer = 0 to face->Glyph->Bitmap.Rows - 1
		for x as integer = 0 to face->Glyph->Bitmap.Width - 1
			dim as uinteger c2 = point( draw_x + x, draw_y + y )
			if *fp <> 0 then
				dim as uinteger rb = any, g = any
				dim as integer a = *fp

				' http://www.daniweb.com/code/snippet216791.html
				rb = (((colour and &H00ff00ff) * a) + ((c2 and &H00ff00ff) * (&Hff - a))) and &Hff00ff00
				g =  (((colour and &H0000ff00) * a) + ((c2 and &H0000ff00) * (&Hff - a))) and &H00ff0000

				pset ( draw_x + x, draw_y + y ), (rb or g) shr 8
			end if
			fp += 1
		next x
	next y

	function = face->Glyph->Advance.x shr 6

end function

sub font_print_real _
	( _
		byval draw_x as integer, _
		byval draw_y as integer, _
		byref s      as string, _
		byval colour as uinteger, _
		byval sz     as integer, _
		byval center as integer _
	)

	sz = DeriveDesignHeightFromMaxHeight( face, sz )
	
	draw_y += sz

	if FT_Set_Pixel_Sizes( face, sz, sz ) then
		die( "Unable to set font size" )
	end if

	if center then
		dim as integer wid

		for i as integer = 0 to len( s ) - 1
			dim as integer n = s[i]
			if FT_Load_Char( face, n, FT_LOAD_RENDER ) then
				die( "Unable to load and render char" )
			end if
			wid += face->Glyph->Advance.x shr 6
		next i

		draw_x = (VIEW_WIDTH \ 2) - (wid \ 2)
	end if

	for i as integer = 0 to len( s ) - 1
		draw_x += font_print_char( draw_x, draw_y, s[i], colour )
	next i

end sub

sub font_print _
	( _
		byval draw_x as integer, _
		byval draw_y as integer, _
		byref s      as string, _
		byval colour as uinteger, _
		byval sz     as integer _
	)

	font_print_real( draw_x, draw_y, s, colour, sz, 0 )

end sub

sub font_print_center _
	( _
		byval draw_y as integer, _
		byref s      as string, _
		byval colour as uinteger, _
		byval sz     as integer _
	)

	font_print_real( 0, draw_y, s, colour, sz, -1 )

end sub

sub font_init
	' Setup freetype, load the font, and set the correct size
	if FT_Init_FreeType( @library ) then
		die( "Unable to initialize FreeType" )
	end if
	
	if FT_New_Face( library, "gfx" & PATSEP & "iso" & PATSEP & "Vera.ttf", 0, @face ) then
		die( "Unable to initialize face" )
	end if
end sub

sub font_deinit

end sub

function font_input _
	( _
		byval draw_x as integer, _
		byval draw_y as integer, _
		byref s      as string, _
		byval colour as uinteger, _
		byval sz     as integer _
	) as string

	dim as string result

	font_print( draw_x, draw_y, s & result, colour, sz )

	do
		dim as string skey = inkey( )
		
		while inkey <> "" : wend

		' TODO this is a bit of a nasty way to erase the old input in case it's backspace
		font_print( draw_x, draw_y, s & result, &H000000, sz )

		select case asc( skey )
			case asc( "A" ) to asc( "Z" ), asc( "a" ) to asc( "z" ), asc( "0" ) to asc( "9" ), asc( " " )
				result += skey
			case 8 ' backspace
				result = left( result, len( result ) - 1 )
			case 13, 10 ' enter
				exit do
			case else
				'if len(skey) = 2 then
				'	plog( "chr(" & Asc(skey, 1) & ", " & Asc(skey, 2) & ")" )
				'elseif len(skey) = 1 then
				'	plog( "chr(" & Asc(skey) & ")" )
				'end if
		end select

		font_print( draw_x, draw_y, s & result, colour, sz )

		sleep 100, 1
	loop

	function = result

end function

