Page 27 of 34

Re: Efektit

Posted: Thu Jun 09, 2011 1:20 pm
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ä.

Re: Efektit

Posted: Thu Jun 09, 2011 4:40 pm
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

Re: Efektit

Posted: Sat Jun 11, 2011 2:49 am
by tuhoojabotti
Itsellä nousi koolla 3 fps noin kahdella (16 -> 18), kun muutin for-luupit repeateiksi. :)

Re: Efektit

Posted: Mon Jun 13, 2011 8:58 pm
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 

Re: Efektit

Posted: Tue Jun 14, 2011 12:20 am
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...

Re: Efektit

Posted: Tue Jun 14, 2011 10:13 am
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
    
   

Efektit

Posted: Wed Jun 15, 2011 2:18 pm
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.

Re: Efektit

Posted: Wed Jun 15, 2011 3:12 pm
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.

Re: Efektit

Posted: Thu Jun 16, 2011 4:57 pm
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

Re: Efektit

Posted: Thu Jun 16, 2011 6:10 pm
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

Re: Efektit

Posted: Thu Jun 16, 2011 6:19 pm
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


Re: Efektit

Posted: Thu Jun 16, 2011 6:24 pm
by esa94
Onko OpacityImage nyt sitten tehokkaampi kuin GhostImage

Re: Efektit

Posted: Fri Jun 17, 2011 12:24 am
by MaGetzUb
Olipas eeppinen pelimoottori. =) Teki semmoose ikkunan missä luki: "Memory access violation!" :D

Re: Efektit

Posted: Fri Jun 17, 2011 12:05 pm
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

Re: Efektit

Posted: Fri Jun 17, 2011 2:00 pm
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

Re: Efektit

Posted: Sat Jun 18, 2011 5:00 pm
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.


Re: Efektit

Posted: Wed Jun 29, 2011 4:53 pm
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

Re: Efektit

Posted: Wed Jun 29, 2011 8:50 pm
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ä. :)

Efektit

Posted: Wed Jun 29, 2011 10:04 pm
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 

Re: Efektit

Posted: Thu Jun 30, 2011 7:53 pm
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