Efektit
Re: Efektit
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.
Re: Efektit
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
EDIT:
Olen näköjään sitten käsittänyt tuon exit-komennon vähän väärällä tavalla : /
Last edited by DatsuniG on Sun Nov 30, 2008 8:23 pm, edited 1 time in total.
Hengität nyt manuaalisesti.
Re: Efektit
Öö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
- -Z-
- Devoted Member
- Posts: 682
- Joined: Tue Aug 28, 2007 3:33 pm
- Location: In ur danmaku, grazin ur bullets
Re: Efektit
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
"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
Re: Efektit
No järki mukaan, ei tietenkään enää käytetä poistamisen jälkeen niitä instansseja! Siirrä se poistaminen vaikka viimeiseksi tarkistukseksi, tai laita iffillä: JOS partikkeli on tarpeeksi lähellä määränpäätään, poista se MUUTEN piirrä. Dead simple.
Re: Efektit
Ja lisää ASCII leikkimistä
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
Hengität nyt manuaalisesti.
Re: Efektit
heh... Seka testien (Cos, Sin, jne) testien pohjalta tuli tällänen:
EDIT: sanokaa jos FPS on korkea.
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
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Re: Efektit
Sori, mutta koodissasi ei ole mitään järkeä : /
Teinpäs tässä sitten huvikseni tämmöisen viiva hommelin. Kokeilkaa laittaa myös Drawscreen OFF.
Teinpäs tässä sitten huvikseni tämmöisen viiva hommelin. Kokeilkaa laittaa myös Drawscreen OFF.
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
Hengität nyt manuaalisesti.
Re: Efektit
Jes, tuo DatsuniG:n efekti oli niin hieno että sen vois laittaa vaik näytönsäästäjäksi.
Re: Efektit
Ei niin. Sanoinhan sen pelkän sekoituksen aikana.DatsuniG wrote:Sori, mutta koodissasi ei ole mitään järkeä : /
Voitko muuten hieman opettaa Cosia ja Siniä, DatsuniG?
EDIT: esa34 opettamana:
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
EDIT: Toinen:
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
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Re: Efektit
Teinpäs kivan kuvan peilaamis-funktion.
Ja parannettu versio putpixel2 ja getpixel2 käyttäen
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
EDIT:
No eipä ole enään nopeampi
E2: Arghh, tämä on nopeampi vain pienillä kuvilla ^^
Last edited by DatsuniG on Thu Dec 18, 2008 8:31 pm, edited 4 times in total.
Hengität nyt manuaalisesti.
Re: Efektit
Pikaisen testin perusteella tavallinen ResizeImage on vähän nopeampi.
Tässä vielä muutamat hypnoottiset efektit arkistosta. Aaltoja luvassa.
Ja vielä muutama vanha aaltoiluefekti samassa paketissa. Näpyttele välilyöntiä.
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
Peli piirtokomennoilla - voittaja, Virtuaalilemmikkipeli - voittaja,
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)
Re: Efektit
Tein tämmösen alkeellisen PyroMax: illa toimivan "kuilun".
FPS on tarkoituksella pieni:
FPS on tarkoituksella pieni:
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()
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Re: Efektit
Teinpäs aalto-effektin, joka on yllättävän nopea.
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
Last edited by DatsuniG on Mon Dec 22, 2008 11:41 am, edited 1 time in total.
Hengität nyt manuaalisesti.
Re: Efektit
Voisitko tehdä samaan tyyliin tekstille, DatsuniG?
Tai joku muu
Tai joku muu
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Codegolf: 99 bottles of beer (oneliner) - Water map partition
-
- Tech Developer
- Posts: 545
- Joined: Sun Aug 26, 2007 2:43 pm
- Location: Liminka
Re: Efektit
Haluatko niin että kirjaimet pomppivat yksittäin vai pikselitarkasti?Jani wrote:Voisitko tehdä samaan tyyliin tekstille, DatsuniG?
Tai joku muu
Tässä olis nyt pikselintarkasti pomppiva
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
CoolBasic henkilökuntaa
Kehittäjä
cbFUN Kello
cbSDL
Whale.dy.fi
<@cce> miltäs tuntuu olla suomen paras
Kehittäjä
cbFUN Kello
cbSDL
Whale.dy.fi
<@cce> miltäs tuntuu olla suomen paras
-
- Advanced Member
- Posts: 349
- Joined: Mon Aug 27, 2007 9:00 pm
- Location: Lapinjärvi, Finland
- Contact:
Re: Efektit
Yritin tehdä jonkinlaisia vauhtiviivoja, mutta en kyllä ole vielä tyytyväinen. Toteutusehdotuksia?
EDIT: Juu tosiaan pikselikomennot olivatkin paljon nopeampia.
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
Last edited by otto90x on Mon Dec 22, 2008 9:52 pm, edited 3 times in total.
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.
Runoblogi, vuodatusta ja sekoiluja.
Re: Efektit
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
Koodarina kohtalainen, henkilönä vittumainen
Re: Efektit
Laitoin koodin käyttämään pikselikomentoja ja viivan jatkuvaksi. Pitäisi olla huomattavasti nopeampi.
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
Peli piirtokomennoilla - voittaja, Virtuaalilemmikkipeli - voittaja,
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)
Re: Efektit
Tuossa on jonkinmoinen MotionBlur -funktio, hieman ruma ja hieman typerä, olisi ollut järkevämpi toteuttaa typeillä, niin voisi käsitellä vaikka kymmenen objektin vauhtiviivoja samalla funktiolla jne... Jos joskus toteutat hienomman motionblur efektin, niin tee ihmeessä vauhtiviivoista hieman eripituisia, näyttää hienommalta.
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