Bitmap font

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
Tsalop88
Member
Posts: 55
Joined: Fri Mar 20, 2009 2:35 pm
Location: Loppi

Bitmap font

Post by Tsalop88 »

Tämä on luultavasti jo vanha juttu mutta tässä olisi purkasta tehty funktio joka korvaa tekstin kirjaimet kuvalla:
Koodin toteutus objekteilla:

Code: Select all

b = LoadAnimObject("fnt.png",10,10,0,256) 'Font must have 256 frames

bitFont("osta_uusi_auto",b,-200,0)
DrawScreen : WaitKey : End

//
// This function will convert the characters of the string to
// objects, NOTE: use '_' for linebreaks...
//
Function bitFont(txt$,fnt,pX,pY) 
Dim sz(Len(txt))  'Array for text
fnd = 0 : wrd = 0 'processing words
wdt = ObjectSizeX(fnt) 'Get font width
hgt = ObjectSizeY(fnt) 'Get font height
//Start creating text
For i = 0 To Len(txt)
//Handle letters and breaks:
  curC = Asc(Mid(txt,(i+1),1)) 'Get current char 
  If curC = Asc("_") Then      'Make a line break
     fnd+1 : wrd = -1          'New position
  EndIf : wrd+1
//Position text:
  cY = pY-(fnd*hgt) 'Count X
  cX = pX+(wrd*wdt) 'Count Y                     
//Make objects as we go 
  If curC <> Asc("_") Then
     sz(i) = MakeObject() : sz(i) = CloneObject(fnt) 'Clone font
     PlayObject sz(i),curC-1,curC-1                  'Set correct graphic
     PositionObject sz(i),cX,cY                      'Position letter
     ShowObject sz(i),ON                             'Show letter
  EndIf 
Next i  
EndFunction 
Sama kuvilla:

Code: Select all

b = LoadAnimImage("fnt.png",10,10,0,256)
Repeat
bitFont("osta_uusi_auto",b,0,20)
DrawScreen : Until(EscapeKey()) : End

Function bitFont(txt$,fnt,pX,pY) 
lne = 0 : wrd = 0 'processing words
wdt = ImageWidth(fnt)
hgt = ImageHeight(fnt)
Dim c(Len(txt),2)
//Start creating text
For t = 0 To Len(txt)-1 'Without -1 DrawImage breaks
//Handle letters and breaks:
  curC = Asc(Mid(txt,(t+1),1)) 'Get current char 
  If curC = Asc("_") Then      'Make a line break
     lne+1 : wrd = -1          'Set new position
  EndIf : wrd+1
//Position text:
  c(t,0)= pY+(lne*hgt)  'Set image X
  c(t,1)= pX+(wrd*wdt)  'Set image Y      
  c(t,2)= curC-1        'Set Image frame 
Next t  
//Draw images (values in array to show all letters): 
For d = 0 To Len(txt)-1 'Without -1 DrawImage breaks
If c(d,2)<>(Asc("_")-1) Then DrawImage fnt,c(d,0),c(d,1),Abs(c(d,2)) 'Show no linebreaks
Next d
EndFunction 

Sitten tuo maaginen fnt.png (kyllästyin loppuakohden tyylittelemään):
Image

EDIT: Muutin kuvaversion käyttämään vain yhtä arrayta.
Last edited by Tsalop88 on Wed Dec 15, 2010 10:51 am, edited 3 times in total.
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Bitmap font

Post by MaGetzUb »

Olisin toteuttanut ko. homman kuvilla, koska kuvia ei tarvitse kopioida jos niitä halutaan käyttää monesti.
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
Tsalop88
Member
Posts: 55
Joined: Fri Mar 20, 2009 2:35 pm
Location: Loppi

Re: Bitmap font

Post by Tsalop88 »

Lisäsin tuohon saman koodinpätkän mutta nyt vain kuvia käyttäen.
Kesti hieman tajuta miksi DrawImage aina hajosi mutta sitten huomasin, että se lyö viimeisen merkin
perään maagisen luvun -2...

EDIT: Abs() köyhän miehen korjauksena, että se ei varmastikkaan tungen negatiivisiä frameja.
Tsalop88
Member
Posts: 55
Joined: Fri Mar 20, 2009 2:35 pm
Location: Loppi

Re: Bitmap font

Post by Tsalop88 »

Vielä yksi erilainen rutiini (lisätty padding fonttien väliin ja muutettu koodia hieman):

Code: Select all

b = LoadAnimImage("Fnt2.png",10,20,0,96)
Repeat
bitFont("Does this work_or not?",b)
DrawScreen : Until(EscapeKey()) : End
//
// bitFont()
// Used for replacing text with icons,
// Attributes:
// String, bitmap to use, X, Y and padding
//
Function bitFont(txt$,fnt,pX=0,pY=0,pad=0) 
lne = 0 : wrd = 0 'processing words
wdt = ImageWidth(fnt) +pad 'Pad is for padding
hgt = ImageHeight(fnt)+pad 'between letters.
Dim c(Len(txt),2)          'Array for X,Y,char
//Start creating text
For t = 0 To Len(txt)-1 'Without -1 DrawImage breaks
//Handle letters and breaks:
  curC = Asc(Mid(txt,(t+1),1))-33 'Get current char (start from !)
  If curC = Asc("_")-33 Then lne+1 : wrd = -1 'Make linebreak            
  wrd+1                                       'Set new position
//Get letter position:
  c(t,0)= pX+(wrd*wdt)  'Set image X
  c(t,1)= pY+(lne*hgt)  'Set image Y 
  If curC = Asc(" ")-33 Then c(t,2) = 96 Else c(t,2)= curC 'Used for sparing spaces
Next t  
//Draw images (values in array to show all letters): 
//NOTE: USe only values between 33 - 126 (! - ~)
For d = 0 To Len(txt)-1 'Without -1 DrawImage breaks
If (c(d,2)<>(Asc("_")-33)) And c(d,2) < 97 'No overflow
   DrawImage fnt,c(d,0),c(d,1),Abs(c(d,2))
EndIf : Next d
EndFunction 
Nyt ei tarvitse käyttää 256 framen bittikarttoja...
Linkki tässä esimerkissä käytettyyn kuvaan:
Image
Ja screeni:
Image

EDIT: Pistin koordinaatit ja rajat vaihtoehtoiseksi...
Last edited by Tsalop88 on Tue Jan 11, 2011 12:11 pm, edited 1 time in total.
User avatar
-Z-
Devoted Member
Posts: 682
Joined: Tue Aug 28, 2007 3:33 pm
Location: In ur danmaku, grazin ur bullets

Re: Bitmap font

Post by -Z- »

Ihan nasta.

Teetkö vielä sitä Touhou-fanipeliäsi?
"Fallout 3 (#10) marked a shift in the industry, a move that saw the western RPG begin to surpass its Japanese counterparts." -IGN top 100 RPGs of all time
Tsalop88
Member
Posts: 55
Joined: Fri Mar 20, 2009 2:35 pm
Location: Loppi

Re: Bitmap font

Post by Tsalop88 »

Yep. Aloitin sen tekemisen tosin alusta tuossa syyskuun tienoilla. Tämän viikon aikana julkaisen uudesta enginestä
demon (olen tosin jo aikaisemmin postannut pelistä demon toiselle foorumille mutta sorsaa on siitä uusittu aika lailla).

Tällä hetkellä tilanne on tosin seuraava... Kaikki tasot on jo tehty mutta itse pomotappelut pitäisi koodata.
Myös pelimoottorin osalta kaikki olennainen on tehty. Pomoja lukuunottamatta pelistä puuttuu enää hieman
grafiikkaa eri lopetuksia varten ja tietysti musiikki (ajattelin tehdä omia kappaleita ja remixejä - demossa
tosin vielä soi alkuperäisten touhou-pelien midejä).

Pyrin siihen, että kun peli on viimein valmis niin julkaisen sorsasta sellaisen version, että kuka tahansa pystyisi tekemään
simppeleitä shmuppeja ilman hirvittävää työmäärää (esimerkiksi tasot luettaisiin tekstitiedostosta).
Post Reply