Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Efektit

Post by axu »

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.
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

nevssons wrote:
DatsuniG wrote:Ascii räjähdyksiä : P

Code: Select all

koodia 
    
Pätkii ärsyttävästi
Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /
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.
m1c
Member
Posts: 65
Joined: Tue Aug 28, 2007 5:10 pm
Location: \o

Re: Efektit

Post by m1c »

DatsuniG wrote:
nevssons wrote:
DatsuniG wrote:Ascii räjähdyksiä : P

Code: Select all

koodia 
    
Pätkii ärsyttävästi
Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /
Ööh, entä jos vaikka jätät exitin pois? Turhaa kai lopettaa päivittäminen kesken jos YKSI partikkeli tuhotaan?
User avatar
-Z-
Devoted Member
Posts: 682
Joined: Tue Aug 28, 2007 3:33 pm
Location: In ur danmaku, grazin ur bullets

Re: Efektit

Post by -Z- »

m1c wrote:
DatsuniG wrote:
nevssons wrote: Pätkii ärsyttävästi
Se johtuu tuosta Tyyppien poistamisesta, enkä voi vaikuttaa siihen mitenkään. : /
Ööh, entä jos vaikka jätät exitin pois? Turhaa kai lopettaa päivittäminen kesken jos YKSI partikkeli tuhotaan?
Se aiheuttaa aika herkästi MAVin ainakin omien kokemusten pohjalta.
"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
m1c
Member
Posts: 65
Joined: Tue Aug 28, 2007 5:10 pm
Location: \o

Re: Efektit

Post by m1c »

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.
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

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.
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: Efektit

Post by Jani »

heh... Seka testien (Cos, Sin, jne) testien pohjalta tuli tällänen:

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
EDIT: sanokaa jos FPS on korkea.
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

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.

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.
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Efektit

Post by phons »

Jes, tuo DatsuniG:n efekti oli niin hieno että sen vois laittaa vaik näytönsäästäjäksi. :D
Image
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: Efektit

Post by Jani »

DatsuniG wrote:Sori, mutta koodissasi ei ole mitään järkeä : /
Ei niin. Sanoinhan sen pelkän sekoituksen aikana.

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
Saa kommentoida ihan vapaasti koska tämä on ensimmäinen "harkittu" Cos+Sin

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
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

Teinpäs kivan kuvan peilaamis-funktion.

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 
            
Ja parannettu versio putpixel2 ja getpixel2 käyttäen :P

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 :P
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.
Harakka
Advanced Member
Posts: 430
Joined: Mon Aug 27, 2007 9:08 pm
Location: Salo
Contact:

Re: Efektit

Post by Harakka »

Pikaisen testin perusteella tavallinen ResizeImage on vähän nopeampi. ;)

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 
Tässä vielä muutamat hypnoottiset efektit arkistosta. Aaltoja luvassa.

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
Ja vielä muutama vanha aaltoiluefekti samassa paketissa. Näpyttele välilyöntiä.

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)
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: Efektit

Post by Jani »

Tein tämmösen alkeellisen PyroMax: illa toimivan "kuilun".
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
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

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.
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: Efektit

Post by Jani »

Voisitko tehdä samaan tyyliin tekstille, DatsuniG?

Tai joku muu
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
KilledWhale
Tech Developer
Tech Developer
Posts: 545
Joined: Sun Aug 26, 2007 2:43 pm
Location: Liminka

Re: Efektit

Post by KilledWhale »

Jani wrote:Voisitko tehdä samaan tyyliin tekstille, DatsuniG?

Tai joku muu
Haluatko niin että kirjaimet pomppivat yksittäin vai pikselitarkasti?

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
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: Efektit

Post by otto90x »

Yritin tehdä jonkinlaisia vauhtiviivoja, mutta en kyllä ole vielä tyytyväinen. Toteutusehdotuksia?

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
EDIT: Juu tosiaan pikselikomennot olivatkin paljon nopeampia.
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.
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Efektit

Post by nevssons »

otto90x wrote:Yritin tehdä jonkinlaisia vauhtiviivoja, mutta en kyllä ole vielä tyytyväinen. Toteutusehdotuksia?

Code: Select all

koodia 
Vauhtiviivoja? Mihin tarkoitukseen? Mutta on tuo hauskan näköinen.
Koodarina kohtalainen, henkilönä vittumainen
Image
Harakka
Advanced Member
Posts: 430
Joined: Mon Aug 27, 2007 9:08 pm
Location: Salo
Contact:

Re: Efektit

Post by Harakka »

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)
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

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
Post Reply