Re: Efektit
Posted: Sun Nov 30, 2008 5:56 pm
Tuosta tulikin mieleeni, minulla oli kehitteillä suht. koht. hyvä ascii kirjasto efektejä ym. varten. Taidan postata tänne parin esimerkin kera kunhan vähän siistin koodia.
Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /nevssons wrote:Pätkii ärsyttävästiDatsuniG wrote:Ascii räjähdyksiä : PCode: Select all
koodia
Olen näköjään sitten käsittänyt tuon exit-komennon vähän väärällä tavalla : /
Ööh, entä jos vaikka jätät exitin pois? Turhaa kai lopettaa päivittäminen kesken jos YKSI partikkeli tuhotaan?DatsuniG wrote:Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /nevssons wrote:Pätkii ärsyttävästiDatsuniG wrote:Ascii räjähdyksiä : PCode: Select all
koodia
Se aiheuttaa aika herkästi MAVin ainakin omien kokemusten pohjalta.m1c wrote:Ööh, entä jos vaikka jätät exitin pois? Turhaa kai lopettaa päivittäminen kesken jos YKSI partikkeli tuhotaan?DatsuniG wrote:Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /nevssons wrote: Pätkii ärsyttävästi
Code: Select all
Type AscThr
Field ThrID
Field ThrCurrentParticles
EndType
Type AscParticles
Field ParticleLetter$
Field ParticleX
Field ParticleY
Field ParticleAngle
Field ParticleDistance
EndType
CreateAsciiThruster(1)
Repeat
Text 0,0,FPS()
If MouseDown(1) Then uusi=1 Else uusi=0
UpdateAsciiThrusters(uusi,1,MouseX(),MouseY(),0,359,250,3,120,62)
DrawScreen
Forever
Function CreateAsciiThruster(id) // ID = Thrusterin ID
uusi.AscThr = New(AscThr)
uusi\ThrID=ID
uusi\ThrCurrentParticles=0
EndFunction
// MODE = Uusien partikkelien lisäys 1 = ON / 0 = OFF
// Id Thrusterin ID
// X = X-koordinaatti
// Y = Y-koordinaatti
// Angle1 = Aloituskulma
// Angle2 = Lopetuskulma
// Maxpar = Partikkelien maksimimäärä
// Speed = Nopeus
// Maxdis = Maksimi etäisyys ennenkuin tuhotaan
// Spread = Lopetuspisteestä vähennettävä satunnainen summa, mieluiten puolet maxdistancen arvosta
Function UpdateAsciiThrusters(mode,id,x,y,angle1,angle2,maxpar,speed,maxdis,spread)
For uusi.AscThr = Each AscThr
If uusi\ThrID = id Then
If uusi\ThrCurrentParticles<Maxpar Then
If mode=True Then
For i=1 To Maxpar-uusi\ThrCurrentparticles
Create.AscParticles = New(AscParticles)
Create\Particleletter = Chr(Rand(35,38))
Create\ParticleX=x
Create\ParticleY=y
Create\Particleangle=Rand(angle1,angle2)
Create\ParticleDistance = 0
uusi\ThrCurrentParticles=uusi\ThrCurrentParticles+1
Next i
EndIf
EndIf
For Create.AscParticles = Each AscParticles
If Create\ParticleDistance>Maxdis-Rand(spread) Then
uusi\ThrCurrentParticles=uusi\ThrCurrentParticles-1
Delete create
EndIf
Create\ParticleDistance=Create\ParticleDistance+speed
Text Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance,Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance,create\Particleletter
Next create
EndIf
Next uusi
EndFunction
Code: Select all
Repeat
For i=1 To 60
For a=1 To 20
For e=1 To 10
Color Rand(0,100),Rand(0,255),Rand(0,255)
Line ScreenWidth()/2*Cos(8000)*Sin(10)/Cos(800)/Sin(2),ScreenHeight()/2*Sin(i),ScreenWidth()*Cos(70)/Sin(300),CurveValue(a*5,i*3,35)*2
Next e
Next a
Next i
DrawScreen
Forever
Code: Select all
SCREEN 800,600
Repeat
For i=1 To 600 Step 6
r=r+12
If r>255 Then r=0 : g+12
If g>255 Then b+12 : g=0
If b>255 Then b=0
Color r,g,b
Line ScreenWidth()/2+Cos(WrapAngle(i))*i,i-Sin(WrapAngle(i))*i,ScreenWidth()/2+Cos(WrapAngle(i+180))*i,i-Sin(WrapAngle(i-180))*i
DrawScreen
Next i
Forever
Ei niin. Sanoinhan sen pelkän sekoituksen aikana.DatsuniG wrote:Sori, mutta koodissasi ei ole mitään järkeä : /
Code: Select all
Repeat
For i=1 To 360 Step 1
Color Rand(0,255),Rand(0,255),Rand(0,255)
Line ScreenWidth()/2*i*i/2*80,ScreenHeight()/2*i*i/2*800,i+Cos(WrapAngle(i+180*3))*i*2,i-Sin(WrapAngle(i+180/3*2*2*10/2))*i
DrawScreen OFF
Next i
Forever
Code: Select all
SCREEN 800,600
SetWindow "Valo-viivan lento"
Repeat
For i=1 To 600 Step 1
Color Rand(0,255),Rand(0,255),Rand(0,255)
Line ScreenWidth()/2+Cos(WrapAngle(i))*i,i-Sin(WrapAngle(i*5/2))*i,ScreenWidth()/2+Cos(WrapAngle(i+180*3))*i/3*2,i-Sin(WrapAngle(i+180*2))*i/2
DrawScreen
Next i
Forever
Code: Select all
img = LoadImage("media/soldier.bmp")
aika=Timer()
img1 = WrapImage(img,1)
väliaika1=Timer()-aika : aika=Timer()
img2 = Wrapimage(img,2)
väliaika2=Timer()-aika
Color cbwhite
DrawImage img,20,20
Text 72,22,"Alkuperäinen"
DrawImage img1,20,80
Text 72,82,"Mode 1 - Aikaa kului: "+väliaika1+"ms"
DrawImage img2,20,140
Text 72,142,"Mode 2 - Aikaa kului: "+väliaika2+"ms"
DrawScreen
WaitKey
Function WrapImage(img,mode)
img1 = MakeImage(ImageWidth(img),ImageHeight(img))
DrawToImage img1
Select mode
Case 1
For i=ImageWidth(img) To 0 Step -1
For a=ImageHeight(img) To 0 Step -1
PickImageColor img,Imagewidth(img)-i,imageheight(img)-a
Dot Abs(i),Abs(a)
Next a
Next i
Case 2
For i=0 To ImageWidth(img)
For a=ImageHeight(img) To 0 Step -1
PickImageColor img,i,imageheight(img)-a
Dot i,Abs(a)
Next a
Next i
Default
MakeError "Invalid mode!"
EndSelect
DrawToScreen
Return img1
EndFunction
Code: Select all
img = LoadImage("media/soldier.bmp")
aika=Timer()
img1 = WrapImage(img,1)
väliaika1=Timer()-aika : aika=Timer()
img2 = Wrapimage(img,2)
väliaika2=Timer()-aika
Color cbwhite
DrawImage img,20,20
Text 72,22,"Alkuperäinen"
DrawImage img1,20,80
Text 72,82,"Mode 1 - Aikaa kului: "+väliaika1+"ms"
DrawImage img2,20,140
Text 72,142,"Mode 2 - Aikaa kului: "+väliaika2+"ms"
DrawScreen
WaitKey
Function WrapImage(img,mode)
img1 = MakeImage(ImageWidth(img),ImageHeight(img))
Lock Image(img)
Lock Image(img1)
Select mode
Case 1
For i=ImageWidth(img) To 0 Step -1
For a=ImageHeight(img) To 0 Step -1
PutPixel2 Abs(i),Abs(a),GetPixel2(ImageWidth(img)-i,ImageHeight(img)-a,Image(img)),Image(img1)
Next a
Next i
Case 2
For i=0 To ImageWidth(img)
For a=ImageHeight(img) To 0 Step -1
PutPixel2 i,Abs(a),GetPixel2(i,ImageHeight(img)-a,Image(img)),Image(img1)
Next a
Next i
Default
MakeError "Invalid mode!"
EndSelect
Unlock Image(img)
Unlock Image(img1)
Return img1
EndFunction
No eipä ole enään nopeampi
E2: Arghh, tämä on nopeampi vain pienillä kuvilla ^^
Code: Select all
img = LoadImage("media/soldier.bmp")
aika=Timer()
img1 = WrapImage(img,1)
väliaika1=Timer()-aika : aika=Timer()
img2 = Wrapimage(img,2)
väliaika2=Timer()-aika : aika = Timer()
Color cbwhite
img3 = CloneImage(img)
ResizeImage img3,-ImageWidth(img3),ImageHeight(img3)
väliaika3 = Timer()-aika
DrawImage img,20,20
Text 72,22,"Alkuperäinen"
DrawImage img1,20,80
Text 72,82,"Mode 1 - Aikaa kului: "+väliaika1+"ms"
DrawImage img2,20,140
Text 72,142,"Mode 2 - Aikaa kului: "+väliaika2+"ms"
DrawImage img3,20,200
Text 72,202,"Resizeimage - Aikaa kului: "+väliaika3+"ms"
DrawScreen
WaitKey
Function WrapImage(img,mode)
img1 = MakeImage(ImageWidth(img),ImageHeight(img))
DrawToImage img1
Select mode
Case 1
For i=ImageWidth(img) To 0 Step -1
For a=ImageHeight(img) To 0 Step -1
PickImageColor img,Imagewidth(img)-i,imageheight(img)-a
Dot Abs(i),Abs(a)
Next a
Next i
Case 2
For i=0 To ImageWidth(img)
For a=ImageHeight(img) To 0 Step -1
PickImageColor img,i,imageheight(img)-a
Dot i,Abs(a)
Next a
Next i
Default
MakeError "Invalid mode!"
EndSelect
DrawToScreen
Return img1
EndFunction
Code: Select all
//CYBERPUNK-SKANNERI - AALTOILEVA
Const SW = 1280 'RUUDUN LEVEYS
Const SH = 1024 'RUUDUN KORKEUS
Const FULLSCREEN = 1 'ONKO FULLSCREEN
Const KOKO = 20 'RUUTUJEN KOKO
Const VALI = 4 'TYHJÄÄ RUUTUJEN VÄLILLÄ
Const SPEED = 100 'SKANNAUSVIIVAN HITAUS - PIENEMPI NOPEAMPI
Const ODOTUS = 3000 'KUINKA KAUAN ODOTETAAN UUDEN KIERROKSEN ALKUA
Const VARI = 0 'Selkeyttämässä koodia, älä koske näihin ;)
Const KOHDE = 1
If FULLSCREEN Then
SCREEN SW,SH,0,0
Else
SCREEN SW,SH
EndIf
global ruutujax : ruutujax = SW/KOKO
global ruutujay : ruutujay = SH/KOKO
Dim ruutu(ruutujaX,ruutujaY,1)
arvoVarit()
Repeat
a + 6
If Timer() > tick Then
ScanX = ScanX + 1
tick = Timer() + SPEED
If scanX = ruutujaX Then palautus = Timer() + ODOTUS
EndIf
If Timer() > palautus And ScanX > ruutujaX Then
ScanX = 0
ArvoVarit()
EndIf
For x = 0 To ruutujaX
For y = 0 To ruutujaY
If x = ScanX Then
ruutu(x,y,VARI) = ruutu(x,y,KOHDE)
Color 0,max(30,ruutu(x,y,VARI)),0
Else
ruutu(x,y,VARI) = Max(10,ruutu(x,y,VARI) - 3)
Color 0,ruutu(x,y,VARI),0
EndIf
xp = x*KOKO + Cos(a+y)*25
yp = y*KOKO + Sin(a*1.8+x)*13
tkoko = Float(KOKO-VALI)
Box xp,yp,tkoko,tkoko
j +1
Next y
Next x
DrawScreen
Forever
Function ArvoVarit(mustaa = 20,minVari = 150)
For x = 0 To ruutujaX
For y = 0 To ruutujaY
If Not Rand(mustaa) Then
ruutu(x,y,KOHDE) = Rand(minVari,255)
EndIf
Next y
Next x
End Function
Code: Select all
//CYBERPUNK-SKANNERI - KUVANLUKIJA
Const SW = 800 'RUUDUN LEVEYS
Const SH = 600 'RUUDUN KORKEUS
Const FULLSCREEN = 0 'ONKO FULLSCREEN
Const KOKO = 15 'RUUTUJEN KOKO
Const VALI = 5 'TYHJÄÄ RUUTUJEN VÄLILLÄ
Const SPEED = 100 'SKANNAUSVIIVAN HITAUS - PIENEMPI NOPEAMPI
Const ODOTUS = 3000 'KUINKA KAUAN ODOTETAAN UUDEN KIERROKSEN ALKUA
Const rVARI = 0 'Selkeyttämässä koodia, älä koske näihin ;)
Const KOHDE = 1
Global vari : vari = RED //VAIHDA TÄSTÄ SKANNATTAVA VÄRI
If FULLSCREEN Then
SCREEN SW,SH,0,0
Else
SCREEN SW,SH
EndIf
Global ruutujax : ruutujax = SW/KOKO
Global ruutujay : ruutujay = SH/KOKO
Dim ruutu(ruutujaX,ruutujaY,1)
'arvoVarit()
Global tImg
timg = LoadImage("media/map.bmp")
ResizeImage timg,ruutujax,ruutujay
varitKuvasta(timg,vari)
Repeat
If Timer() > tick Then
ScanX = ScanX + 1
tick = Timer() + SPEED
If scanX = ruutujaX Then palautus = Timer() + ODOTUS
EndIf
If Timer() > palautus And ScanX > ruutujaX Then
ScanX = 0
'ArvoVarit()
EndIf
For x = 0 To ruutujaX
For y = 0 To ruutujaY
If x = ScanX Then
ruutu(x,y,rVARI) = ruutu(x,y,KOHDE)
Select vari
Case RED
Color Max(30,ruutu(x,y,rVARI)),0,0
Case GREEN
Color 0,Max(30,ruutu(x,y,rVARI)),0
Case BLUE
Color 0,0,Max(30,ruutu(x,y,rVARI))
End Select
Else
ruutu(x,y,rVARI) = Max(10,ruutu(x,y,rVARI) - 3)
Select vari
Case RED
Color ruutu(x,y,rVARI),0,0
Case GREEN
Color 0,ruutu(x,y,rVARI),0
Case BLUE
Color 0,0,ruutu(x,y,rVARI)
End Select
EndIf
Box x*KOKO,y*KOKO,KOKO-VALI,KOKO-VALI
j +1
Next y
Next x
DrawScreen
Forever
Function ArvoVarit(mustaa = 20,minVari = 150)
For x = 0 To ruutujaX
For y = 0 To ruutujaY
If Not Rand(mustaa) Then
ruutu(x,y,KOHDE) = Rand(minVari,255)
EndIf
Next y
Next x
End Function
Function VaritKuvasta(kuva,_vari)
vari = _vari
Lock Image(kuva)
For x = 0 To ruutujaX
For y = 0 To ruutujaY
pix = GetPixel2(x,y,Image(kuva))
r = PixelToRGB(pix,_vari)
ruutu(x,y,KOHDE) = r
Next y
Next x
Unlock
End Function
Function PixelToRGB(pixel,format=0)
If format < 0 Or format > 3 Then MakeError "pixelToRGB(): Incorrect format: "+format
If format = 0 Then Color r,g,b Else Return (pixel Shl 8 * format) Shr 24
End Function
Code: Select all
SCREEN 800,600
ky = ScreenHeight()/2
Color 20,20,60
Repeat
Text 10,10,"Paina välilyöntiä..."
a + 5
If KeyHit(cbkeyspace) Then
efxnum = efxnum + KeyHit(cbkeyspace)
If efxnum > 4 Then efxnum = 0
a = 0
EndIf
Lock
For x = 0 To ScreenWidth()
For y = 200 To ScreenHeight()-200 Step 20
Select efxnum
Case 0
PutPixel2 x,y+Sin(x*(a-y)/1000)*10,y*a/(x+1)
Case 1
PutPixel2 x,y+Sin(x*a/100)*100,a*y+x
Case 2
PutPixel2 x,y+Sin(x+a)*x/10,a+2000-(y*3*x)
Case 3
PutPixel2 x,y+Sin(x+a)*x/10,a+2000-(y*3)
Case 4
PutPixel2 x,y+Sin(x*(a-y)/1000)*x/10,x*a-1000*y*a
End Select
Next y
Next x
Unlock
DrawScreen
Forever
Code: Select all
SCREEN 800,600
Include "pyromax\pyromax.cb"
rajahdys=500
For i=1 To 600
r=pyro_createrocket(400,600,90,200,0,0,255,rajahdys,500,1000)
For a=1 To 2
pyro_attacheffect(r,100,255,Rand(0,100),0,5000,500)
Next a
rajahdys=rajahdys+1000
Next i
pyro_initall()
Repeat
pyro_updateall()
DrawScreen
Until GetKey()
Code: Select all
Const Quality = 1
SCREEN 800,600
Img = LoadImage("media/map.bmp")
tmp = MakeImage(ScreenWidth(),ScreenHeight())
Repeat
Text 2,ScreenHeight()-TextHeight("TEST"),"TEST"
DrawImage img,0,0
DrawImage img,ImageWidth(img),ImageHeight(img)
seed=seed+1
WaveScreen(tmp,30,seed)
Text 0,0,"FPS: "+FPS()
DrawScreen
Forever
Function Wavescreen(img,Wavelenght,seed=1,Smoothness#=1)
CopyBox 0,0,ScreenWidth(),ScreenHeight(),0,0,SCREEN(),Image(img)
Cls
For i=-Wavelenght To ScreenWidth()+wavelenght Step QUALITY
CopyBox i,0,QUALITY,ScreenHeight()+Wavelenght*2,i-ScreenWidth()/2,(RoundDown(a-Sin(WrapAngle((seed+i)/smoothness))*wavelenght))-ScreenHeight()/2,Image(img),SCREEN()
Next i
EndFunction
Haluatko niin että kirjaimet pomppivat yksittäin vai pikselitarkasti?Jani wrote:Voisitko tehdä samaan tyyliin tekstille, DatsuniG?
Tai joku muu
Code: Select all
SetFont(LoadFont("impact", 20))
Repeat
a + 1
wavetext("KilledWhale", 0, 0, a * 1, 5, 15, 1)
DrawScreen
Forever
Function wavetext(txt$, x, y, seed, seed2, r, roughness = 1)
k = MakeImage(TextWidth(txt), TextHeight(txt))
DrawToImage k
Text 0, 0, txt$
DrawToScreen
For i = 0 To ImageWidth(k) / roughness
DrawImageBox k, x + i * roughness, y + r - Sin(i * seed2 + seed) * r, i * roughness, 0, roughness, ImageHeight(k)
Next i
DeleteImage k
EndFunction
Code: Select all
SCREEN 1024,768
Type particle
Field lifetime
Field x#
Field y#
Field life#
Field r As Byte
Field g As Byte
Field b As Byte
Field mult#
Field ang#
Field update
End Type
SetWindow "Piirrä hiiren ensimmäisellä näppäimellä. Välilyönti tyhjentää ruudun."
ClsColor 200,200,200
Cls
Repeat
mx#=MouseMoveX()
my#=MouseMoveY()
mang#=-GetAngle(0,0,mx#,my#)
mdis#=Distance(0,0,mx#,my#)
If mdis#>0.0 And mdis#<100.0 And MouseDown(1) Then
Color Rand(20),Rand(20),rand(50)
AddSpiralParticle(MouseX(),MouseY(),mang#+180,Rnd(-(5.0/(10.0+mdis#)),(5.0/(10.0+mdis#))),5*mdis#)
If mox# And moy# Then
Line MouseX(),MouseY(),mox#,moy#
EndIf
mox#=MouseX()
moy#=MouseY()
Else
mox#=0.0
moy#=0.0
EndIf
UpdateParticles()
If KeyHit(cbkeyspace) Then
For p.particle=Each particle
Delete p
Next p
Cls
EndIf
DrawScreen OFF
Wait 2
Forever
Function AddSpiralParticle(_x#,_y#,_ang#,_mult#,_len#=100.0,_life=1)
r=getRGB(1)
g=getRGB(2)
b=getRGB(3)
p.particle=New(particle)
p\x=_x#
p\y=_y#
p\ang=_ang#
p\mult=_mult
p\lifetime=_len#
p\r=r
p\g=g
p\b=b
p\life=_life
p\update=1 // spiraali
Return ConvertToInteger(p)
EndFunction
Function UpdateParticles()
Lock
For p.particle=Each particle
Select p\update
Case 1
If 1<p\x And p\x<ScreenWidth()-1 And 1<p\y And p\y<ScreenHeight()-1 Then
a=GetPixel2 (Int(p\x),int(p\y))
r=PixelToRGB(a,1)
g=PixelToRGB(a,2)
b=PixelToRGB(a,3)
col#=(Float(p\lifetime-p\life)/Float(p\lifetime))
a = RGBToPixel( Float(r)*(1-col#)+Float(p\r)*col#,Float(g)*(1-col#)+Float(p\g)*col#,Float(b)*(1-col#)+Float(p\b)*col# )
PutPixel2 int(p\x),int(p\y),a
EndIf
p\ang#=p\ang+p\mult*p\life
p\x=p\x+Cos(p\ang)
p\y=p\y+Sin(p\ang)
Default
End Select
p\life=p\life+1.0
If p\lifetime-p\life<=0 Then Delete p
Next p
Unlock
End Function
Function Spiral(_x#,_y#,_ang#,_mult#,_len=100)
r=getRGB(1)
g=getRGB(2)
b=getRGB(3)
Lock
For i = 0 To _len
a=GetPixel2 (int(_x#),int(_y#))
rr=PixelToRGB(a,1)
gg=PixelToRGB(a,2)
bb=PixelToRGB(a,3)
col#=(Float(_len-i)/Float(_len))
a = RGBToPixel( Float(rr)*(1-col#)+Float(r)*col#,Float(gg)*(1-col#)+Float(g)*col#,Float(bb)*(1-col#)+Float(b)*col# )
PutPixel2 int(_x#),int(_y#),a
_ang#=_ang#+_mult#*i
_x#=Min(Max(_x#+Cos(_ang#),0.0),ScreenWidth())
_y#=Min(Max(_y#+Sin(_ang#),0.0),ScreenHeight())
Next i
Unlock
EndFunction
Function PixelToRGB(pixel,format=0)
//Converts pixel -> RGB
//pixel: 32 bit pixel value (integer)
//format: 0: set result To current drawing Color (And Return 0)
// 1: Return only RED
// 2: Return only GREEN
// 3: Return only BLUE
//Instead of numbers 1-3, you may also use constants RED, GREEN And BLUE To indicate which Color component you want To be returned.
If format < 0 Or format > 3 Then MakeError "pixelToRGB(): Incorrect format: "+format
pixel = pixel Shl 8
r = pixel Shr 24
If format = 1 Then Return r 'Return RED
pixel = pixel Shl 8
g = pixel Shr 24
If format = 2 Then Return g 'Return GREEN
pixel = pixel Shl 8
b = pixel Shr 24
If format = 3 Then Return b 'Return BLUE
If format = 0 Then
'Make the result To be our current drawing Color
Color r,g,b
Return False 'We do Not need To Return any value in this Case.
EndIf
EndFunction
Function RGBToPixel(r,g,b)
//Converts RGB -> pixel
Return b + (g Shl 8) + (r Shl 16) + (255 Shl 24)
EndFunction
Vauhtiviivoja? Mihin tarkoitukseen? Mutta on tuo hauskan näköinen.otto90x wrote:Yritin tehdä jonkinlaisia vauhtiviivoja, mutta en kyllä ole vielä tyytyväinen. Toteutusehdotuksia?
Code: Select all
koodia
Code: Select all
SCREEN 1024,768
Type particle
Field lifetime
Field x#
Field y#
Field life#
Field r As Byte
Field g As Byte
Field b As Byte
Field mult#
Field ang#
Field update
End Type
ShowMouse OFF
SetWindow "Liikuta hiirtä ikkunan sisällä hitaasti. Välilyönti tyhjentää ruudun."
ClsColor 200,200,200
Cls
mox#=MouseX()
moy#=MouseY()
Repeat
mx#=MouseMoveX()
my#=MouseMoveY()
mang#=-GetAngle(0,0,mx#,my#)
mdis#=Distance(0,0,mx#,my#)
If mdis#>0.0 And mdis#<100.0 Then
Color Rand(20),Rand(20),rand(50)'Rand(200,150),Rand(200,150),0
'For k=1 To 2
AddSpiralParticle(MouseX(),MouseY(),mang#+180,Rnd(-(5.0/(10.0+mdis#)),(5.0/(10.0+mdis#))),5*mdis#)
'Next k
EndIf
UpdateParticles()
If KeyHit(cbkeyspace) Then
For p.particle=Each particle
Delete p
Next p
Cls
EndIf
Color 15,15,30
Line MouseX(),MouseY(),mox#,moy#
mox#=MouseX()
moy#=MouseY()
DrawScreen OFF
Wait 2
Forever
Function AddSpiralParticle(_x#,_y#,_ang#,_mult#,_len#=100.0,_life=1)
r=getRGB(1)
g=getRGB(2)
b=getRGB(3)
p.particle=New(particle)
p\x=_x#
p\y=_y#
p\ang=_ang#
p\mult=_mult
p\lifetime=_len#
p\r=r
p\g=g
p\b=b
p\life=_life
p\update=1 // spiraali
Return ConvertToInteger(p)
EndFunction
Function UpdateParticles()
For p.particle=Each particle
Select p\update
Case 1
If 0<p\x<ScreenWidth() And 0<p\y<ScreenHeight() Then
PickColor p\x,p\y
r=getRGB(1)
g=getRGB(2)
b=getRGB(3)
col#=(Float(p\lifetime-p\life)/Float(p\lifetime))
Color Float(r)*(1-col#)+Float(p\r)*col#,Float(g)*(1-col#)+Float(p\g)*col#,Float(b)*(1-col#)+Float(p\b)*col#
Dot p\x,p\y
EndIf
p\ang#=p\ang+p\mult*p\life
p\x=p\x+Cos(p\ang)
p\y=p\y+Sin(p\ang)
Default
End Select
p\life=p\life+1.0
If p\lifetime-p\life<=0 Then Delete p
Next p
End Function
Function Spiral(_x#,_y#,_ang#,_mult#,_len=100)
r=getRGB(1)
g=getRGB(2)
b=getRGB(3)
Lock
For i = 0 To _len
'Color r*(Float(_len-i)/Float(_len)),g*(Float(_len-i)/Float(_len)),b*(Float(_len-i)/Float(_len))
'Dot _x#,_y#
PutPixel2 _x#,_y#,RGBToPixel(r*(Float(_len-i)/Float(_len)),g*(Float(_len-i)/Float(_len)),b*(Float(_len-i)/Float(_len)))
_ang#=_ang#+_mult#*i
_x#=_x#+Cos(_ang#)
_y#=_y#+Sin(_ang#)
Next i
Unlock
Color r,g,b
EndFunction
Function RGBToPixel(r,g,b)
//Converts RGB -> pixel
Return b + (g Shl 8) + (r Shl 16) + (255 Shl 24)
EndFunction
Code: Select all
Global MotionBlurX As Float
Global MotionBlurY As Float
Repeat
Circle MouseX()-20,MouseY()-20,40
MotionBlur(MouseX(),MouseY(),3.0,40,20)
// X, Y, Nopeus (isompi = hitaampi), halkaisija, vauhtiviivojen määrä.
DrawScreen
Forever
Function MotionBlur(x#,y#,speed#=5.0,size# = 40, density = 20)
MotionBlurX = MotionBlurX - (MotionBlurX - X)/speed#
MotionBlurY = MotionBlurY - (MotionBlurY - Y)/speed#
For i=1 To density
ang = Rand(360)
Line X+Cos(ang)*size/2,Y-Sin(ang)*size/2,MotionBlurX+Cos(ang)*size/2,MotionBlurY-Sin(ang)*size/2
Next i
EndFunction