Jos pelkän koodin perässä tulit niin selaile tämä viesti loppuun!
Koodi on ensin tehty, sen jälkeen optimoitu koonsa puolesta ja tämänjälkeen viimeistelty parilla nopeusmuunnoksella jotka lisäävät pari riviä ja muistikomennot.
Code: Select all
Const sw=700'jos vaihdat, säädä myös sw2!
Const sh=1000
Const sw2=350'sw2=sw/2
SCREEN sw,sh',32,0
Code: Select all
SetFont LoadFont("arial",1)
Code: Select all
Dim c(359)
For i=0 To 359
h#=i/60.0
x#=1-Abs((h Mod 2)-1)
c(i)=(255 Shl 24)+((x*((h<2 And h>=1) Or (h>=4 And h<5))+(h<1 Or h>=5))*255 Shl 16)+((x*(h<1 Or (h>=3 And h<4))+(h>=1 And h<3))*255 Shl 8)+(x*(h=>5 Or (h>=2 And h<3))+(h>=3 And h<5))*255
Next i
Code: Select all
tb=MakeMEMBlock(20)
PokeFloat tb,0,sw2
PokeFloat tb,4,650.0
PokeFloat tb,12,6.0
PokeFloat tb,16,11.0
Code: Select all
k=WrapAngle(k+1)
Code: Select all
PokeInt tb,8,c(k)
Code: Select all
b=0
Repeat
b+1
Until b=150
Code: Select all
a=Rand(0,360)
l=Rand(1,12)
d.ds=New(ds)
MemCopy tb,0,ConvertToInteger(d),12,20
d\x=d\x+l*Sin(a)
d\y=d\y+l*Cos(a)
d\sX=d\sX+Rnd(-.7,.7)
d\sY=d\sY+Rnd(-.7,.7)
Satunnoidaan 2 arvoa.
Luodaan uusi type-esiintymä partikkeli tyypistä.
Kopioidaan partikkelin arvot muistista type-esiintymään, koska useampi arvo, on tämä nopeampi.
Muokataan vähän äskeisellä muistisiirrolla toteutettuja arvoja, jos koodi olisi ollut jossain rivimäärä rajoitteisessa kisassa, olisi tässäkohin ollut tyyppialustus suoraan.
Code: Select all
Lock
For d.ds=Each ds
d\l+1
d\sY-.4
If d\l>40 Then d\sX-.5
d\x+d\sX
d\y+d\sY
If d\x>sw2 And d\x<sw And d\y>0 And d\y<sh Then
PutPixel2 d\x,sh-d\y,d\c
PutPixel2 sw-d\x,sh-d\y,d\c
drops+2
Else
Delete d
EndIf
Next d
Unlock
Käydään jokainen pikseli for loopissa läpi ja piirretään taululle kahtena toisen ollessa kloonisijainti. Toisinkuin ylemmässä, tässä for loopissa ei ole niin kauheaa ongelmaa nopeuden kannalta, miksi? koska cb tekee ylimääräisen tarkistuksen numeroiden kanssa ja tästä aiheutuu että repeat on nopeampi.
Myöskin lasketaan vähän sijainteja ja sellaisia. Ja muistetaan poistaa näyttöpuskuri lukko! Tuossa tarkistetaan Iffissä ennen pikselien siirtoa onko pikseli tietyllä alueella käyttäen sw2 muuttujaa sw/2 jakolaskun sijaan, jakolaskun ollessa huomattavasti hitaampi kuin muuttujasiirron on tämä huomattavasti nopeampaa.
Code: Select all
Print ""
DrawScreen OFF
Code: Select all
Type ds
Field x#
Field y#
Field c
Field sX#
Field sY#
Field l As Byte
EndType
Const sw=1920
Const sh=1080
Const sw2=960'sw2=sw/2
SCREEN sw,sh,32,0
SetFont LoadFont("arial",1)
Dim c(359)
For i=0 To 359
h#=i/60.0
x#=1-Abs((h Mod 2)-1)
c(i)=(255 Shl 24)+((x*((h<2 And h>=1) Or (h>=4 And h<5))+(h<1 Or h>=5))*255 Shl 16)+((x*(h<1 Or (h>=3 And h<4))+(h>=1 And h<3))*255 Shl 8)+(x*(h=>5 Or (h>=2 And h<3))+(h>=3 And h<5))*255
Next i
tb=MakeMEMBlock(20)
PokeFloat tb,0,sw2
PokeFloat tb,4,650.0
PokeFloat tb,12,6.0
PokeFloat tb,16,11.0
drops=0
Repeat
SetWindow Str(FPS())+"drops: "+drops
k=WrapAngle(k+1)
PokeInt tb,8,c(k)
b=0
Repeat
b+1
a=Rand(0,360)
l=Rand(1,12)
d.ds=New(ds)
MemCopy tb,0,ConvertToInteger(d),12,20
d\x=d\x+l*Sin(a)
d\y=d\y+l*Cos(a)
d\sX=d\sX+Rnd(-.7,.7)
d\sY=d\sY+Rnd(-.7,.7)
Until b=150
drops=0
Lock
For d.ds=Each ds
d\l+1
d\sY-.4
If d\l>40 Then d\sX-.5
d\x+d\sX
d\y+d\sY
If d\x>sw2 And d\x<sw And d\y>0 And d\y<sh Then
PutPixel2 d\x,sh-d\y,d\c
PutPixel2 sw-d\x,sh-d\y,d\c
drops+2
Else
Delete d
EndIf
Next d
Unlock
Print ""
DrawScreen OFF
Forever
DeleteMEMblock tb
Resoluutiosäätö on aika selvää, mutta for->repeat säädössä oleva "until b=150" vaikuttaa pikselimäärän luontiin, mitä isompi luku sitä useamman pikselin tämä luo, omalla koneella toimii tässä kohin "220" ilman drops laskuria pomppii fps ~58-61
Kysymyksiä, kommentteja ja ehdotuksia voi heitellä.
Ja viimeiseksi
http://www.youtube.com/watch?v=Yn6wz498Pzk