Efektit

Post by **Ilmuri** » Sun Jun 06, 2010 11:04 pm

CCE wrote: Ilmurin hurjien optimointien pohjalta tein efektistä C64 -henkisen version widepixeleineen kaikkineen.

SCREEN 150,150

sw = ScreenWidth()-11
sh = ScreenHeight()-11

Repeat
   
   Lock
	  For y = 10 To sh
		 For x = 10 To sw Step 2
			c = Rand(0,2)*127
			c = c + c Shl 8 + c Shl 16
			PutPixel2 x, y, c
			PutPixel2 x+1, y, c
		 Next x
	  Next y
   Unlock
   
   DrawScreen
Forever

Knoy · Post by **Knoy** » Sun Jun 06, 2010 11:35 pm

Pikselöinti effekti.

Code: Select all

Imag = LoadImage("media\map.bmp")
Img=MakeImage(ImageWidth(Imag),ImageHeight(Imag))


For Times= 2 To 15

    DrawToImage Img
        DrawImage Imag,0,0
    DrawToScreen
    
    Skip#=Abs(Times)

    For X = 0 To ScreenWidth()
        SetWindow Str(FPS())
        If (X Mod Skip) = 0 Then
            DrawImage Img,0,0
                For Y = 0 To ScreenHeight()
                    If (Y Mod Skip) = 0 Then
                        Pixel=GetPixel( X,Y)
                        DrawToImage Img
                            For i = 0 To Skip-1
                                For ii = 0 To Skip-1
                                    PutPixel X+i,Y+ii,Pixel
                                Next ii
                            Next i
                        DrawToScreen
                    EndIf 
                Next Y
            DrawScreen OFF
        EndIf 
    Next X
        
Next Times
        
DrawImage Img,0,0
DrawScreen
        
WaitKey

Post by **CCE** » Sun Jun 06, 2010 11:49 pm

Knoy wrote:Pikselöinti effekti.

Saa tuon tehtyä vähän nopeamminkin

Code: Select all

Imag = LoadImage("media\map.bmp")
m = 2
DrawImage Imag, 0, 0
DrawScreen OFF
ResizeImage imag, ImageWidth(imag)/m, ImageHeight(imag)/m
ResizeImage imag, ImageWidth(imag)*m, ImageHeight(imag)*m
DrawImage imag, 0, 0
DrawScreen
WaitKey

Knoy · Post by **Knoy** » Mon Jun 07, 2010 10:09 am

CCE wrote:
Knoy wrote:Pikselöinti effekti.
Saa tuon tehtyä vähän nopeamminkin
Code: Select all
---

Kusetusta tuollainen... Kuka antoi luvan käyttää resizeimagea

Enpä tullut ajatelleekseni tuota.

Wingman · Post by **Wingman** » Mon Jun 07, 2010 11:55 am

Knoy wrote:Editoin hieman vanhaa effektiäni ja siitä syntyi jotain omituisehkoa.

Code: Select all

Const ScreenW = 400
Const ScreenH = 300

Angle As Float = 0

ii As Float = 0
iii As Float = 0

SCREEN ScreenW,ScreenH

Repeat
    Angle=WrapAngle(Angle+0.1)
    Angle2=WrapAngle(Angle2+1)
    Angle3#=WrapAngle(Angle3+0.15)
    Angle4#=WrapAngle(Angle4+0.25)
    For i = 1 To 15 As Float
        For ii = 1 To 15 As Float
            Color ii*17,((i+ii)/2)*17,i*17
            Line ScreenW/2+Cos(WrapAngle(Angle2+(1+i+ii)*Angle))*(15+i+ii)+Cos(Angle3+(i+ii+2)*Angle)*45,ScreenH/2-Sin(WrapAngle(Angle2+(1+i+ii)*Angle))*(15+i+ii)-Sin(Angle4+(i+ii+2)*Angle)*45,ScreenW/2+Cos(WrapAngle(Angle2+(i+ii+2)*Angle))*(16+i+ii)+Cos(Angle3+(i+ii+2)*Angle)*45,ScreenH/2-Sin(WrapAngle(Angle2+(i+ii+2)*Angle))*(16+i+ii)-Sin(Angle4+(i+ii+2)*Angle)*45
        Next ii
    Next i
    DrawScreen
Forever

siis wtf?? tää on kyllä hieno, katoin about 3 kertaa sen koko kierroksen läpi, ennen ku tajusin että se looppas

Post by **CCE** » Sat Aug 07, 2010 11:57 am

Inspiroidun Wingmanin wallpaperista ja tein kivan isometrisen "plasman".

Code: Select all

Const WIDTH = 640
Const HEIGHT = 480
SCREEN WIDTH, HEIGHT,32,1
ClsColor 255, 255, 255
ruutu = MakeImage( WIDTH, HEIGHT ) 
MaskImage ruutu, 255, 0, 255
imgLoota = MakeImage( 28, 22 )
DrawToImage imgLoota
	Gosub the_magic_box	// siististi kirjoitettu koodi ei tarvitse kommentteja
DrawToScreen
MaskImage  imgLoota, 128, 128, 128

Const COLOR_AMOUNT = 6
Dim imgLaatikko( COLOR_AMOUNT ) 
For i=0 To COLOR_AMOUNT
	pala# = 255 / (COLOR_AMOUNT-1)
	r =  min(255, pala * i + 48 )
	g =  min(255, pala * i + 16 )
	b = min(255, pala * i + 16 )
	imgLaatikko(i) = colorbox( imgloota, r, g, b )
Next i

start=Timer()

TranslateCamera width / 2, - height / 2

Repeat
aika = Timer()-start
	Color 64,64,64
	Box 0,0, WIDTH, HEIGHT
	DrawToImage ruutu
		
	DrawToScreen
	DrawImage ruutu, 0, 0


	blocksize = 14
	blockheight = 8
	planeWidth = 20
	planeHeight = 20
	amplitude = 20
	
	For x = 0 To planeWidth
	For z = 0 To planeHeight
'	korkeus = 5 + Sin( aika / 4.0 + x*300 ) * 4.0
		'For y = 0 To korkeus
		factor# = (((1 - (Sin( aika / 12.0 ))) / 2.0)*0.8)+0.1
		pz# = 5 + Sin( aika / 5.0 + x*15 + z^2 ) * amplitude
		pz2# = 5 + Sin( aika / 5.0 + (x-z)*20 ) * amplitude*0.9
		
		korkeus# = pz*factor + pz2*(1-factor)
		
		px = WIDTH/2 - ( z - x )*(blocksize-1)
		py = HEIGHT*0.3 + ((x + z) / 2.0)*blocksize - korkeus
		
			'xx = 400 -blocksize*z  '(WIDTH * 0.8) -x * 2 * blocksize
			'yy = 100 +blocksize*z '(HEIGHT  * 0.6) + x * blocksize - y*blockheight
			
				colorphase = min(COLOR_AMOUNT, Max(0, Int(korkeus / COLOR_AMOUNT)))

			DrawImage imgLaatikko( colorphase ), px, py
			'DrawScreen OFF
			'WaitKey
	'	DrawImage colorbox( imgLoota ,Rand(255),Rand(255),Rand(255)) ,xx, yy
		'Next y
	Next z
	Next x
	
	
	'DrawImage imgLoota, MouseX(), MouseY()
	
	speed# = 1.0
	'CopyBox 300, 300, 200, 200, MouseX(), MouseY(), SCREEN(), SCREEN()
	
	'If keyhit(cbkeyspace) then CopyBox 0, 0, WIDTH, HEIGHT, Int( -blocksize*2*speed#), Int(-blockheight*speed#), SCREEN(), Image( ruutu )
'CopyBox 400, 300, 400, 300, MouseX(), MouseY(), SCREEN(), Image( ruutu )
'DrawImage ruutu, 0, 0
Color cbWhite
Text 0,0,""+FPS()
	DrawScreen
Forever

Function colorbox(img, r,g,b)
	varikas = MakeImage( 28, 22 )
	MaskImage varikas, 255, 0, 255
	DrawToImage varikas
		Color r,g,b
		Box 0, 0, 28, 22, 1
		DrawImage img, 0,0
	DrawToScreen
	
	
	Return varikas
	
EndFunction

the_magic_box:
	Color 128, 128, 128
		Box 0,0,28,22

	Color 0,0,0	 // viivojen väri
		Line 14, 0, 1, 6
		Line 15, 1, 26, 6
		Line 27, 7, 27, 14	// oikea reuna
		Line 0, 7, 0, 14 // vasen reuna
		
		Line 1, 15, 14, 21
		Line 15, 20, 26, 15	// oikea ala
	Color 255, 255, 255	// hilight
		Line 1, 8, 14, 14
		Line 15, 13, 26, 8
	Color 255, 0, 255 // maski
		Line 0,0,0, 6
		Line 0, 21, 0, 15
		Dot 27,6
	Line 15, 0, 26, 5
		For y=5 To 0 Step -1
		If y < 2 then Line 11, 21*y, 12, 21*y
		If y < 2 then Line 15, 21*y, 17, 21*y
		
			Line 1 + (5-y)*2, y ,1 + (5-y)*2, 0
			Line 2 + (5-y)*2, y ,2 + (5-y)*2, 0
			
			Line 7 + (5+y)*2, y ,7 + (5+y)*2, 0
			Line 6 + (5+y)*2, y ,6 + (5+y)*2, 0

			Line (27-y*2), 15 + y , (27-y*2),  21
			Line (28-y*2), 15 + y , (28-y*2),  21
			
			Line  1+(y)*2, 16 + y, 1+(y)*2, 21
			Line  2+(y)*2, 16 + y, 2+(y)*2, 21
		Next y
Return

MaGetzUb · Post by **MaGetzUb** » Sat Aug 07, 2010 3:46 pm

CCE wrote:Inspiroidun Wingmanin wallpaperista ja tein kivan isometrisen "plasman".

Wow, kun näin tuon, melkein paskoin housuihini tiiliä! Hieno on!

Nassi_Setä · Post by **Nassi_Setä** » Sat Aug 07, 2010 5:09 pm

CCE: Siis tuohan on jo jotain Über-hienoo! Eikä ole mikään kovin raskaskaan, kuten voisi luulla. Mulla pyöri fps kokoajan 60

Arvaat kyllä kuka · Post by **Arvaat kyllä kuka** » Sat Aug 07, 2010 5:14 pm

Nassi_Setä wrote:Eikä ole mikään lagittaja, kuten voisi luulla.

Miten Internettiä käyttämätön sovellus voisikaan lagittaa?

MaGetzUb · Post by **MaGetzUb** » Sat Aug 07, 2010 5:24 pm

Arvaat kyllä kuka wrote:
Nassi_Setä wrote:Eikä ole mikään lagittaja, kuten voisi luulla.
Miten Internettiä käyttämätön sovellus voisikaan lagittaa?

Olet siis trolli. >:) Ja kyllä, internettiä käyttämätön sovellus voi lagia. Software renderillä toteutetut piirtokomennot hidastavat prosessoria ja sitä rataa.

Ainiin sori. Don't ever feed the troll.

Awaclus · Post by **Awaclus** » Sat Aug 07, 2010 6:14 pm

MaGetzUb wrote:
Arvaat kyllä kuka wrote:
Nassi_Setä wrote:Eikä ole mikään lagittaja, kuten voisi luulla.
Miten Internettiä käyttämätön sovellus voisikaan lagittaa?
Olet siis trolli. >:) Ja kyllä, internettiä käyttämätön sovellus voi lagia. Software renderillä toteutetut piirtokomennot hidastavat prosessoria ja sitä rataa.
Ainiin sori. Don't ever feed the troll.

Itseasiassa, termi "lag" tässä tapauksessa tarkoittaa pelkästään nimenomaan sitä, että Internet-yhteys oman koneen ja serverin välillä jumittaa. Joten Internetiä käyttämätön sovellus ei tosiaankaan voi lagia.

MaGetzUb · Post by **MaGetzUb** » Sat Aug 07, 2010 9:26 pm

Chaosworm wrote:Itseasiassa, termi "lag" tässä tapauksessa tarkoittaa pelkästään nimenomaan sitä, että Internet-yhteys oman koneen ja serverin välillä jumittaa. Joten Internetiä käyttämätön sovellus ei tosiaankaan voi lagia.

Just, en tunne tätä nettipelaajien jokseenkin ärsyttävää termistöä paremmin. Yleensä kuulen sanaa lag käytettäessä kun joku asia pätkii. Mutta jatketaanhan aihetta ettei tule modesediltä sanktiota.

MetalRain · Post by **MetalRain** » Fri Aug 20, 2010 6:42 pm

Joskus peleissä pitää ladata paljon samankaltaisia kuvia, joissa ehkä on pieniä valoisuus tai värieroja. Tein systeemin joka pystyy käsittelemään kuvia reaaliaikaisesti.

Esimerkissä 500 lehmäkuvaa (kyllä jokaisella on oma kuvansa, näin esimerkin vuoksi) ja 1024,768 kokoinen kuva muokataan muutaman sekunnin sisällä porrastetusti siten että pelattavuus säilyy. Käsittelynopeutta voi säätää sopivaksi eri tehoisille koneille ja uusia käsittelytapoja on helppo luoda. Valmiina on sumennus, harmaasävy, seepia, negatiivi, valoisuuden muokkaus ja värikanavan muokkaus.

Oletuksena on 1000 pikselioperaatiota per frame, omalla koneellani tällä esimerkillä se riittää pitämään fps:än 40-60 välillä.

Kehitysideoita otetaan vastaan, mutta toteutetaan kun jaksetaan/pystytään

Code: Select all

SCREEN 1024,768

Type LiveShader
    Field shader
    Field img
    Field ppf
End Type 

Type cow
    Field x
    Field y
    Field angle
    Field img
End Type

basecow = LoadImage("media/cow.bmp")

For o=1 To 500
    c.cow=New(cow)
    c\img = CloneImage(basecow)
    Select Rand(2,8)
        Case 2
            AddShader(c\img,"desaturate",1)
        Case 3
            AddShader(c\img,"seepian",1)
        Case 4
            AddShader(c\img,"negative",1)
        Case 5
            AddShader(c\img,"luminance",1,Rnd(-1.0,1.0))
        Case 6
            AddShader(c\img,"add",1,1,Rnd(-1.0,1.0)) 
        Case 7
            AddShader(c\img,"add",1,2,Rnd(-1.0,1.0))
        Case 8
            AddShader(c\img,"add",1,3,Rnd(-1.0,1.0))
    End Select 
    c\x=Rand(200,ScreenWidth()-200) 
    c\y=Rand(100,ScreenHeight()-100) 
    c\angle=Rand(360)
Next o

map=LoadImage("media/map.bmp")
ResizeImage map,ScreenWidth(),ScreenHeight()
AddShader(map,"seepian",1)


Targetppf=1000

Repeat

    Targetppf=Max(targetppf+(UpKey()-DownKey())*10,0)

    DrawImage map,0,0
    
    For c.cow=Each cow
    
        c\x=c\x+Cos(c\angle)*1
        c\y=c\y-Sin(c\angle)*1
        If Distance(ScreenWidth()/2,ScreenHeight()/2,c\x,c\y)>ScreenHeight()/2 Then 
            c\angle=GetAngle(c\x,c\y,ScreenWidth()/2,ScreenHeight()/2)
        EndIf

        DrawImage c\img,c\x,c\y
    
    Next c
    
    Color cbwhite
    
    UpdateShaders(Targetppf,1)
    
    DrawScreen

Forever

Function UpdateShaders(targetppf=1000,showstats=0)

    maxliveshaders=3

    pixelsperframe=0

    If targetppf>0 Then 
        maxlivecount=0
        livecount=0
        For l.liveshader=Each liveshader
            If l\shader Then 
                If PeekByte(l\shader,0)=0 Then 
                    livecount=livecount+1
                    l\ppf=0
                Else
                    DeleteMEMBlock l\shader
                    Delete l
                EndIf 
            Else 
                Delete l
            EndIf 
        Next l
        
        If livecount Then speedlimit=RoundUp((targetppf-pixelsperframe)/Max(min(maxliveshaders,livecount)-count,1))
        
        While speedlimit>0 And livecount>0
            
            count=0
            
            For l.liveshader=Each liveshader
                
                If PeekByte(l\shader,0)=0 Then 
                    If speedlimit<=0 Then
                        livecount=0
                        Exit
                    Else
                        count=count+1
                        If l\ppf=0 Then livecount=livecount+1
                        pixels=UpdateShader(l\shader,l\img,speedlimit)
                        pixelsperframe=pixelsperframe+pixels
                        l\ppf=l\ppf+pixels
                        
                        speedlimit=RoundUp((targetppf-pixelsperframe)/Max(Min(maxliveshaders,livecount)-count,1))
                        
                    EndIf 
                Else
                    DeleteMEMBlock l\shader
                    Delete l
                    livecount=livecount-1
                EndIf 
            Next l
        Wend
        
        If showstats Then 
            
            i=0
            For l.liveshader=Each liveshader
                i=i+1
                If l\ppf>0 Then 
                    Text 0,12*i,"Shader "+i+" shades "+l\ppf+" pixels per frame."
                EndIf 
            Next l
        EndIf 
    
   ' ElseIf targetppf=0
   '      For l.liveshader=Each liveshader
   '         If PeekByte(l\shader,0)=0 Then 
   '             pixelsperframe=pixelsperframe+UpdateShader(l\shader,l\img)
   '         Else
   '             DeleteMEMBlock l\shader
   '             Delete l
   '         EndIf 
   '     Next l
    EndIf 
    
    If showstats Then Text 0,0,"Pixels shaded per frame: "+pixelsperframe+" / "+targetppf+ " by "+i+" shaders @ "+FPS()+" FPS."
End Function 

Function AddShader(img,shade$,autoupdate=1,var1#=0.0,var2#=0.0)
    If img<>0 Then 
        Select shade$
        
            Case "blur", "1"
                shadenum=1
            Case "desaturate", "2"
                
                shadenum=2

            Case "seepian", "3"
            
                shadenum=3
                
            Case "negative", "4"
            
                shadenum=4
            
            Case "luminance", "5"
            
                shadenum=5
                
            Case "add", "6"
                shadenum=6
            Default 
                shadenum=0
        End Select 
        
        If shadenum Then 
        
            shader = MakeMEMBlock(34)
            
            PokeByte shader,0,0
            PokeInt shader,1,img
            PokeByte shader,5,shadenum
            PokeInt shader,6,0
            PokeInt shader,10,0
            PokeFloat shader,14,var1#
            PokeFloat shader,18,var2#
            PokeInt shader,22,ImageWidth(img)
            PokeInt shader,26,ImageHeight(img)
            
            If autoupdate Then 
                l.liveshader=New(liveshader)
                l\shader=shader
                l\img=img
            EndIf 

            Return shader
        
        EndIf 
        
        Return 0
    EndIf 
End Function 

Function UpdateShader(shader,img,speed=10)
    
    If shader<>0 And speed<>0 Then 
    
        If PeekInt(shader,1)<>img Then finished=1 Else finished = PeekByte(shader,0)
    
        If finished=0 Then 
        
            shade = PeekByte(shader,5)
            x = PeekInt(shader,6)
            y = PeekInt(shader,10)
            var1# = PeekFloat(shader,14)
            var2# = PeekFloat(shader,18)
            
            w = PeekInt(shader,22)
            h = PeekInt(shader,26)
            
            maskr=0
            maskg=0
            maskb=0
            
            Lock Image(img)

            For o=1 To speed
    
                pixel=GetPixel2(x,y,Image(img))
                
                r=(pixel Shl 8) Shr 24
                g=(pixel Shl 16) Shr 24
                b=(pixel Shl 24) Shr 24
                
                modified=0
                
                If r<>maskr Or g<>maskg Or b<>maskb Then 
                
                    Select shade
                
                        Case 1 //blur
                        
                                        
                            mr=0 
                            mg=0 
                            mb=0 
                            amount=0
        
                            If var1#=0.0 Then var1#=1.0
                            If var2#=0.0 Then var2#=2.0
                        
                            
                            For x2=-var2# To var2# 
                                For y2=-var2# To var2#
                                    If x+x2=>0 And x+x2=<w And y+y2=>0 And y+y2=<h Then
                                    
                                        pixel2=GetPixel2(x+x2,y+y2,Image(img))
                                        
                                        rr=(pixel2 Shl 8) Shr 24
                                        gg=(pixel2 Shl 16) Shr 24
                                        bb=(pixel2 Shl 24) Shr 24
                                        
                                        If rr<>maskr Or gg<>maskg Or bb<>maskb Then 
                                            mr=mr+rr
                                            mg=mg+gg
                                            mb=mb+bb
                                            amount+1
                                        EndIf
                                        
                                        
                                    EndIf 
                                Next y2
                            Next x2
                            
                            If amount Then 
                                r=(mr/amount)*var1#+r*(1.0-var1#)
                                g=(mg/amount)*var1#+g*(1.0-var1#)
                                b=(mb/amount)*var1#+b*(1.0-var1#)
                                modified=1
                            EndIf
                            
                        Case 2  //desaturate
                            
                            value=(r+g+b)/3.0
                            r=value
                            g=value
                            b=value
                            modified=1
        
                        Case 3 //seepian
                        
                            seepianvalue#=Float((r+g+b)/3.0)
                            r = 1.1*seepianvalue#
                            g = 0.8*seepianvalue#
                            b = 0.5*seepianvalue#
                            modified=1
                            
                        Case 4 //negative
                        
                            r = 255-r
                            g = 255-g
                            b = 255-b
                            modified=1
                        
                            
                        Case 5  //luminance
                        
                            If var1#=0.0 Then var1#=0.50
                            
                            r = r * (1.0+var1#)
                            g = g * (1.0+var1#)
                            b = b * (1.0+var1#)
                            modified=1
                            
                        Case 6
                            
                            Select Int(var1#)
                                Case RED 
                                    r= r*(1.0+var2#)
                                Case GREEN
                                    g= g*(1.0+var2#)
                                Case BLUE
                                    b= b*(1.0+var2#)
                            End Select 
                            
                            modified=1
                
                        Default 
                            y=h
                            x=w
                    End Select 
                EndIf
                
                If modified Then 
                    r=Max(Min(r,255),0)
                    g=Max(Min(g,255),0)
                    b=Max(Min(b,255),0)
                    PutPixel2 x,y, b + (g Shl 8) + (r Shl 16) + (255 Shl 24),Image(img)
                EndIf 
        
                If y<h-1 Then 
                    y=y+1
                ElseIf y=>h-1 And x<w-1 Then
                    y=0
                    x=x+1
                ElseIf y>=h-1 And x>=w-1 Then
                    finished=1
                    Exit
                EndIf
        
            Next o
        
            Unlock Image(img)
            
            PokeByte shader,0,finished
            PokeInt shader, 1,img
            PokeInt shader,6,x
            PokeInt shader,10,y
            
            Return speed
            
        EndIf 
        
    EndIf 
End Function

phons · Post by **phons** » Fri Aug 20, 2010 7:25 pm

MetalRain wrote:Jotain nopeaa..

Yllätyin.. ..siis positiivisesti.. ..kun näin että tästä koneesta lähteekin jotain. FPS 16-17 ja loppuefekti 20-21

Koodiapina · Post by **Koodiapina** » Fri Aug 20, 2010 7:45 pm

Ensimmäiset sekunnit pyöri alle 10 FPS, sitten nousi 30 FPS:ään (Alkuhidastelut ovat olleet tavallisia muissakin CB-ohjelmissa). Loppuefekti oli ~50 FPS.

Testikoneena heikkotehoinen kannettava.

Post by **atomimalli** » Fri Aug 20, 2010 11:15 pm

Meni tänään bumpmapit uusiksi kun kokeilin vuosien jälkeen erilaista lähesymisapaa. Nopeus ja ominaisuudet ovat kasvaneet viime kerrasta.

Code: Select all

SCREEN 400,300
'Const sw=400
'Const sh=300
sw=200
sh=150
SCREEN sw,sh,0,2
Smooth2D ON 
kuva=LoadImage("media/map.bmp")
ResizeImage kuva,sw,sh
DrawImage kuva,0,0
DrawScreen
precalc= Timer()
Dim offset(sw,sh,1) As Float
Dim col(sw,sh,2)
'Lock' Image(kuva)
For x=1 To sw-1
    For y=1 To sh-1
        ox=0
        oy=0
        For xx=-1 To 1
            For yy=-1 To 1
                PickImageColor kuva,x+xx,y+yy
                If xx And yy Then
                    c=((getRGB(RED)+getRGB(GREEN)+getRGB(BLUE)))/3 
                    'v=GetPixel(x+xx,y+yy)
                    
                    If xx=0 And yy=0 Then d=c
                    d=Distance(0,0,xx,yy)
                    ox=ox+c*xx/d
                    
                    oy=oy+c*yy/d
                Else
                    col(x,y,0)=getRGB(RED)
                    col(x,y,1)=getRGB(GREEN)
                    col(x,y,2)=getRGB(BLUE)
                EndIf
            Next yy
        Next xx
        'SetWindow ""+ox
        'normalisoini tänne
        offset(x,y,0)=ox'-d*3
        offset(x,y,1)=oy'-d*3
    Next y
    SetWindow ""+(x/2)
Next x
'Unlock
precalc = Timer() - precalc

Repeat
    t=Timer()/3
    x1=sw/2+Sin(t/5)*sw/3
    x2=sw/2+Sin(t/7)*sw/3
    x3=sw/2+Sin(t/11)*sw/3
    y1=sh/2+Sin(t/7)*sh/3
    y2=sh/2+Sin(t/11)*sh/3
    y3=sh/2+Sin(t/13)*sh/3
    Lock
    
    For x=1 To sw-1
        a= Not a
        For y=1+a To sh-2 Step 2
            'v3=ATan(20/Distance(x3,y3,x+offset(x,y,0),y+offset(x,y,1)))
            'v2=ATan(20/Distance(x2,y2,x+offset(x,y,0),y+offset(x,y,1)))
            'v=ATan(20/Distance(x1,y1,x+offset(x,y,0),y+offset(x,y,1)))
            'PutPixel2 x,y,'v+v2 shl 8 +v3 shl 16'<>0)*255
            'v#=ATan(20/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v3#=ATan(20/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v2#=ATan(20/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1)))/90
            v#=sin(ATan(15/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v3#=sin(ATan(15/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v2#=sin(ATan(15/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v#=valo(int(x+offset(x,y,0)+256+sw+x1),Int(y+offset(x,y,1)+256+sh)+x2)
            PutPixel2 x,y,Int(col(x,y,0)*v Shl 16+col(x,y,1)*v Shl 8+col(x,y,2)*v)
            'CopyBox int(x+offset(x,y,0)),Int(y+offset(x,y,1)),1,1,x-sw/2,y-sh/2,Image(kuva),SCREEN()
        Next y
    Next x
    Unlock
    SetWindow FPS()+" "+precalc
    DrawScreen OFF
Forever
WaitKey

värivaloilla sama:

Code: Select all

SCREEN 400,300
'Const sw=400
'Const sh=300
sw=200
sh=150
SCREEN sw,sh,0,2
Smooth2D ON 
kuva=LoadImage("media/map.bmp")
ResizeImage kuva,sw,sh
DrawImage kuva,0,0
DrawScreen
precalc= Timer()
Dim offset(sw,sh,1) As Float
Dim col(sw,sh,2)
'Lock' Image(kuva)
For x=1 To sw-1
    For y=1 To sh-1
        ox=0
        oy=0
        For xx=-1 To 1
            For yy=-1 To 1
                PickImageColor kuva,x+xx,y+yy
                If xx And yy Then
                    c=((getRGB(RED)+getRGB(GREEN)+getRGB(BLUE)))/3 
                    'v=GetPixel(x+xx,y+yy)
                    
                    If xx=0 And yy=0 Then d=c
                    d=Distance(0,0,xx,yy)
                    ox=ox+c*xx/d
                    
                    oy=oy+c*yy/d
                Else
                    col(x,y,0)=getRGB(RED)
                    col(x,y,1)=getRGB(GREEN)
                    col(x,y,2)=getRGB(BLUE)
                EndIf
            Next yy
        Next xx
        'SetWindow ""+ox
        'normalisoini tänne
        offset(x,y,0)=ox'-d*3
        offset(x,y,1)=oy'-d*3
    Next y
    SetWindow ""+(x/2)
Next x
'Unlock
precalc = Timer() - precalc

Repeat
    t=Timer()/3
    x1=sw/2+Sin(t/5)*sw/3
    x2=sw/2+Sin(t/7)*sw/3
    x3=sw/2+Sin(t/11)*sw/3
    y1=sh/2+Sin(t/7)*sh/3
    y2=sh/2+Sin(t/11)*sh/3
    y3=sh/2+Sin(t/13)*sh/3
    Lock
    
    For x=1 To sw-1
        a= Not a
        For y=1+a To sh-2 Step 2
            'v3=ATan(20/Distance(x3,y3,x+offset(x,y,0),y+offset(x,y,1)))
            'v2=ATan(20/Distance(x2,y2,x+offset(x,y,0),y+offset(x,y,1)))
            'v=ATan(20/Distance(x1,y1,x+offset(x,y,0),y+offset(x,y,1)))
            'PutPixel2 x,y,'v+v2 shl 8 +v3 shl 16'<>0)*255
            'v#=ATan(20/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v3#=ATan(20/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v2#=ATan(20/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1)))/90
            v#=sin(ATan(15/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1))))'/90
            v3#=sin(ATan(15/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1))))'/90
            v2#=sin(ATan(15/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v#=valo(int(x+offset(x,y,0)+256+sw+x1),Int(y+offset(x,y,1)+256+sh)+x2)
            PutPixel2 x,y,Int(col(x,y,0)*v Shl 16+col(x,y,1)*v2 Shl 8+col(x,y,2)*v3)
            'CopyBox int(x+offset(x,y,0)),Int(y+offset(x,y,1)),1,1,x-sw/2,y-sh/2,Image(kuva),SCREEN()
        Next y
    Next x
    Unlock
    SetWindow FPS()+" "+precalc
    DrawScreen OFF
Forever
WaitKey

Jani · Post by **Jani** » Fri Aug 20, 2010 11:23 pm

atomimalli wrote:

Meni tänään bumpmapit uusiksi kun kokeilin vuosien jälkeen erilaista lähesymisapaa. Nopeus ja ominaisuudet ovat kasvaneet viime kerrasta.

Code: Select all

SCREEN 400,300
'Const sw=400
'Const sh=300
sw=200
sh=150
SCREEN sw,sh,0,2
Smooth2D ON 
kuva=LoadImage("media/map.bmp")
ResizeImage kuva,sw,sh
DrawImage kuva,0,0
DrawScreen
precalc= Timer()
Dim offset(sw,sh,1) As Float
Dim col(sw,sh,2)
'Lock' Image(kuva)
For x=1 To sw-1
    For y=1 To sh-1
        ox=0
        oy=0
        For xx=-1 To 1
            For yy=-1 To 1
                PickImageColor kuva,x+xx,y+yy
                If xx And yy Then
                    c=((getRGB(RED)+getRGB(GREEN)+getRGB(BLUE)))/3 
                    'v=GetPixel(x+xx,y+yy)
                    
                    If xx=0 And yy=0 Then d=c
                    d=Distance(0,0,xx,yy)
                    ox=ox+c*xx/d
                    
                    oy=oy+c*yy/d
                Else
                    col(x,y,0)=getRGB(RED)
                    col(x,y,1)=getRGB(GREEN)
                    col(x,y,2)=getRGB(BLUE)
                EndIf
            Next yy
        Next xx
        'SetWindow ""+ox
        'normalisoini tänne
        offset(x,y,0)=ox'-d*3
        offset(x,y,1)=oy'-d*3
    Next y
    SetWindow ""+(x/2)
Next x
'Unlock
precalc = Timer() - precalc

Repeat
    t=Timer()/3
    x1=sw/2+Sin(t/5)*sw/3
    x2=sw/2+Sin(t/7)*sw/3
    x3=sw/2+Sin(t/11)*sw/3
    y1=sh/2+Sin(t/7)*sh/3
    y2=sh/2+Sin(t/11)*sh/3
    y3=sh/2+Sin(t/13)*sh/3
    Lock
    
    For x=1 To sw-1
        a= Not a
        For y=1+a To sh-2 Step 2
            'v3=ATan(20/Distance(x3,y3,x+offset(x,y,0),y+offset(x,y,1)))
            'v2=ATan(20/Distance(x2,y2,x+offset(x,y,0),y+offset(x,y,1)))
            'v=ATan(20/Distance(x1,y1,x+offset(x,y,0),y+offset(x,y,1)))
            'PutPixel2 x,y,'v+v2 shl 8 +v3 shl 16'<>0)*255
            'v#=ATan(20/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v3#=ATan(20/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v2#=ATan(20/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1)))/90
            v#=sin(ATan(15/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v3#=sin(ATan(15/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v2#=sin(ATan(15/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v#=valo(int(x+offset(x,y,0)+256+sw+x1),Int(y+offset(x,y,1)+256+sh)+x2)
            PutPixel2 x,y,Int(col(x,y,0)*v Shl 16+col(x,y,1)*v Shl 8+col(x,y,2)*v)
            'CopyBox int(x+offset(x,y,0)),Int(y+offset(x,y,1)),1,1,x-sw/2,y-sh/2,Image(kuva),SCREEN()
        Next y
    Next x
    Unlock
    SetWindow FPS()+" "+precalc
    DrawScreen OFF
Forever
WaitKey

värivaloilla sama:

Code: Select all

SCREEN 400,300
'Const sw=400
'Const sh=300
sw=200
sh=150
SCREEN sw,sh,0,2
Smooth2D ON 
kuva=LoadImage("media/map.bmp")
ResizeImage kuva,sw,sh
DrawImage kuva,0,0
DrawScreen
precalc= Timer()
Dim offset(sw,sh,1) As Float
Dim col(sw,sh,2)
'Lock' Image(kuva)
For x=1 To sw-1
    For y=1 To sh-1
        ox=0
        oy=0
        For xx=-1 To 1
            For yy=-1 To 1
                PickImageColor kuva,x+xx,y+yy
                If xx And yy Then
                    c=((getRGB(RED)+getRGB(GREEN)+getRGB(BLUE)))/3 
                    'v=GetPixel(x+xx,y+yy)
                    
                    If xx=0 And yy=0 Then d=c
                    d=Distance(0,0,xx,yy)
                    ox=ox+c*xx/d
                    
                    oy=oy+c*yy/d
                Else
                    col(x,y,0)=getRGB(RED)
                    col(x,y,1)=getRGB(GREEN)
                    col(x,y,2)=getRGB(BLUE)
                EndIf
            Next yy
        Next xx
        'SetWindow ""+ox
        'normalisoini tänne
        offset(x,y,0)=ox'-d*3
        offset(x,y,1)=oy'-d*3
    Next y
    SetWindow ""+(x/2)
Next x
'Unlock
precalc = Timer() - precalc

Repeat
    t=Timer()/3
    x1=sw/2+Sin(t/5)*sw/3
    x2=sw/2+Sin(t/7)*sw/3
    x3=sw/2+Sin(t/11)*sw/3
    y1=sh/2+Sin(t/7)*sh/3
    y2=sh/2+Sin(t/11)*sh/3
    y3=sh/2+Sin(t/13)*sh/3
    Lock
    
    For x=1 To sw-1
        a= Not a
        For y=1+a To sh-2 Step 2
            'v3=ATan(20/Distance(x3,y3,x+offset(x,y,0),y+offset(x,y,1)))
            'v2=ATan(20/Distance(x2,y2,x+offset(x,y,0),y+offset(x,y,1)))
            'v=ATan(20/Distance(x1,y1,x+offset(x,y,0),y+offset(x,y,1)))
            'PutPixel2 x,y,'v+v2 shl 8 +v3 shl 16'<>0)*255
            'v#=ATan(20/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v3#=ATan(20/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1)))/90
            'v2#=ATan(20/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1)))/90
            v#=sin(ATan(15/Distance(x1,y1,x-offset(x,y,0),y-offset(x,y,1))))'/90
            v3#=sin(ATan(15/Distance(x3,y3,x-offset(x,y,0),y-offset(x,y,1))))'/90
            v2#=sin(ATan(15/Distance(x2,y2,x-offset(x,y,0),y-offset(x,y,1))))'/90
            'v#=valo(int(x+offset(x,y,0)+256+sw+x1),Int(y+offset(x,y,1)+256+sh)+x2)
            PutPixel2 x,y,Int(col(x,y,0)*v Shl 16+col(x,y,1)*v2 Shl 8+col(x,y,2)*v3)
            'CopyBox int(x+offset(x,y,0)),Int(y+offset(x,y,1)),1,1,x-sw/2,y-sh/2,Image(kuva),SCREEN()
        Next y
    Next x
    Unlock
    SetWindow FPS()+" "+precalc
    DrawScreen OFF
Forever
WaitKey

Tämä oli jotain aivan mahtavaa! Hienot välot.

Latexi95 · Post by **Latexi95** » Sat Aug 21, 2010 11:55 am

Kuva + matriisi = efekti

Code: Select all

Function AddMatrixColor(img,mtrx,border As Byte=0)
    w = ImageWidth(img)-1
    h = ImageHeight(img)-1
    img2 = MakeImage(w+1,h+1)
    size = MEMBlockSize(mtrx)
    mtrxX = PeekShort(mtrx,size-4)
    mtrxY = PeekShort(mtrx,size-2)
    mtrxW = PeekShort(mtrx,size-8)
    mtrxH = PeekShort(mtrx,size-6)
    Lock Image(img)
    Lock Image(img2)
    For x = 0 To w
        For y = 0 To h
            If x < mtrxX Or y < mtrxY Or w-x < mtrxW-mtrxX-1 Or h-y < mtrxH-mtrxY-1 Then
                If border Then
                    PickImageColor2 img,x,y
                    PutPixel2 x,y,getRGB(BLUE)+(getRGB(GREEN) Shl 8) + (getRGB(BLUE) Shl 16),Image(img2)
                EndIf
            Else
                r# = 0
                g# = 0
                b# = 0
                For x2 = -mtrxX To mtrxW-mtrxX-1
                    For y2 = -mtrxY To mtrxH-mtrxY-1
                        PickImageColor2 img,x+x2,y+y2
                        m# = PeekFloat(mtrx,((x2+mtrxX)+(y2+mtrxY)*mtrxW)*4)
                        r# = r# + Float(getRGB(RED))*m#
                        g# = g# + Float(getRGB(GREEN))*m#
                        b# = b# + Float(getRGB(BLUE))*m#
                    Next y2
                Next x2
                r2 = Max(0,Min(255,r#))
                g2 = Max(0,Min(255,g#))
                b2 = Max(0,Min(255,b#))
                PutPixel2 x,y,b2 + (g2 Shl 8) + (r2 Shl 16),Image(img2)
            EndIf
        Next y
    Next x
    Unlock Image(img)
    Unlock Image(img2)
    Return img2
EndFunction
Function AddMatrix(img,mtrx,border As Byte=0)
    w = ImageWidth(img)-1
    h = ImageHeight(img)-1
    img2 = MakeImage(w+1,h+1)
    size = MEMBlockSize(mtrx)
    mtrxX = PeekShort(mtrx,size-4)
    mtrxY = PeekShort(mtrx,size-2)
    mtrxW = PeekShort(mtrx,size-8)
    mtrxH = PeekShort(mtrx,size-6)
    Lock Image(img)
    Lock Image(img2)
    For x = 0 To w
        For y = 0 To h
            If x < mtrxX Or y < mtrxY Or w-x < mtrxW-mtrxX-1 Or h-y < mtrxH-mtrxY-1 Then
                If border Then
                    PutPixel2 x,y,GetPixel2(x,y,Image(img)),Image(img2)
                EndIf
            Else
                r# = 0
                g# = 0
                b# = 0
                For x2 = -mtrxX To mtrxW-mtrxX-1
                    For y2 = -mtrxY To mtrxH-mtrxY-1
                        PickImageColor2 img,x+x2,y+y2
                        m# = PeekFloat(mtrx,((x2+mtrxX)+(y2+mtrxY)*mtrxW)*4)
                        r# = r# + Float(getRGB(RED))*m#
                        g# = g# + Float(getRGB(GREEN))*m#
                        b# = b# + Float(getRGB(BLUE))*m#
                    Next y2
                Next x2
                sum = Max(0,Min(255,(r#+g#+b#)/3))
                PutPixel2 x,y,sum + (sum Shl 8) + (sum Shl 16),Image(img2)
            EndIf
        Next y
    Next x
    Unlock Image(img)
    Unlock Image(img2)
    Return img2
EndFunction

Function MakeBlurMatrix()
    mtrx = MakeMEMBlock(44)
    PokeFloat mtrx,0,0:PokeFloat mtrx,4,0.2:PokeFloat mtrx,8,0
    PokeFloat mtrx,12,0.2:PokeFloat mtrx,16,0.2:PokeFloat mtrx,20,0.2
    PokeFloat mtrx,24,0:PokeFloat mtrx,28,0.2:PokeFloat mtrx,32,0
    PokeShort mtrx,36,3:PokeShort mtrx,38,3
    PokeShort mtrx,40,1:PokeShort mtrx,40,1
    Return mtrx
EndFunction

Function MakeEdgeEnhanceMatrix(force# = 1)
    mtrx = MakeMEMBlock(16)
    PokeFloat mtrx,0,-1*force#:PokeFloat mtrx,4,2*force#
    PokeShort mtrx,8,2:PokeShort mtrx,10,1
    PokeShort mtrx,12,1:PokeShort mtrx,14,0
    Return mtrx
EndFunction

Function MakeSharpenMatrix(force# = 1)
    mtrx = MakeMEMBlock(44)
    PokeFloat mtrx,0,0:PokeFloat mtrx,4,-1*force#:PokeFloat mtrx,8,0
    PokeFloat mtrx,12,-1*force#:PokeFloat mtrx,16,4*force#:PokeFloat mtrx,20,-1*force#
    PokeFloat mtrx,24,0:PokeFloat mtrx,28,-1*force#:PokeFloat mtrx,32,0
    PokeShort mtrx,36,3:PokeShort mtrx,38,3
    PokeShort mtrx,40,1:PokeShort mtrx,40,1
    Return mtrx
EndFunction
Function MakeEmbossMatrix(force# = 1)
    mtrx = MakeMEMBlock(44)
    PokeFloat mtrx,0,-2*force#:PokeFloat mtrx,4,-1*force#:PokeFloat mtrx,8,0
    PokeFloat mtrx,12,-1*force#:PokeFloat mtrx,16,1*force#:PokeFloat mtrx,20,1*force#
    PokeFloat mtrx,24,0:PokeFloat mtrx,28,1*force#:PokeFloat mtrx,32,2*force#
    PokeShort mtrx,36,3:PokeShort mtrx,38,3
    PokeShort mtrx,40,1:PokeShort mtrx,40,1
    Return mtrx
EndFunction
Function MakeEdgeDetectMatrix(force# = 1)
    mtrx = MakeMEMBlock(44)
    PokeFloat mtrx,0,0:PokeFloat mtrx,4,1*force:PokeFloat mtrx,8,0
    PokeFloat mtrx,12,1*force#:PokeFloat mtrx,16,-4*force#:PokeFloat mtrx,20,1*force#
    PokeFloat mtrx,24,0:PokeFloat mtrx,28,1*force#:PokeFloat mtrx,32,0
    PokeShort mtrx,36,3:PokeShort mtrx,38,3
    PokeShort mtrx,40,1:PokeShort mtrx,40,1
    Return mtrx
EndFunction

SCREEN 600,400
img = LoadImage("Media/tileset.bmp")
mtrx = MakeBlurMatrix()
img2 = AddMatrixColor(img,mtrx)
DrawImage img,0,0
DrawImage img2,300,0
DrawScreen
WaitKey

Sisältää valmiiksi 5 matriisia kuvan käsittelyyn. mm. terävöittämiseen ja reunojen etsintään.
Matriisin voi lisätä kuvaan joko väreillä(AddMatrixColor) tai harmaa sävyillä(AddMatrix)
Vielä kun joku keksii miten kannattaisi tehdä reunat... Tällä hetkellä funktio ei piirrä reunoja tai piirtää ne muokkaamattomina...
En nyt ehdi selittelemään enempää pitää mennä pihatöihin.

TheDuck · Post by **TheDuck** » Sat Aug 21, 2010 12:00 pm

Can't load image: Media/tileset.png

Post by **valscion** » Sat Aug 21, 2010 12:39 pm

TheDuck wrote:Can't load image: Media/tileset.png

Heitä rivin 130

Code: Select all

img = LoadImage("Media/tileset.png")

tilalle tämä:

Code: Select all

img = LoadImage("Media/tileset.bmp")

EDIT: Oli muuten ihan kivoja matriiseja

. Tuohon tilesettiin kun heitti MakeEdgeDetectMatrix tai MakeSharpenMatrix niin oli aika kauhean näköistä, mutta muut toimivat oikein hienosti

. Yllättävän nopeitakin olivat, kun miettii CB:n hitautta.

CoolBasic Forums

Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Kuvien käsittely pelin taustaprosessina

Re: Kuvien käsittely pelin taustaprosessina

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit