Tällä kertaa aiheena on grafiikka. CB:ssä on valmis kuvamoottori ja objektimoottori, mutta kumpikaan ei oikein soveltunut omiin tarkoituksiini. Tarvitsin pyöritettävää grafiikkaa, jota objektit tarjoaisivat, mutta niitä täytyisi kloonata, mikäli sama kuva toistuisi monta kertaa. Lisäksi niiden piilottaminen edellyttäisi ShowObjektin kanssa kikkailua. Kuvat olisivat oikea ratkaisu, mikäli Blitzin softablitteri ei olisi liian tehoton pyörittelemään kuvia reaaliaikaisesti.
Kirjoitin yksinkertaisen tyyppi-muistipala -yhdistelmää käyttävän systeemin, jossa kuvat pyöritellään latauksen yhteydessä kuten objektit, mutta niitä voi silti piirrellä aivan kuten tavallisia kuvia.
Harkitsin myös kuvan skaalauksen sisällyttämistä, mutta ainakin toistaiseksi benchmarkkini näyttävät sille punaista valoa, mikäli käyttäjä ei halua odotella pelin latausta minuuttitolkulla. Toki esimerkiksi peleissä, jossa objektit pyörivät 45 asteen askelein, latausaika tuskin olisi ongelma. Lisään (tai joku muukin saa toki koodiani modailla) sen jälkikäteen, mikäli tarvetta ilmenee.
Esimerkkeineen päivineen:
Code: Select all
//==========================================================================================
//KIRJASTO
Type TEXTURE
Field iD% //Tekstuurin kahva
Field numRotations% //Eri asentojen määrä
Field interval# //Vierekkäisten asentojen väli (=360 / numRotations)
Field texMem% //Kahva muistipalalle, johon säilötään pöritettyjen kuvien kahvat
EndType
//LoadTexture%(path$, n%, mR%=0, mG%=0, mB%=0)
// Lataa tekstuurin piirtovalmiiksi muistiin
//path$ - kuvan sijainti levyllä
//n% - pyörityslaatu
//m{R,G,B}% - maskivärin RGB-komponentit
Function LoadTexture%(path$, n%, mR%=0, mG%=0, mB%=0)
Dim t.TEXTURE
t = New(TEXTURE)
t\iD = ConvertToInteger(t)
t\numRotations = n
t\interval = 360.0/n
t\texMem = MakeMEMBlock(4*n)
Dim masterImg, tmpImg
If mR + mG + mB <> 0 Then
tmpImg = LoadImage(path$)
MaskImage tmpImg, mR, mG, mB
masterImg = MakeImage(ImageWidth(tmpImg), ImageHeight(tmpImg))
DrawToImage masterImg
DrawImage tmpImg, 0, 0
DrawToScreen
HotSpot masterImg
DeleteImage tmpImg
Else
masterImg = LoadImage(path$)
EndIf
If Not masterImg Then MakeError "Unable To load Image from '"+path+"'"
HotSpot masterImg
PokeInt t\texMem, 0, masterImg
Dim i As Integer
For i = 1 To n - 1
tmpImg = CloneImage(masterImg)
RotateImage tmpImg, -t\interval * i
PokeInt t\texMem, 4*i, tmpImg
Next i
Return t\iD
EndFunction
//DrawTexture(tex%, tx#, ty#, angle#, muteError% = 1)
// Piirtää yksittäisen tekstuurin
//tex% - tekstuurin kahva LoadTexture()-funktiolta
//t{x,y}# - piirtokoordinaatit (ikkunakoordinaatistossa)
//angle# - asento asteina
//muteError - jos = True, jätetään piirtämättä eikä anneta virheilmoitusta, jos tekstuuri on tyhjä
Function DrawTexture(tex%, tx#, ty#, angle#, muteError% = 1)
Dim t.TEXTURE
t = ConvertToType(tex%)
If (Not t\texMem) Or (Not t\iD) Or t = NULL Then
If Not muteError Then MakeError "Invalid texture handle!"
Return False
EndIf
Dim index% As Integer
index = Int(WrapAngle(angle)/t\interval)
DrawImage PeekInt(t\texMem, 4*(index*(index<t\numRotations))), tx, ty
Return True
EndFunction
//DrawTextureList(list%, muteError% = 1)
// Piirtää listan(muistipala) tekstuureita yhdellä funktiokutsulla
//list% - tekstuurilistamuistipalan kahva
//muteError - jos = True, jätetään piirtämättä eikä anneta virheilmoitusta, jos lista on epäkelpo tai tekstuuri on tyhjä
Function DrawTextureList(list%, muteError% = 1)
Dim listSize% As Integer
listSize = MEMBlockSize(list)
If listSize Mod 16 <> 0 Then
If Not muteError Then MakeError "Invalid texture list!"
Return False
EndIf
Dim ret
ret = True
Dim i% As Integer
For i = 0 To (listSize / 16) - 1
Dim t.TEXTURE
t = ConvertToType(PeekInt(list, 16*i))
If (Not t\texMem) Or (Not t\iD) Or t = NULL Then
If Not muteError Then MakeError "Invalid texture handle!"
ret = False
Else
Dim index% As Integer
index = Int(WrapAngle(PeekFloat(list, 16*i+12))/t\interval)
DrawImage PeekInt(t\texMem, 4*(index*(index<t\numRotations))), PeekFloat(list, 16*i+4), PeekFloat(list, 16*i+8)
EndIf
Next i
Return ret
EndFunction
//Function ClearTexture(tex%)
// Tyhjentää tekstuurin vaatiman muistin lukuunottamatta tyyppi-instanssia
// Tyhjän tekstuurin piirtäminen ei kaada ohjelmaa, jos muteError = True
//tex% - tekstuurin kahva
Function ClearTexture(tex%)
Dim t.TEXTURE
t = ConvertToType(tex%)
If Not t\texMem Then MakeError "Texture already cleared!"
Dim i
For i = 0 To t\numRotations - 1
DeleteImage PeekInt(t\texMem, 4*i)
Next i
DeleteMEMBlock(t\texMem)
t\texMem = 0
EndFunction
//Function DeleteTexture(tex%)
// Poistaa tekstuurin kokonaan
// Poistetun tekstuurin piirtäminen tuottaa toinen toistaan mielenkiintoisempia virheilmoituksia...
//tex% - tekstuurin kahva
Function DeleteTexture(tex%)
If tex <= 0 Then MakeError "Invalid texture handle!"
Dim t.TEXTURE
t = ConvertToType(tex%)
If t = NULL Then MakeError "Invalid texture handle!"
If t\texMem Then ClearTexture(t\iD)
Delete t
EndFunction
//==========================================================================================
//ESIMERKKI
Const SCRW = 640
Const SCRH = 480
SCREEN SCRW, SCRH, 0, 1
Smooth2D ON
Const COWS = 1000 //LEHMIEN MÄÄRÄ
Dim cow(COWS-1, 5) As Float
//Luodaan satunnaisia lehmiä
Dim i
For i = 0 To COWS-1
cow(i, 0) = Rnd(SCRW) //Paikka
cow(i, 1) = Rnd(SCRH)
cow(i, 2) = Rnd(-4,4) //Nopeus
cow(i, 3) = Rnd(-4,4)
cow(i, 4) = Rnd(360) //Asento
cow(i, 5) = Rnd(-5,5) //Kulmanopeus
Next i
Dim cowTexture% As Integer //Ladataan YKSI tekstuuri. Ei kloonausta tai muuta säätöä.
cowTexture = LoadTexture("Media/cow.bmp", 720)
Dim cowList% As Integer //Tehdään tekstuureille lista (vrt. OpenGL:n display list), jotta piirtäminen ON nopeampaa
cowList = MakeMEMBlock(16*COWS)
SAFEEXIT OFF
While Not EscapeKey()
For i = 0 To COWS-1
cow(i, 0) = cow(i, 0) + cow(i, 2)
cow(i, 1) = cow(i, 1) + cow(i, 3)
cow(i, 4) = cow(i, 4) + cow(i, 5)
//Siirretään ruudun ulkopuoliset lehmät toiseen laitaan
If cow(i, 0) > SCRW Then cow(i, 0) = cow(i, 0) - SCRW
If cow(i, 0) < 0 Then cow(i, 0) = cow(i, 0) + SCRW
If cow(i, 1) > SCRH Then cow(i, 1) = cow(i, 1) - SCRH
If cow(i, 1) < 0 Then cow(i, 1) = cow(i, 1) + SCRH
//Tekstuurin tiedot syötetään järjestyksessä: kahva, koordinaatit (x, y), kulma
PokeInt cowList, 16*i, cowTexture
PokeFloat cowList, 16*i+4, cow(i, 0)
PokeFloat cowList, 16*i+8, cow(i, 1)
PokeFloat cowList, 16*i+12, cow(i, 4)
Dim result% As Integer
//result = DrawTexture(cowTexture, cow(i, 0), cow(i, 1), cow(i, 4))
Next i
//Vertaa suorituskykyä kommentoimalla tätä seuraava rivi sekä poistamalla rivin 187 kommentointi.
result = DrawTextureList(cowList)
If result = False Then Text 5, 50, "DrawTexture failed!"
If KeyHit(cbKeySpace) Then ClearTexture(cowTexture)
If KeyHit(cbKeyD) Then DeleteTexture(cowTexture)
DrawScreen
SetWindow "FPS: " + FPS() + " Cows: " + COWS
Wend
DeleteMEMBlock(cowList)
Deletetexture(cowTexture)
End
21.3.2010:
DrawTextureList()-funktio lisätty. Kiitos ja kumarrus ideasta otto90x:n suuntaan.
Funktion käyttö ilmenee esimerkistä. Yksi tekstuuri kerraallaan -piirto on edelleen käytettävissä. Kokeilkaa nopeuseroa.
Tekstuurilistan käyttö vähentää dramaattisesti funktiokutsuja, mikä vaikuttaa vastaavalla tavalla suorituskykyyn. Itelläni ruudunpäivitystaajuus parhaimmillaan tuplaantui 15 -> 30 FPS. Alustana siis Asus EeePc 901 + Win XP ja lehmien määrä 1000.