PureBasic Forums - English

Posted: **Sun Mar 15, 2009 10:06 pm**

Here's a little snippet showing how to integrate an image font into your application. This is mostly for debugging issues but some oldskool games might benefit from it as well. I thought it might be useful for someone since it's fast, small and the font is embedded into the source.

Code: Select all

; Title: Mini Image Font
; Author: Fluid Byte
; Test-Platform: Windows XP SP3
; PB Version: 4.30
; E-Mail: fluidbyte@web.de

Structure MIF_DATA
	Sprite.i
	Width.b
	Height.b
	RealWidth.w
	Spacing.b
EndStructure

Procedure MIF_CreateFont(SZF=1,SPC=0)
	Protected *mifd.MIF_DATA = AllocateMemory(SizeOf(MIF_DATA))	
	If SZF < 1 : SZF  = 1 : EndIf	
	*mifd\Width = 7 * SZF : *mifd\Height = 6 * SZF : *mifd\RealWidth = 112 * SZF : *mifd\Spacing = SPC		
	Protected lpBuffer = AllocateMemory(1462)	
	UnpackMemory(?_MIF_ImgageFont,lpBuffer)		
	If SZF > 1				
		Protected hbmFont = CatchImage(#PB_Any,lpBuffer,1462)		
		ResizeImage(hbmFont,112 * SZF,24 * SZF)		
		*mifd\Sprite = CreateSprite(#PB_Any,112 * SZF,24 * SZF)
		StartDrawing(SpriteOutput(*mifd\Sprite))
		DrawImage(ImageID(hbmFont),0,0)
		StopDrawing() : FreeImage(hbmFont)
	Else
		*mifd\Sprite = CatchSprite(#PB_Any,lpBuffer)
	EndIf		
	TransparentSpriteColor(*mifd\Sprite,RGB(0,128,0))
	FreeMemory(lpBuffer)
	ProcedureReturn *mifd
EndProcedure

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure MIF_DrawText(*mifd.MIF_DATA,X,Y,Text$)
	Protected c, Length = Len(Text$)-1, Frame, RowNum, ClipX
	For c=0 To Length
		Frame = PeekB(@Text$ + c) & $FF - ' '
		RowNum = (Frame * *mifd\Width) / *mifd\RealWidth
 		ClipX = (Frame - (*mifd\RealWidth / *mifd\Width * RowNum)) * *mifd\Width			
		ClipSprite(*mifd\Sprite,ClipX,RowNum * *mifd\Height,*mifd\Width,*mifd\Height)
		DisplayTransparentSprite(*mifd\Sprite,X + c * (*mifd\Width + *mifd\Spacing),Y)
	Next
EndProcedure

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure MIF_FreeFont(*mifd.MIF_DATA)
	If *mifd : FreeSprite(*mifd\Sprite) : FreeMemory(*mifd) : ProcedureReturn 1 : EndIf
EndProcedure

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

DataSection
	_MIF_ImgageFont:
	Data.l $05B6434A,$071F0000,$A9BB4768,$146B20D0,$CA126829,$184AB008,$080CB825,$81E20246,$10607400,$001E4398
	Data.l $981C1730,$4E010204,$020200A0,$03C05E00,$03804FFC,$C02D4093,$59041409,$08962200,$0E010807,$05700320
	Data.l $5025F04C,$16802104,$55433050,$9FF07C90,$8118FE48,$B2021C00,$44032807,$A8048600,$78320BB0,$5E811229
	Data.l $01C682A0,$0810C1C3,$E02A08DF,$71165500,$150007E8,$2B050CE0,$8BF94978,$00C24806,$24E190C9,$260363A0
	Data.l $C0041BF0,$F831C559,$D2F011A5,$E0E3FC0A,$D21A621B,$401F1341,$08186693,$FD1A6D20,$F804E398,$634B2186
	Data.l $043ECA35,$1248C074,$A0614C0E,$3A843F01,$768209B0,$11B7C208,$43BC34A0,$C200244D,$008A22A1,$03E46818
	Data.l $59468CA8,$A8CA4F82,$99F82308,$A66CA054,$A08E1369,$1751BC28,$26C23673,$D7AC9794,$42A4211C,$80725802
	Data.l $6932930A,$26C6D273,$C05693B3,$6C2A1488,$A3681123,$854931F8,$E3674862,$0AC1A140,$EA177A44,$99DFC4A1
	Data.l $7A28506D,$3B80A5ED,$83A0A0E3,$320A9002,$02AC03C2,$018A0DB3,$AA28BD9C,$E4C90AB3,$CA286803,$AF2C2885
	Data.l $AE15628C,$10B80480,$0C583205,$82AA8AD4,$0F010E8B,$B020D330,$D8531031,$F152C0C2,$5B003110,$94D824B3
	Data.l $8A1EF145,$7AB70780,$878B3560,$C204A229,$37AC5E77,$B244B6FA,$5AB245BB,$B76C0ACB,$074D9E4C,$12C7D968
	Data.l $ADE71107,$50C0DC0A,$81864814,$441CAA5A,$BF2F65C4,$0754F223,$A6516540,$40A83441,$E082B1A0,$7586DDC8
	Data.l $E1B8165A,$68F468A0,$6A24C911,$0D191B62,$071AE1F5,$073882C6,$51826940,$7167C0C8,$2C26850A,$9B103144
	Data.l $5B1DC1F3,$08B00712,$48D0460B,$E7C35332,$5E222126,$13244558,$81653625,$9C10061B,$31900CD9,$00818957
	Data.l $2B36080A,$B0EF332C,$7EC6C208,$B9E07C14,$8A20B6C6,$508D7187,$AB31E115,$4CF00AB0,$FE30C431,$F02A4BD9
	Data.l $1E13C46D,$AD2F0E66,$A6118930,$37CC3E34,$D8FD8CA8,$8A92034B,$2D261CD9,$CDC01460,$3870A1C2,$0000B126
	Data.b $FC,$97
EndDataSection

A small example program:

Code: Select all

InitSprite() : InitKeyboard()
OpenWindow(0,0,0,640,480,"Mini Image Font",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0)

Define EventID, *mifd1.MIF_DATA, *mifd2.MIF_DATA, *mifd3.MIF_DATA

*mifd1 = MIF_CreateFont()
*mifd2 = MIF_CreateFont(0,5)
*mifd3 = MIF_CreateFont(2)

Repeat
	Repeat
		EventID = WindowEvent()
		Select EventID
			Case #PB_Event_CloseWindow : End 
		EndSelect
	Until EventID = 0

	ExamineKeyboard()
	
	ClearScreen($756055)
	MIF_DrawText(*mifd1,50,50,"!" + Chr(34) + "#$%&'()*+,-./0123456789:;<=>?@")
	MIF_DrawText(*mifd1,50,70,"ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_")
	MIF_DrawText(*mifd1,50,120,UCase("the quick brown fox jumps over the lazy dog."))
	MIF_DrawText(*mifd1,50,140,UCase("lorem ipsum dolor sit amet."))
	MIF_DrawText(*mifd2,50,200,UCase("this font uses a different spacing!"))
	MIF_DrawText(*mifd3,50,260,UCase("this font is resized by the factor 2"))
	FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

MIF_FreeFont(*mifd1) : MIF_FreeFont(*mifd2) : MIF_FreeFont(*mifd3)

Posted: **Sun Mar 15, 2009 10:32 pm**

most of the chars are identical to the original C64 font...

Posted: **Sun Mar 15, 2009 10:40 pm**

Not quite! The base characters are taken from the password screen from Impossamole (PC-Engine Version).

http://en.wikipedia.org/wiki/Impossamole

Posted: **Sun Mar 15, 2009 10:54 pm**

it was also developed for C64, says the wiki article.

I just recognize, your charset is 5pix high, the C64 font was 7pix high...
but the style is quite similar.

Posted: **Mon Mar 16, 2009 12:37 am**

This is pretty cool

Thanks for sharing with us.

cheers