#if 0
             Titel: fontsystem.bi
           Version: 0.1
             Autor: Paul Grunewald (Stormy)
          Erstellt: 22.04.2006
Zuletzt bearbeitet: 22.04.2006
      Beschreibung: BITMAP-Fonts in FreeBASIC (OpenGL-Version)
         Anmerkung: Ihr dürft diese Routine verwenden wie ihr wollt. Credits wären nett, sind aber nicht notwendig!
           Kontakt: Paul.Grunewald@gmail.com 
#endif

CONST EmptyChar = 160 ' 16pixel dummy white space

' von FONTSYSTEM.BI

TYPE FontChar
 Width AS INTEGER
 Height AS INTEGER
 Left AS INTEGER
 Right AS INTEGER
END TYPE

TYPE FontSystem
 Char(0 TO 255) AS FontChar
 listbase AS UINTEGER
 texture AS UINTEGER
 Spacing AS INTEGER
 Fixed AS UBYTE 
END TYPE


SUB DestroyFont (ByRef Font AS FontSystem)
'ImageDestroy(Font.Handle)
glDeleteLists Font.listbase, 256                      '' Delete All 256 Display Lists

END SUB

FUNCTION FontGetWidth (ByRef Font AS FontSystem, ByVal Text AS STRING) AS INTEGER
DIM AS INTEGER sum, e, c
sum = 0
FOR e = 1 TO LEN(Text)
 c = ASC(MID$(Text,e,1))
 IF Font.Fixed = 0 THEN sum+=Font.Char(c).Width + Font.Spacing ELSE sum+=16
NEXT e
RETURN sum
END FUNCTION


SUB FontPrint (ByRef Font AS FontSystem, ByVal Text AS STRING, ByVal X AS INTEGER, ByVal Y AS INTEGER, ByVal Z AS INTEGER = 0, ByVal scale AS SINGLE = 1)
DIM AS INTEGER i, e, c, sum = 0
With Font       
        glEnable GL_TEXTURE_2D
	glBindTexture GL_TEXTURE_2D, .texture                         '' Select Our Font Texture
	'glDisable(GL_DEPTH_TEST)
			glListBase .listbase                          
			FOR i = 1 to LEN(Text)			 
			 c = ASC(MID$(Text,i,1))
			 glscalef scale, scale, scale  			 
			 glTranslated (x/scale)+sum- .Char(c).Left+8, y/scale+8, z                                      '' Position The Text (0,0 - Bottom Left)
			 glCallList (c+1)     '' Write The Text To The Screen
			 'glPopMatrix	
			 glLoadIdentity
			 IF Font.Fixed = 0 THEN sum+=.Char(c).Width + .Spacing ELSE sum+=16
			NEXT i
	'glEnable(GL_DEPTH_TEST)
End With			
END SUB

Sub GLPrint (ByRef Font AS FontSystem, ByVal text AS STRING, ByVAL x AS INTEGER, BYVAL y AS INTEGER, ByVal z AS INTEGER, ByVal R AS INTEGER, ByVal G AS INTEGER, ByVal B AS INTEGER, ByVal A AS INTEGER = 255) 
   DIM as ubyte red, green, blue

   
  ' new!
  glBlendFunc GL_ONE,GL_ONE_MINUS_SRC_ALPHA
  'glBlendFunc Modes(Mode1), Modes(Mode2)
  'glBlendFunc GL_ONE, GL_ONE
  glcolor4f 0,0,0,.5
  FontPrint (Font, Text, x+1, y+1, z)
  ' ...
  glcolor4ub R, G, B, A
  glBlendFunc GL_ONE,GL_ONE_MINUS_SRC_ALPHA
  FontPrint (Font, Text, x, y, z+1)      
   
End SUB

SUB FontLoad (ByRef Font AS FontSystem, ByVal SourceFile AS STRING, ByVal DataFile AS STRING)
DIM AS INTEGER F, e
DIM tmp_buffer AS gfxtype

With Font
'tmp_buffer = GFX_Load(SourceFile)
'ReplaceColor(tmp_buffer, 0, RGB(255,0,255))
'.texture = CreateTexture(tmp_buffer, TEX_NOFILTER OR TEX_MASKED)   '' Linear Texture
load_texture(SourceFile, tmp_buffer)
.texture = tmp_buffer.handle

 F = FREEFILE
 OPEN DataFile FOR BINARY AS #F
 GET #F,, .Char()
 CLOSE #F
 ' ADDITION:
 ' 160th char has a fixed length regardless from his actual size: 16px
 .Char(EmptyChar).Width = 16
 ' END OF ADDITION

	dim cx as double                             '' Holds Our X Character Coord
	dim cy as double                             '' Holds Our Y Character Coord
	dim gloop as integer                       '' Generic Loop Variable

	.listbase = glGenLists(256)                      '' Creating 256 Display Lists
	'glBindTexture GL_TEXTURE_2D, .texture      '' Select Our Font Texture
	for gloop = 0 to 255                         '' Loop Through All 256 Lists

		cx = (gloop mod 16)/16.0                 '' X Position Of Current Character
		cy = (gloop\16)/16.0                     '' Y Position Of Current Character
#if 1
		glNewList .listbase+gloop, GL_COMPILE        '' Start Building A List
		glBegin GL_QUADS                         '' Use A Quad For Each Character
		glTexCoord2f cx,1-cy-0.0625'cx+0.0625, 1-cy-0.0625  
		glVertex2i -8,8                      ''  LINKS UNTEN
		glTexCoord2f cx+0.0625,1-cy-0.0625'cx+0.0625, 1-cy         
		glVertex2i 8, 8                       '' RECHTS UNTEN
		glTexCoord2f cx+0.0625,1-cy                 
		glVertex2i 8, -8                      '' RECHTS OBEN
		glTexCoord2f cx,1-cy'cx, 1-cy-0.0625         
		glVertex2i -8, -8                      '' LINKS OBEN
		glEnd                                    '' Done Building Our Quad (Character)
		glEndList                                '' Done Building The Display List
#endif		

	next                                         '' Loop Until All 256 Are Built
End With

END SUB
