Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post by atomimalli »

Taisit unohtaa lukea wikilinkkini plasmaefektistä. Siinä ei ole kyse fysiikoista, vaan yksinkertaisella kaavalla saadusta aaltoilevasta efektistä. Lisäksi mainitsemasi pyöriminen on vain illuusio. Seuraappa yksittäisiä pisteitä. Ne völlyvät ympyräradan sijaan. Se on tyypillistä plasmaefekteille.

Plasmaefektin määrittää kaava, ei lopputulos. Siinä ei voi olla fysiikoita seinistä törmäilyyn. Plasmasimulaatio on eri juttu.

Wingmanin plasman kaava näyttää tältä:

Code: Select all

palikka(x,y)=(((Sin(x*17))*(Cos(y*13)))+((Sin(a+y*23))*(Cos(a+x*25))))*15
Siinä on sinin sisässä jotain sijaintiin liittyvää. Se riittää.

Tässä plasma yksinkertaisemmalla kaavalla:

Code: Select all

Const koko= 10
Repeat
    For x=0 To 400 Step koko
        For y=0 To 300 Step koko
            kirkkaus#=Sin(x)+Sin(y)
            Color 0,0,(kirkkaus+2)*63
            Box x,y,koko,koko
        Next y
    Next x
    drawscreen
Forever
sen ei tarvitse liikkua, vaikka se perinteisesti liikkuukin.
tässä vähän monipuolisempi ja liikkuva:

Code: Select all

Const koko= 5
Repeat
    t#=Timer()/20.0
    For x=0 To 400 Step koko
        For y=0 To 300 Step koko
            kirkkaus#=Sin(x*2-y^1.01-t)+Sin(-y+t/5)+Sin(Distance(0,0,x,y)^1.1+t/7+Sin(t)*70)+Sin(Distance(x,y,Sin(t/3)*200+200,Sin(t/5)*150+150)^1.3/3+t*2) 'jännä plasmakaava
            kirkkaus#=(Sin(kirkkaus*90+t)+1)*127 'jännä säätö kun pistetään välille 0 ja 255
            Color (kirkkaus/16.0)^2,kirkkaus,Sqrt(kirkkaus)*16 'jännä paletti
            Box x,y,koko,koko
        Next y
    Next x
    DrawScreen
    SetWindow ""+FPS()
Forever
plasmapalloväreillä kans:

Code: Select all

Const koko= 4
alku=Timer()
Repeat
    t#=(Timer())/20.0
    t2#=(Timer()+123456)/20.0
    t3#=(Timer())/20.0
    For x=0 To 399 Step koko
        For y=0 To 299 Step koko
            kirkkaus#=Sin(x*2-y^1.01-t)+Sin(-y+t/5)+Sin(Distance(0,0,x,y)^1.1+t/7+Sin(t)*70)+Sin(Distance(x,y,Sin(t/3)*200+200,Sin(t/5)*150+150)^1.3/3+t*2) 'jännä plasmakaava
            kirkkaus#=(Sin(kirkkaus*50)+1)*127 
            kirkkaus3#=Sin(x*2-y^1.01-t2)+Sin(-y+t3/5)+Sin(Distance(0,0,x,y)^1.1+t/7+Sin(t3)*70)+Sin(Distance(x,y,Sin(t/3)*200+200,Sin(t/5)*150+150)^1.3/3+t*2) 'jännä plasmakaava
            kirkkaus3#=(Sin(kirkkaus3*50)+1)*127 
            Color (Sqrt(kirkkaus3)*16+(kirkkaus/16.0)^2)/2,((kirkkaus3/16.0)^2+kirkkaus)/2,(kirkkaus3+Sqrt(kirkkaus)*16)/2
            Box x,y,koko,koko
        Next y
    Next x
    DrawScreen
    SetWindow ""+FPS()
Forever


Olikin kiva tehdä vaihteeksi kunnon plasmaefekti :)

Eli ideana on tuottaa pinnalle joku jatkuva funktio ja heittää ne sinille ja yhdistellä ja liikutella niitä.
User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 11:17 am
Location: Espoo

Re: Efektit

Post by MetalRain »

atomimalli wrote:Olikin kiva tehdä vaihteeksi kunnon plasmaefekti :)
Eli ideana on tuottaa pinnalle joku jatkuva funktio ja heittää ne sinille ja yhdistellä ja liikutella niitä.
Hienoja plasmoja ja eikä edes kovin kryptistä koodia, saa selvää ja voi ottaa opikseen mikäli ei aiemmin olekaan plasmoja koodaillut.

Päätinpä optimoida tuota viimeistä hiukan, vaihdoin boxin pikselikomentoihin joita piirrellään venytellylle ruudulle. Siirsin myös osan laskennasta apahtuvaksi ennen plasman piirtoa, jottei esimerkiksi jokaisen laatikon etäisyyttä tarvitse laskea ruudun keskipisteestä joka framella. Itselläni FPS nousi 8:sta 30:een, hienotkin plasmat voivat siis pyöriä CB:lläkin sulavasti.

Code: Select all

//säädä tästä laatikoiden ja ruudun kokoa
Const koko = 4
SW = 400
SH = 300 

SW2 = SW/2.0
SH2 = SH/2.0

SWK = SW/koko
SHK = SH/koko

SCREEN SW,SH
SCREEN SWK ,SHK ,0,cbsizable

Dim tdis(SWK,SHK) As Float
Dim xm(SWK,SHK) As Float

For y=0 To SHK 
    For x=0 To SWK 
        tdis(x,y) = Distance(0.0,0.0,x*koko,y*koko)^1.1
        xm(x,y) = (x*koko) Shl 1 - (y*koko)^1.01
    Next x
Next y

white = 255 Shl 24

Repeat

    ti# = Timer()
    
    t#=(ti#)/20.0
    t2#=(ti#+123456)/20.0
    t3#=(ti#)/20.0

    t_2#=t#*2.0
    
    t_5#=t#/5.0
    t3_5#=t3#/5.0
    
    t7#=t#/7.0 + Sin(t#)*70.0
    t73#=t3#/7.0 + Sin(t3#)*70.0
    
    s3t# = (1.0+Sin(t#/3.0))*SW2
    s3t3# = (1.0+Sin(t3#/3.0))*SW2
    
    s5t# = (1.0+Sin(t_5#))*SH2
    s5t3# = (1.0+Sin(t3_5#))*SH2

    
    Lock SCREEN()
        
        yk=0
    
        For y=0 To SH-1 Step koko

            y5t# = Sin(-y+t_5#)
            y5t3# = Sin(-y+t3_5#)
            
            xk=0
        
            For x=0 To SW-1 Step koko 

                kirkkaus#=Sin(xm(xk,yk)-t#)+y5t#+Sin(tdis(xk,yk)+t7#)+Sin(Distance(x,y,s3t#,s5t#)^1.3/3.0+t_2#) 'j?nn? plasmakaava
                kirkkaus#=(Sin(kirkkaus*50.0)+1.0)*127.0 
                
                kirkkaus3#=Sin(xm(xk,yk)-t2#)+y5t3#+Sin(tdis(xk,yk)+t73#)+Sin(Distance(x,y,s3t3#,s5t3#)^1.3/3.0+t_2#) 'j?nn? plasmakaava
                kirkkaus3#=(Sin(kirkkaus3 *50.0)+1.0)*127.0 
                
                r = (Sqrt(kirkkaus3)*16+(kirkkaus/16.0)^2) Shr 1 Shl 16
                g = ((kirkkaus3/16.0)^2+kirkkaus)Shr 1 Shl 8
                b = (kirkkaus3+Sqrt(kirkkaus)*16)Shr 1 

                PutPixel2 xk,yk,b + g + r + white
            
                xk=xk+1
            
            Next x
            
            yk=yk+1
            
        Next y
        
    Unlock SCREEN()
    
    DrawScreen 
    SetWindow ""+FPS()
Forever
Last edited by MetalRain on Sat Jun 11, 2011 10:58 am, edited 1 time in total.
tuhoojabotti
Advanced Member
Posts: 485
Joined: Tue Aug 28, 2007 3:53 pm
Location: Suomi, Finland
Contact:

Re: Efektit

Post by tuhoojabotti »

Itsellä nousi koolla 3 fps noin kahdella (16 -> 18), kun muutin for-luupit repeateiksi. :)
Imagedev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”
mkn
Member
Posts: 61
Joined: Wed Feb 17, 2010 3:12 pm

Re: Efektit

Post by mkn »

Aika jännä efekti:

EDIT: Oli jäänyt näköjään turha taulukkokin mukaan :( hyvä minä!


Code: Select all

SCREEN 640,480
Const  koko=6

muutu#=1
Repeat
muutu=muutu+1
If muutu#=20 Then muutu#=1
For x=1 To ScreenWidth () Step koko
For y=1 To ScreenHeight () Step koko

R = 127 + 127 * sin(1 * (x+y))^muutu
G = 127 + 127 * sin(3 * (x+y))^muutu
B = 127 + 127 * sin(5 * (x+y))^muutu
Color R,G,B
Box x,y,koko,koko 
Next y
Next x



DrawScreen 
Forever 
Last edited by mkn on Tue Jun 14, 2011 4:44 pm, edited 1 time in total.
"I'd love to change the world, but they won't give me the source code." - Anonymous
Latexi95
Guru
Posts: 1166
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Efektit

Post by Latexi95 »

mkn wrote:Aika jännä efekti:
Jäänyt näköjään taulukot 2 kertaa liian suureksi aikaisemmasta kokeilusta :(

Code: Select all

SCREEN 640,480
Const  koko=6
Dim p#(ScreenWidth()*2,ScreenHeight ()*2)

muutu#=1
Repeat
muutu=muutu+1
If muutu#=20 Then muutu#=1
For x=1 To ScreenWidth () Step koko
For y=1 To ScreenHeight () Step koko

R = 127 + 127 * sin(1 * (x+y))^muutu
G = 127 + 127 * sin(3 * (x+y))^muutu
B = 127 + 127 * sin(5 * (x+y))^muutu
Color R,G,B
Box x,y,koko,koko 
Next y
Next x



DrawScreen 
Forever 
Mitä varten siinä muuten edes on taulukko? :P
Mutta aika hienon näköinenhän tuo oli. Tuollainen kyllä aiheuttaa tehokkaasti epilepsia kohtauksia...
legend
Advanced Member
Posts: 371
Joined: Wed Nov 18, 2009 8:06 pm

Re: Efektit

Post by legend »

Keskiyöllä väännetty mielestäni erittäin hieno efekti =D Efektistä tulee kokoajan hienompi, malttakaa katsoa! (vaikka se voi pätkiä jos on huono fps)

Code: Select all

    SCREEN 400,300

    määrä = 3
    valoisuus# =0.0
    pituus# = 3
    nopeus = 1
    mxNopeus = 400
    n=1

    Dim x(määrä)
    Dim y(määrä)
    Dim n1(määrä)
    Dim n2(määrä)
    Dim w(määrä)

    Gosub Ruutu
    
    i=0

    Repeat
        
        For a =0 To määrä
            Viiva(x(a),y(a),w(a),i,n1(a),n2(a))
        Next a
             
        Gosub Värit           
        DrawScreen OFF
        
        If i >= 330 
            i=-20
            
            If nV = 0
                nopeus = nopeus + 1
            Else
                nopeus = nopeus - 1
            EndIf
                
            If nopeus >= mxNopeus
                nV = 1
                pituus - 0.5
            EndIf 
            If nopeus <= 20
                nV = 0
                pituus - 0.5
            EndIf
            
            If pituus <= 0
                pituus = 4
                mxNopeus + 100
            EndIf
                
            
            If valoisuus < 50 Then 
                For a=0 To määrä Step 2
                    x(a) = x(a)+10
                    x(a+1) = x(a+1)-10
                    w(a) = w(a) + 0.5
                    w(a+1) = w(a+1) + 0.5
                Next a
            Else
                Gosub Arvo
            EndIf
            
            valoisuus + pituus
            If valoisuus > 100
                valoisuus = 0
                Gosub Ruutu
                For a =0 To määrä
                    q=w(a)
                    w(a)=q+1
                Next a
            EndIf
                
         EndIf
         i = i + 1*nopeus
         
    Forever
    
    Värit:
    
        Color r, g, b
        If gV = 0
            g = g + 1*nopeus
            If g > 100+valoisuus Then gV = 1
        Else
            g = g -1*nopeus
            If g < 5+valoisuus Then gV = 0
        EndIf
        If bV = 0
            b = b +2*nopeus
            If b > 100+valoisuus Then bV = 1
        Else
            b = b -1*nopeus
            If b < 5+valoisuus Then bV = 0
        EndIf
        If rV = 0
            r = r +1*nopeus
            If r > 100+valoisuus Then rV = 1
        Else
            r = r -2*nopeus
            If r < 5+valoisuus Then rV = 0
        EndIf

    Return
    
    Arvo:
    
        For q=0 To määrä
            x(q) = Rand(0,400)
            n1(q) = Tai(-1,1)
            y(q) = Tai(-60,300)
            w(q) = Rand(1,8)
            If y(q) = -60
                n2(q) = 1
            Else
                n2(q) = -1
            EndIf
        Next q
        
    Return
    
    Ruutu:
        x(0)=200
        y(0)=-60
        n1(0)=-1
        n2(0)=1
        w(0)=2
        
        x(1)=200
        y(1)=-60
        n1(1)=1
        n2(1)=1
        w(1)=2
        
        x(2)=200
        y(2)=360
        n1(2)=-1
        n2(2)=-1
        w(2)=2
        
        x(3)=200
        y(3)=360
        n1(3)=1
        n2(3)=-1
        w(3)=2
    Return
     
    
    
    Function Viiva(x1,y1,w1,i,xN As Integer = 1,yN As Integer = 1)
        For a=1 To w1
            Line x1+(i*xN), y1+((i+a)*yN), x1+((i+50)*xN), y1+((i+a+50)*yN)
        Next a
    EndFunction 
    
    Function Tai(x1,y1)
        If Rand(0,1) = 1
            Return x1
        Else
            Return y1
        EndIf
     EndFunction
    
   
User avatar
Execute
Active Member
Posts: 110
Joined: Fri Feb 11, 2011 6:41 pm

Efektit

Post by Execute »

Joku tyhmä MatrixCode functio tuli väsättyä...

Code: Select all

 Function MatrixCode(numbers,x,y)
Color 160,160,10
numbers = numbers*10
For i = 0 To numbers
y1 = Rand(0,1000)
If y1 = 500 Or y1 > 500 Then 
Text x+10,y, "1"
Else 
Text x+10,y, "0"
EndIf 
x = x+10
Next i
EndFunction 
Sitte functio+Esimerkki:

Code: Select all

 SCREEN 300,100
SetWindow "The MatrixCode"
Repeat 
MatrixCode(code,-10,0)
matrixcode(code-14,-10,10)
matrixcode(code-40,-10,20)
matrixcode(code+10,-10,30)
MatrixCode(code-10,-10,40)
MatrixCode(code,-10,50)
MatrixCode(code+20,-10,60)
MatrixCode(Code+30,-10,70)
MatrixCode(code-70,-10,80)
Matrixcode(code+50,-10,90)
code = code+1
DrawScreen 
Forever 

Function MatrixCode(numbers,x,y)
Color 160,160,10
numbers = numbers*10
For i = 0 To numbers
y1 = Rand(0,1000)
If y1 = 500 Or y1 > 500 Then 
Text x+10,y, "1"
Else 
Text x+10,y, "0"
EndIf 
x = x+10
Next i
EndFunction 
Siinäpä tuo.
SpaceCraft on kokopitkä peli! Nyt ladattavissa! Tsekkaa!
User avatar
Knoy
Active Member
Posts: 187
Joined: Fri Feb 12, 2010 10:50 pm

Re: Efektit

Post by Knoy »

legend wrote:Keskiyöllä väännetty mielestäni erittäin hieno efekti =D Efektistä tulee kokoajan hienompi, malttakaa katsoa! (vaikka se voi pätkiä jos on huono fps)

Code: Select all

Koodia
Kaunis. Ei voi muuta sanoa.
User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 11:17 am
Location: Espoo

Re: Efektit

Post by MetalRain »

Tulipahan kirjoteltua ohjelmointiaiheista peliä varten tälläinen feikki bluescreen generaattori, vaan eipä ole ainakaan muistiosoitteiden kannalta kauhean uskottava.
Koodin ajaminen on turvallista. (:

Code: Select all

BlueScreen()

Function BlueScreen()

    SAFEEXIT OFF
    
    SCREEN 800,600,0,cbfullscreen
    
    ClsColor 0,0,164
    Color cbwhite
    
    Cls
    
    AddText "*** STOP: 0x"+Upper(""+Hex2(18))+" (0x"+Hex2(18)+", 0x"+Hex2(18)+", 0x"+Hex2(18)+")"
    AddText "Unhandled Kernel exception "+Hex2()+" from "+Hex2()+" ("+Hex2()+","+Hex2()+")"
    
    AddText ""
    
    AddText LSet("Dll Base Date Stamp - Name",40)+"Dll Base Date Stamp - Name"
    
    ChDir "C:\"
    
    If FileExists("Windows") Then ChDir "C:\Windows\"
    If FileExists("System32") Then ChDir "C:\Windows\System32\"
    
    Dim add(32) As String 
    
    count=0
    'Prepare search 
    StartSearch
    
        s$ = ""
    
        Repeat
        
            file$=FindFile()
            
            If file$="" Or count=>22 Then Exit
            
            e$ = Lower(Right(file$,4))
            
            If e$=".dll" Or e$=".sys" Or e$=".bat" Or e$=".exe" And Rand(30)=1 And Len(file$)<16 Then
            
                If addresses<8 Then 
                    For o=1 To Rand(1,3)
                        add(addresses) = ""+Hex2()+" "+Hex2()+" "+Hex2()+" "+Hex2()+" "+Hex2()+" "+Hex2()+" : "+Hex2()+" - " +file$
                        addresses+1
                    Next o
                EndIf 
            
                If s$="" Then 
                    s$ = ""+Hex2()+" "+Hex2()+" - "+file$  
                Else    
                    AddText LSet(s$,40)+Hex2()+" "+Hex2()+" - "+file$ 
                    s$=""
                    count=count+1
                EndIf 
                
            EndIf
        
        Forever
    EndSearch
    
    AddText ""
    
    AddText LSet("Address dword dump Dll Base",64)+" - Name"
    
    For i=0 To addresses-1
        AddText add(i)
    Next i
    
    AddText ""
    
    AddText "Kernel Debugger Using: COM2 (Port 0x"+Hex2(3,4)+", Baud Rate 19200)"
    AddText "Restart and set the recovery options in the system control panel"
    AddText "or the /CRASHDEBUG system start option. If this message reappears,"
    AddText "contact your system administrator or technical support group."
    
    DrawScreen 
    
    WaitKey  
    
    Wait 5000
    
    End 

End Function 

Function Hex2(minbit=16,maxbit=32)
    Return Lower(""+Hex(Rand(2^16,2^31)))
End Function
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Efektit

Post by esa94 »

Oikeat tiedostonimet ja muistiosoitteet on mahdollista kuitenkin selvittää; Voit vaikka pakki-insinöröidä sen Bluescreen-näytönsäästäjän joka poimii kaikki tiedot filuista ja järjestelmäkutsuista IIRC
legend
Advanced Member
Posts: 371
Joined: Wed Nov 18, 2009 8:06 pm

Re: Efektit

Post by legend »

Tässä on tälläinen "pelimoottori", jossa näyt kaukaa vain talon katon ja sitä lähempänä ollaan niin katto muuttuu läpinäkyvämmäksi.
Katon läpinäkyvyyteen käytin oma tekemieni funktioita ExploreImage ja OpacityImage...

Code: Select all

        
    SCREEN 500, 400
   
    Dim Colour(10,10,2,1)//kuvien tiedot
    
    Smooth2D ON

    katto = LoadImage("media/map.bmp")
    ResizeImage katto, 202,152 
    
    runko = MakeImage(200,150)
    MaskImage runko, 255,0,255
    DrawToImage runko //piirretään talo
        Color 255,0,255
        Box 0,0,200,150
        Color 0,0,0
        Box 0,0,75,5
        Box 120,0,80,5
        Box 0,145,80,5
        Box 120,145,80,5
        Box 0,0,5,150
        Box 196,0,5,150
    DrawToScreen
    
    ruoho = MakeObjectFloor ()
    nurmikko = LoadImage ("Media\grass.bmp")
    lehmä = LoadImage("media\cow.bmp")
    
    Color 123,90,0
    Box 50,50,200,150 //piirretään lattia
    Color 0,0,0
    For i =1 To 250 Step 10 //lattia viivat
        Line i,50,i, 200
    Next i
    DrawImage runko, 50,50
    DrawImage lehmä, 70,70
    DrawImage lehmä, 170,120
    
    ExploreImage(katto,49,49) //analysoidaan rakennusta
    
    Cls
    Color 255,255,255
    CenterText 250,200, "20%",2 // merkitään lataus
    DrawScreen
    Cls
    
    Dim Talo(10)
    a# = 0.0
    For i=0 To 10
        talo(i) = OpacityImage(katto,a) //eri näkyvyysarvot
        CenterText 250,200, (20 + i*7) + "%",2 // merkitään lataus
        DrawScreen
        a = a+0.1
    Next i   
    MaskImage talo(0), 255, 0, 255
    
    PaintObject ruoho, nurmikko
    
    mUkko = LoadImage("media/soldier.bmp")
    Dim ukko(3)
    For i= 0 To 360 Step 90
        ukko(i/90) = CloneImage(mUkko)
        RotateImage  ukko(i/90), i
    Next i
    
    posX = 450
    posY = 350
    
    u = 2
    
    Repeat
        
        DrawGame
        
        If KeyDown(205) //könkkö liikutettavuus =D
            posX = posX + 1
            u = 0
        ElseIf KeyDown(203)
            posX = posX - 1
            u = 2
        ElseIf KeyDown(200)
            posY = posY - 1
            u = 3
        ElseIf KeyDown(208)
            posY = posY + 1
            u =1
        EndIf 
        
        If posX > 45 And posX < 260 And posY > 45 And posY < 205 //talon sisällä
            i = 0
        Else
            i = Min(Distance(posX, posY, 150, 125)/39,10) //näkyvyysarvo
        EndIf
            
        
        DrawImage  talo(i), 49,49
        DrawImage ukko(u), posX, posY
        DrawScreen
    
    Forever
    
    
    
    
    
    //esivalmistellaan kuvaa...
    Function ExploreImage(pic,picX,picY)
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        ReDim Colour(picW,picH,2,1)//laitettaan taulukko uuten kokoon
        If picX > 0 And PicxX+picW < ScreenWidth() And picY > 0 And PicY+picH < ScreenHeight() //ettei mene ruuudun ulkopuolelle
            Lock()
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel2(picX + x, picY + y) //otettaan tausta talteen
                    Colour(x,y,0,0) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,0) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,0) = ((pixel Shl (3*8)) Shr 24)
                Next y
            Next x
            Unlock()
            DrawToImage pic
            Lock()
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel2(x,y) //otetaan itse kuva talteen
                    Colour(x,y,0,1) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,1) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,1) = ((pixel Shl (3*8)) Shr 24) 
                Next y
            Next x
            Unlock()
            DrawToScreen
        EndIf
    EndFunction
    
    
    //luodaan kuva
    Function OpacityImage(pic,op#)
        op = 1-op
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        newPic = MakeImage(picW,picH)
        DrawToImage newPic
        Lock()
        For x = 1 To picW
            For y=1 To picH
                R = Colour(x,y,0,1)
                G = Colour(x,y,1,1)
                B = Colour(x,y,2,1)
                ColorR = R+(Colour(x,y,0,0) -R)*op //yhdistetään värit
                ColorG = G+(Colour(x,y,1,0) -G)*op
                ColorB = B+(Colour(x,y,2,0) -B)*op
                PutPixel2 x,y, (ColorB + ColorR Shl 16 + ColorG Shl 8) //pistettään se kasaan
            Next y
        Next x
        Unlock()
        DrawToScreen
        Return newPic
    EndFunction
Jä tässä pelkkä funktio. Explore tutkii kuvan taustan ja kuvan, jonka jälkeen voi käyttää Opacityä, joka palauttaa kuvan.

Code: Select all

   
    Dim Colour(10,10,2,1)//kuvien tiedot

    //esivalmistellaan kuvaa...
    Function ExploreImage(pic,picX,picY)
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        ReDim Colour(picW,picH,2,1)//laitettaan taulukko uuten kokoon
        If picX > 0 And PicxX+picW < ScreenWidth() And picY > 0 And PicY+picH < ScreenHeight() //ettei mene ruuudun ulkopuolelle
            Lock()
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel2(picX + x, picY + y) //otettaan tausta talteen
                    Colour(x,y,0,0) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,0) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,0) = ((pixel Shl (3*8)) Shr 24)
                Next y
            Next x
            Unlock()
            DrawToImage pic
            Lock()
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel2(x,y) //otetaan itse kuva talteen
                    Colour(x,y,0,1) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,1) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,1) = ((pixel Shl (3*8)) Shr 24) 
                Next y
            Next x
            Unlock()
            DrawToScreen
        EndIf
    EndFunction
    
    
    //luodaan kuva
    Function OpacityImage(pic,op#)
        op = 1-op
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        newPic = MakeImage(picW,picH)
        DrawToImage newPic
        Lock()
        For x = 1 To picW
            For y=1 To picH
                R = Colour(x,y,0,1)
                G = Colour(x,y,1,1)
                B = Colour(x,y,2,1)
                ColorR = R+(Colour(x,y,0,0) -R)*op //yhdistetään värit
                ColorG = G+(Colour(x,y,1,0) -G)*op
                ColorB = B+(Colour(x,y,2,0) -B)*op
                PutPixel2 x,y, (ColorB + ColorR Shl 16 + ColorG Shl 8) //pistettään se kasaan
            Next y
        Next x
        Unlock()
        DrawToScreen
        Return newPic
    EndFunction
EDIT:

Esa94 - Eipä taida olla =DD mutta sillä on helppo talettaa kuvat muistiin =D

Last edited by legend on Thu Jun 16, 2011 7:24 pm, edited 3 times in total.
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Efektit

Post by esa94 »

Onko OpacityImage nyt sitten tehokkaampi kuin GhostImage
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb »

Olipas eeppinen pelimoottori. =) Teki semmoose ikkunan missä luki: "Memory access violation!" :D
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
legend
Advanced Member
Posts: 371
Joined: Wed Nov 18, 2009 8:06 pm

Re: Efektit

Post by legend »

MaGetzUb wrote:Olipas eeppinen pelimoottori. =) Teki semmoose ikkunan missä luki: "Memory access violation!" :D
Ei mulla tule, johtuu varmaan putpixel2 epävarmuudesta... tässä hitaampi normi putpixel versio

Code: Select all

       
    SCREEN 500, 400
   
    Dim Colour(10,10,2,1)//kuvien tiedot
    
    Smooth2D ON

    katto = LoadImage("media/map.bmp")
    ResizeImage katto, 202,152 
    
    runko = MakeImage(200,150)
    MaskImage runko, 255,0,255
    DrawToImage runko //piirretään talo
        Color 255,0,255
        Box 0,0,200,150
        Color 0,0,0
        Box 0,0,75,5
        Box 120,0,80,5
        Box 0,145,80,5
        Box 120,145,80,5
        Box 0,0,5,150
        Box 196,0,5,150
    DrawToScreen
    
    ruoho = MakeObjectFloor ()
    nurmikko = LoadImage ("Media\grass.bmp")
    lehmä = LoadImage("media\cow.bmp")
    
    Color 123,90,0
    Box 50,50,200,150 //piirretään lattia
    Color 0,0,0
    For i =1 To 250 Step 10 //lattia viivat
        Line i,50,i, 200
    Next i
    DrawImage runko, 50,50
    DrawImage lehmä, 70,70
    DrawImage lehmä, 170,120
    
    ExploreImage(katto,49,49) //analysoidaan rakennusta
    
    Cls
    Color 255,255,255
    CenterText 250,200, "20%",2 // merkitään lataus
    DrawScreen
    Cls
    
    Dim Talo(10)
    a# = 0.0
    For i=0 To 10
        talo(i) = OpacityImage(katto,a) //eri näkyvyysarvot
        CenterText 250,200, (20 + i*7) + "%",2 // merkitään lataus
        DrawScreen
        a = a+0.1
    Next i   
    MaskImage talo(0), 255, 0, 255
    
    PaintObject ruoho, nurmikko
    
    mUkko = LoadImage("media/soldier.bmp")
    Dim ukko(3)
    For i= 0 To 360 Step 90
        ukko(i/90) = CloneImage(mUkko)
        RotateImage  ukko(i/90), i
    Next i
    
    posX = 450
    posY = 350
    
    u = 2
    
    Repeat
        
        DrawGame
        
        If KeyDown(205) //könkkö liikutettavuus =D
            posX = posX + 1
            u = 0
        ElseIf KeyDown(203)
            posX = posX - 1
            u = 2
        ElseIf KeyDown(200)
            posY = posY - 1
            u = 3
        ElseIf KeyDown(208)
            posY = posY + 1
            u =1
        EndIf 
        
        If posX > 45 And posX < 260 And posY > 45 And posY < 205 //talon sisällä
            i = 0
        Else
            i = Min(Distance(posX, posY, 150, 125)/39,10) //näkyvyysarvo
        EndIf
            
        
        DrawImage  talo(i), 49,49
        DrawImage ukko(u), posX, posY
        DrawScreen
    
    Forever
    
    
    
    
    
    //esivalmistellaan kuvaa...
    Function ExploreImage(pic,picX,picY)
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        ReDim Colour(picW,picH,2,1)//laitettaan taulukko uuten kokoon
        If picX > 0 And PicxX+picW < ScreenWidth() And picY > 0 And PicY+picH < ScreenHeight() //ettei mene ruuudun ulkopuolelle
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel(picX + x, picY + y) //otettaan tausta talteen
                    Colour(x,y,0,0) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,0) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,0) = ((pixel Shl (3*8)) Shr 24)
                Next y
            Next x
            DrawToImage pic
            For x = 1 To picW
                For y = 1 To picH
                    pixel = GetPixel(x,y) //otetaan itse kuva talteen
                    Colour(x,y,0,1) = ((pixel Shl (1*8)) Shr 24)
                    Colour(x,y,1,1) = ((pixel Shl (2*8)) Shr 24)
                    Colour(x,y,2,1) = ((pixel Shl (3*8)) Shr 24) 
                Next y
            Next x
            DrawToScreen
        EndIf
    EndFunction
    
    
    //luodaan kuva
    Function OpacityImage(pic,op#)
        op = 1-op
        picW = ImageWidth(pic)
        picH = ImageHeight(pic)
        newPic = MakeImage(picW,picH)
        DrawToImage newPic
        For x = 1 To picW
            For y=1 To picH
                R = Colour(x,y,0,1)
                G = Colour(x,y,1,1)
                B = Colour(x,y,2,1)
                ColorR = R+(Colour(x,y,0,0) -R)*op //yhdistetään värit
                ColorG = G+(Colour(x,y,1,0) -G)*op
                ColorB = B+(Colour(x,y,2,0) -B)*op
                PutPixel x,y, (ColorB + ColorR Shl 16 + ColorG Shl 8) //pistettään se kasaan
            Next y
        Next x
        DrawToScreen
        Return newPic
    EndFunction
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb »

Minulla toimii PutPixel2 näin jos kuvaa luetaan:

Code: Select all

For X = 0 To ImageWidth(kuva)-1
   For Y = 0 To ImageHeight(kuva)-1

   Next Y
Next X
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: Efektit

Post by JATothrim »

(0,0) on siis ensimäinen (ylävasen) pikseli. ImageWidth() taas kertoo pikselien lukumäärän rivillä, mikä ei kelpaa suoraan CB:n for-loopin lopetusarvoksi.
putpixel2/getpixel2:iä ei käytetä oikein, jos koordinaatit menee yli. Simple. On määrä selata läpi vain [0, width tai height[ indexit. Indeksi menee hyvin useasti ohi yhdellä, sillä CB:n for-looppi pelaa jota kuinkin näin:

Code: Select all

i = aloitus
while i <= lopetusarvo
<code>
i + 1
endwhile
eli i TULEE SAAVUTTAMAAN lopetusarvon.

ja C/C++ kielissä yleensä for-loopataan näin, jolloin i EI KOSKAAN savuta lopetus arvoa:

Code: Select all

for(int i = aloitus; i < lopetus; i++)    { <code>; }
EDIT:

Ts. MaGetzUp:lla on täysin oikeatapa.

-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
User avatar
Kille
Active Member
Posts: 249
Joined: Wed Aug 26, 2009 3:50 pm
Location: Juankoski

Re: Efektit

Post by Kille »

Teinpä tällaisen ratasfunktion, jolla siis piirretään hammasrattaita. Tässä olisi funktio+esimerkki. Saa käyttää!

Code: Select all

//RATASEFEKTI by Ville "Kille" Valtiala
//saa käyttää vapaasti 

//Funktio + esimerkki

FrameLimit 40

SCREEN 400,300,0,1
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat



Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

gear(0,0,8,40,60,3,kulma)
gear(100,0,8,40,60,3,-1*kulma)
gear(0,100,8,40,60,3,-1*kulma)




Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

tormays=0

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i+pres)*maxrad+x,Cos(ang-hammasväli*i+pres)*maxrad+y
Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y

Next i

For i=2 To hammas Step 2

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y
Line Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y

Next i



End Function 

joo ja on huonosti sisennetty
Last edited by Kille on Fri Jul 01, 2011 11:49 am, edited 2 times in total.
ZEPPELIN
Jatkoa tulossa... tällä kertaa lataus ei kestä viikkoa
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb »

Kille wrote:Teinpä tällaisen ratasfunktion, jolla siis piirretään hammasrattaita. Tässä olisi funktio+esimerkki. Saa käyttää!

Code: Select all

//RATASEFEKTI by Ville "Kille" Valtiala
//saa käyttää vapaasti 

//Funktio + esimerkki

FrameLimit 40

SCREEN 400,300,0,1
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat

maassa=0
Tormays=0

Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

tormays=tormays+gear(0,0,8,40,60,3,kulma)
tormays=tormays+gear(100,0,8,40,60,3,-1*kulma)
tormays=tormays+gear(0,100,8,40,60,3,-1*kulma)




Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

tormays=0

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i+pres)*maxrad+x,Cos(ang-hammasväli*i+pres)*maxrad+y
Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y

Next i

For i=2 To hammas Step 2

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y
Line Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y

Next i



End Function 

joo ja on huonosti sisennetty
Ihan kiva, mitään ällistyttäväähän tuo ei ole, mutta rattaat pyörivät nätin dynaamisesti toistensa vierellä. :)
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
User avatar
Execute
Active Member
Posts: 110
Joined: Fri Feb 11, 2011 6:41 pm

Efektit

Post by Execute »

Värkkäsin tällaisen efektin (puolivahingossa) leikkiessäni rotatedtext-fukkarillani.

Tässäpä tämä:

Code: Select all

SCREEN 1000,1000 
 font = LoadFont("Impact",50)
    SetFont font
    x2 = 0
    y2 = 1000

    Repeat
    Color cbred
    RotatedText(y2,x2,aste,"Effect")
    rotatedtext(x,y,aste,"Super")
    X = X+1
    Y = Y+1
    y2 = y2-1
    x2 = x-1
    aste = aste+5
    DrawScreen OFF 
    Forever

        Function RotatedText(x,y,aste,tex$)
        pituus = TextWidth(tex$)
        korkeus = TextHeight(tex$)
        teksti = MakeImage(pituus,korkeus)
        DrawToImage teksti
        Text 0,0, "" +tex$
        DrawToScreen
        Smooth2D ON
        RotateImage teksti,aste
        DrawImage teksti,x,y
        Smooth2D OFF
        DeleteImage teksti
        EndFunction 
Kommentointi ja sisennykset puuttuvat.

Toka versio:

Code: Select all

    SCREEN 1000,1000
    font = LoadFont("Impact",50)
        SetFont font
        x2 = 0
        y2 = 1000

        Repeat
        Color cbred
        RotatedText(y2,x2,aste,"Effect")
        rotatedtext(x,y,aste,"Super")
        X = X+1
        Y = Y+1
        y2 = y2-1
        x2 = x-1
        aste = aste+1
        DrawScreen OFF
        Forever

            Function RotatedText(x,y,aste,tex$)
            pituus = TextWidth(tex$)
            korkeus = TextHeight(tex$)
            teksti = MakeImage(pituus,korkeus)
            DrawToImage teksti
            Text 0,0, "" +tex$
            DrawToScreen
            Smooth2D ON
            RotateImage teksti,aste
            DrawImage teksti,x,y
            Smooth2D OFF
            DeleteImage teksti
            EndFunction 
SpaceCraft on kokopitkä peli! Nyt ladattavissa! Tsekkaa!
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post by Wingman »

Kille wrote:Teinpä tällaisen ratasfunktion, jolla siis piirretään hammasrattaita. Tässä olisi funktio+esimerkki. Saa käyttää!

Code: Select all

//RATASEFEKTI by Ville "Kille" Valtiala
//saa käyttää vapaasti 

//Funktio + esimerkki

FrameLimit 40

SCREEN 400,300,0,1
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat

maassa=0
Tormays=0

Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

tormays=tormays+gear(0,0,8,40,60,3,kulma)
tormays=tormays+gear(100,0,8,40,60,3,-1*kulma)
tormays=tormays+gear(0,100,8,40,60,3,-1*kulma)




Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

tormays=0

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i+pres)*maxrad+x,Cos(ang-hammasväli*i+pres)*maxrad+y
Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y

Next i

For i=2 To hammas Step 2

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y
Line Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y

Next i



End Function 

joo ja on huonosti sisennetty
vielä kun saisit rattaiden sisäosat kokonaan mustiksi niin olisi hyvä, nyt rattaat näkyvät toistensa takaa
- - - -
Post Reply