Page 32 of 34

Re: Efektit

Posted: Thu Sep 06, 2012 9:48 pm
by Misthema
Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?
Bwahahhahah :D

Miten edes kehtaat leijua tuon näköisen koodin kanssa...?


Muutinpa koodisi paljonkin nätimmäksi:

Code: Select all

Dim kuvat(128) As Integer
Dim kuva As Integer

For i=0 To 127
    kuva = MakeImage(400,300)
    Lock(Image(kuva))
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793,Image(kuva)
            Next y
        Next x
    Unlock(Image(kuva))
    
    kuvat(i) = kuva
    
    If i Mod 16 = 0 Then block = plapla(block)
Next i

alku:

    start = Timer()

    DrawImage kuvat(Rand(start) Mod 128),0,0

    DrawScreen

    SetWindow Str(FPS()) + " " + Str(Timer()-start)

Goto alku



Function plapla(block#)
    prog# = block / 8.0 * 100
    Color 255,255,255
    Box 0,0, 4*prog,10
    DrawScreen
    Return block+1
EndFunction


Re: Efektit

Posted: Sat Sep 08, 2012 7:54 am
by Buke
Misthema wrote:
Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?
Bwahahhahah :D

Miten edes kehtaat leijua tuon näköisen koodin kanssa...?


Muutinpa koodisi paljonkin nätimmäksi:

Code: Select all

Dim kuvat(128) As Integer
Dim kuva As Integer

For i=0 To 127
    kuva = MakeImage(400,300)
    Lock(Image(kuva))
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793,Image(kuva)
            Next y
        Next x
    Unlock(Image(kuva))
    
    kuvat(i) = kuva
    
    If i Mod 16 = 0 Then block = plapla(block)
Next i

alku:

    start = Timer()

    DrawImage kuvat(Rand(start) Mod 128),0,0

    DrawScreen

    SetWindow Str(FPS()) + " " + Str(Timer()-start)

Goto alku



Function plapla(block#)
    prog# = block / 8.0 * 100
    Color 255,255,255
    Box 0,0, 4*prog,10
    DrawScreen
    Return block+1
EndFunction

Ja ainoa ero, on, että toteutus on erilainen ja kuvia on enemmän? :P

Re: Efektit

Posted: Sat Sep 08, 2012 12:40 pm
by MrMonday
Buke wrote:Ja ainoa ero, on, että toteutus on erilainen ja kuvia on enemmän? :P
"Ja ainoa ero, on, että toteutus on erilainen..."

Nyt sitten :D Ihan hienoa että ohjelmointi kiinnostaa ja uskoo itseensä, mutta lajina se on kuitenkin sellainen, missä auttaa huomattavasti, jos ensin opettelee hieman nöyryyttä ;) Tai sanotaanko että täällä foorumilla se ainakin auttaa, koska viestisi tässä efektit-topicissa on olleet kyllä jo niin jotain älytöntä, että ei tiedä itkeäkkö vai nauraa, joten kannattaa palata maan pinnalle ja sitten tulla kerskailemaan, kun on tämän yhteisön mittapuulla jotain merkittävää saanut aikaiseksi :)

Re: Efektit

Posted: Sat Sep 08, 2012 4:40 pm
by naputtelija
MrMonday wrote:
Buke wrote:Ja ainoa ero, on, että toteutus on erilainen ja kuvia on enemmän? :P
"Ja ainoa ero, on, että toteutus on erilainen..."

Nyt sitten :D Ihan hienoa että ohjelmointi kiinnostaa ja uskoo itseensä, mutta lajina se on kuitenkin sellainen, missä auttaa huomattavasti, jos ensin opettelee hieman nöyryyttä ;) Tai sanotaanko että täällä foorumilla se ainakin auttaa, koska viestisi tässä efektit-topicissa on olleet kyllä jo niin jotain älytöntä, että ei tiedä itkeäkkö vai nauraa, joten kannattaa palata maan pinnalle ja sitten tulla kerskailemaan, kun on tämän yhteisön mittapuulla jotain merkittävää saanut aikaiseksi :)
todellakin... Tuo paranneltu koodi on paljon kehittyneempi ja tehokkaampi sekä hienompi. Se lisäksi sisältää sellaisia hyödyntämisiä, joista buke ei ole koskaan kuullutkaan ja hänen kannattaisi ne opetella. Nopeus ei ole tärkeää...

Re: Efektit

Posted: Sat Sep 08, 2012 8:39 pm
by Buke
Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-

Re: Efektit

Posted: Sat Sep 08, 2012 8:49 pm
by Awaclus
Buke wrote:Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-
Okei, tervemenoa. Ei täällä mikään pakko ole pyöriä, jos ei osaa vastaanottaa aiheellista kritiikkiä.

EDIT: Pahoittelen offtopicia ja omalta osaltani se loppuu tällä kertaa tähän.

Re: Efektit

Posted: Sun Sep 09, 2012 3:52 pm
by skorpioni-cb
Awaclus wrote:
Buke wrote:Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-
Okei, tervemenoa. Ei täällä mikään pakko ole pyöriä, jos ei osaa vastaanottaa aiheellista kritiikkiä.
Täytyy sanoa worm(yh, en ikinä opi tuntemaan sua Awaclusina) Sä oot aika ilkee :roll:

Re: Efektit

Posted: Sun Sep 09, 2012 5:15 pm
by MaGetzUb
Tein tämmöisen 3D anaglyyffitestin cbEnchantedille, kokeilkaa pois ja kertokaa mielipiteenne.. :D Pelkkää tylsyyden tulosta tämä koodi.

Code: Select all

Const CBE_CUSTOM_FUNCTION_GROUP = 1

Const ScrW = 1600
Const ScrH= 900
Const StarAmount = 1024

Dim stars(StarAmount, 2) As Float 

Const NO_STEREO = 0 
Const STEREO_MAGENTA_GREEN = 1
Const STEREO_RED_GREEN = 2
Const STEREO_RED_CYAN = 3
Const STEREO_RED_BLUE = 4

Const STAR_SIZE = 4.0
Const EYE_SPACE = 2.0 

Const SPEED = 2.0

Global CurrentMode 

SCREEN ScrW, ScrH

For i = 0 To StarAmount
    stars(i, 0) = Rnd(-ScrW, ScrW)
    stars(i, 1) = Rnd(-ScrH, ScrH)
    stars(i, 2) = Rnd(1024)
Next i

CurrentMode = STEREO_RED_BLUE

Repeat 
    ClearText 
    AddText "Press  1, 2, 3, 4 keys To change anaglyph mode"
    For i = 0 To 4
        If KeyHit(2+i) Then 
            CurrentMode = -1+(i+1)
        EndIf 
    Next i
    
    For i = 0 To StarAmount
        stars(i, 2) = stars(i, 2) - SPEED
        star(stars(i, 0), stars(i, 1), stars(i, 2), CurrentMode)
        If stars(i, 2) < 0 Then stars(i, 2) = stars(i, 2) + 1024
    Next i

DrawScreen
Forever 

Function Star(x#, y#, z#, stereoscopic = 0)
    r = getRGB(1)
    g = getRGB(2)
    b = getRGB(3)
    a = getRGB(4)
    Select stereoscopic
    Case 0
        s_z# = 1.0 / z#
        s_x# = ScrW/2 + x# * s_z# * 500
        s_y# = ScrH/2 - y# * s_z# * 500
        s_w# = STAR_SIZE * s_z * 500
        s_h# = STAR_SIZE * s_z * 500
        cbeColor(255, 255, 255, 127*s_z*500)
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h 
    Case 1
        s_z# = 1.0 / z#
        s_y# = ScrH/2 - y# * s_z# * 500
        s_w# = STAR_SIZE * s_z * 500
        s_h# = STAR_SIZE * s_z * 500
        cbeColor(255, 0, 255, 127*s_z*500)
        s_x# = ScrW/2 + (x#-EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h  
        cbeColor(0, 255, 0, 127*s_z*500)
        s_x# = ScrW/2 + (x#+EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h          
    Case 2
        s_z# = 1.0 / z#
        s_y# = ScrH/2 - y# * s_z# * 500
        s_w# = STAR_SIZE * s_z * 500
        s_h# = STAR_SIZE * s_z * 500
        cbeColor(255, 0, 0, 127*s_z*500)
        s_x# = ScrW/2 + (x#-EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h  
        cbeColor(0, 255, 0, 127*s_z*500)
        s_x# = ScrW/2 + (x#+EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h        
    Case 3
        s_z# = 1.0 / z#
        s_y# = ScrH/2 - y# * s_z# * 500
        s_w# = STAR_SIZE * s_z * 500
        s_h# = STAR_SIZE * s_z * 500
        cbeColor(255, 0, 0, 127*s_z*500)
        s_x# = ScrW/2 + (x#-EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h  
        cbeColor(0, 255, 255, 127*s_z*500)
        s_x# = ScrW/2 + (x#+EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h   
    Case 4
        s_z# = 1.0 / z#
        s_y# = ScrH/2 - y# * s_z# * 500
        s_w# = STAR_SIZE * s_z * 500
        s_h# = STAR_SIZE * s_z * 500
        cbeColor(255, 0, 0, 127*s_z*500)
        s_x# = ScrW/2 + (x#-EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h  
        cbeColor(0, 0, 255, 127*s_z*500)
        s_x# = ScrW/2 + (x#+EYE_SPACE) * s_z# * 500  
        Box s_x - s_w/2, s_y - s_h/2, 1+s_w, 1+s_h          
    EndSelect 
    cbeColor(r, g, b, a)
EndFunction 

Function cbeColor(cbeR, cbeG, cbeB, cbeA)
    cbeGroup = CBE_CUSTOM_FUNCTION_GROUP
    cbeFuncId = 2
End Function

Re: Efektit

Posted: Sun Sep 09, 2012 5:16 pm
by Wingman
Pitkästä aikaa jotain järkevämpää toteutettu, eli raycaster. Pientä ongelmaa havaittavissa kun katsoo laatikoita tietyistä suunnista, tiedä sitten missä vika.

Code: Select all

SCREEN 640,480,0,1
h=479
w=639
Dim map(32,32)
Dim row(32) As String
row(1)= "1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(2)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(3)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(4)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(5)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(6)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(7)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(8)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(9)= "1,2,2,0,0,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(10)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(11)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(12)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(13)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(14)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(15)="1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,1,5,5,5,5,5,6,6,6,6,6,7,7,7,7,7,1,"
row(16)="1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(17)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(18)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(19)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(20)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(21)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(22)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(23)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(24)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(25)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(26)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(27)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(28)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(29)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(30)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(31)="1,5,2,6,3,7,4,5,2,6,3,7,4,5,2,6,3,7,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(32)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3,1,"
For n=1 To 32
	For nn=1 To Len(row(n))
		For i=1 To 32
			map(32-i,n)=Int(Left(row(n),InStr(row(n),",")))
			row(n)=StrRemove(row(n),1,InStr(row(n),","))
		Next i
	Next nn
Next n
posX#=8
posY#=24
dirX#=-1
dirY#=0
planeX#=0
planeY#=0.66
rotSpeed#=2
otim#=Timer()
tim#=Timer()-otim
Repeat 
	otim#=Timer()
	rotSpeed#=tim/10
	moveSpeed#=tim/100
	If KeyDown(32) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(30) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(17) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(31) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	If KeyDown(205) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(203) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(200) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(208) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	Lock 
	For x=0 To 640 Step 2
		camX# = Float(2) * Float(x) / Float(w) - 1 
		rayPosX# = Float(posX)
		rayPosY# = Float(posY)
		rayDirX# = dirX + planeX * camX
		rayDiry# = dirY + planeY * camX
		sideDistX#=0
		sideDistY#=0
		mapX = Int(rayPosX)
		mapY = Int(rayPosY)
		deltaDistX# = Sqrt(1+(rayDirY*rayDirY)/(rayDirX*rayDirX))
		deltaDistY# = Sqrt(1+(rayDirX*rayDirX)/(rayDirY*rayDirY))
		stepX=0
		stepY=0
		hit=0
		side=0
		If rayDirX<0 Then 
			stepX = -1
			sideDistX = (rayPosX-mapX)*deltaDistX
		Else 
			stepX = 1
			sideDistX = (mapX+1-rayPosX)*deltaDistX
		EndIf 
		If rayDirY<0 Then 
			stepY = -1
			sideDistY = (rayPosY-mapY)*deltaDistY
		Else 
			stepY = 1
			sideDistY = (mapY+1-rayPosY)*deltaDistY
		EndIf
		While hit=0
			If sideDistX<sideDistY Then 
				sideDistX=sideDistX+deltaDistX
				mapX=mapX+stepX
				side=0
			'Color 255,0,0
			'Dot mapX,mapY
			Else 
				sideDistY=sideDistY+deltaDistY
				mapY=mapY+stepY
				side=1
			'Color 0,255,0
			'Dot mapX,mapY
			EndIf 
			If map(mapX,mapY)>0 Then hit=map(mapX,mapY)
		Wend 
		If side=0 Then 
			perpWallDist# = Abs(Float((mapX-rayPosX+(1-stepX)/2)/rayDirX))
		Else 
			perpWallDist# = Abs(Float((mapY-rayPosY+(1-stepY)/2)/rayDirY))
		EndIf 
		side=side+1
		lineHeight#=Abs(h/perpWallDist)
		c#=Min(255,Max(0,255/side/perpWallDist))
		Select hit
			Case 1
				Color c,c,c
			Case 2
				Color c,c,0
			Case 3
				Color 0,c,c
			Case 4
				Color c,0,c
			Case 5
				Color c,0,0
			Case 6
				Color 0,c,0
			Case 7
				Color 0,0,c
			Default 
				Color c,c,c
		EndSelect 
		Line x,Max(0,-lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)
		Line x+1,Max(0,-lineHeight/2+h/2),x+1,Min(480,lineHeight/2+h/2)
		Select hit
			Case 1
				Color c/2,c/2,c/2
			Case 2
				Color c/2,c/2,0
			Case 3
				Color 0,c/2,c/2
			Case 4
				Color c/2,0,c/2
			Case 5
				Color c/2,0,0
			Case 6
				Color 0,c/2,0
			Case 7
				Color 0,0,c/2
			Default 
				Color c/2,c/2,c/2
		EndSelect 
		'Line x,Max(0,-lineHeight/2+h/2),x,0
		Line x,Min(480,lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)+lineHeight
		'Dot x,-lineheight/2+h/2
		'Dot x,lineheight/2+h/2
	Next x
	c=255
	Color 1,1,1
	Unlock 
	Box 2,1,64,32,1
	Lock 
	Color c,c,c
	For x=32 To 0 Step -1
		For y=0 To 32
			Select map(32-x,y)
				Case 1
					Color c,c,c
				Case 2
					Color c,c,0
				Case 3
					Color 0,c,c
				Case 4
					Color c,0,c
				Case 5
					Color c,0,0
				Case 6
					Color 0,c,0
				Case 7
					Color 0,0,c
				Default 
					Color c,c,c
			EndSelect 
			If map(32-x,y)<>0 Then Line x*2,y,x*2+1,y
			If Int(posX)=32-x And Int(posY)=y Then 
				Line x*2,y,x*2+1,y
				Line 2*x+dirX*-4,y-dirY*-2,2*x+dirX*-4+1,y-dirY*-2
			EndIf 
		Next y
	Next x
	Unlock 
	Text 70,0,posx+" "+posy
	Text 71,0,posx+" "+posy
	DrawScreen 
	tim#=Timer()-otim
Forever 

Re: Efektit

Posted: Mon Sep 10, 2012 2:41 pm
by Combatti
Wingman wrote:Pitkästä aikaa jotain järkevämpää toteutettu, eli raycaster. Pientä ongelmaa havaittavissa kun katsoo laatikoita tietyistä suunnista, tiedä sitten missä vika.

Code: Select all

SCREEN 640,480,0,1
h=479
w=639
Dim map(32,32)
Dim row(32) As String
row(1)= "1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(2)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(3)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(4)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(5)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(6)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(7)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(8)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(9)= "1,2,2,0,0,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(10)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(11)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(12)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(13)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(14)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(15)="1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,1,5,5,5,5,5,6,6,6,6,6,7,7,7,7,7,1,"
row(16)="1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(17)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(18)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(19)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(20)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(21)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(22)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(23)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(24)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(25)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(26)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(27)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(28)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(29)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(30)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(31)="1,5,2,6,3,7,4,5,2,6,3,7,4,5,2,6,3,7,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(32)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3,1,"
For n=1 To 32
	For nn=1 To Len(row(n))
		For i=1 To 32
			map(32-i,n)=Int(Left(row(n),InStr(row(n),",")))
			row(n)=StrRemove(row(n),1,InStr(row(n),","))
		Next i
	Next nn
Next n
posX#=8
posY#=24
dirX#=-1
dirY#=0
planeX#=0
planeY#=0.66
rotSpeed#=2
otim#=Timer()
tim#=Timer()-otim
Repeat 
	otim#=Timer()
	rotSpeed#=tim/10
	moveSpeed#=tim/100
	If KeyDown(32) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(30) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(17) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(31) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	If KeyDown(205) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(203) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(200) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(208) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	Lock 
	For x=0 To 640 Step 2
		camX# = Float(2) * Float(x) / Float(w) - 1 
		rayPosX# = Float(posX)
		rayPosY# = Float(posY)
		rayDirX# = dirX + planeX * camX
		rayDiry# = dirY + planeY * camX
		sideDistX#=0
		sideDistY#=0
		mapX = Int(rayPosX)
		mapY = Int(rayPosY)
		deltaDistX# = Sqrt(1+(rayDirY*rayDirY)/(rayDirX*rayDirX))
		deltaDistY# = Sqrt(1+(rayDirX*rayDirX)/(rayDirY*rayDirY))
		stepX=0
		stepY=0
		hit=0
		side=0
		If rayDirX<0 Then 
			stepX = -1
			sideDistX = (rayPosX-mapX)*deltaDistX
		Else 
			stepX = 1
			sideDistX = (mapX+1-rayPosX)*deltaDistX
		EndIf 
		If rayDirY<0 Then 
			stepY = -1
			sideDistY = (rayPosY-mapY)*deltaDistY
		Else 
			stepY = 1
			sideDistY = (mapY+1-rayPosY)*deltaDistY
		EndIf
		While hit=0
			If sideDistX<sideDistY Then 
				sideDistX=sideDistX+deltaDistX
				mapX=mapX+stepX
				side=0
			'Color 255,0,0
			'Dot mapX,mapY
			Else 
				sideDistY=sideDistY+deltaDistY
				mapY=mapY+stepY
				side=1
			'Color 0,255,0
			'Dot mapX,mapY
			EndIf 
			If map(mapX,mapY)>0 Then hit=map(mapX,mapY)
		Wend 
		If side=0 Then 
			perpWallDist# = Abs(Float((mapX-rayPosX+(1-stepX)/2)/rayDirX))
		Else 
			perpWallDist# = Abs(Float((mapY-rayPosY+(1-stepY)/2)/rayDirY))
		EndIf 
		side=side+1
		lineHeight#=Abs(h/perpWallDist)
		c#=Min(255,Max(0,255/side/perpWallDist))
		Select hit
			Case 1
				Color c,c,c
			Case 2
				Color c,c,0
			Case 3
				Color 0,c,c
			Case 4
				Color c,0,c
			Case 5
				Color c,0,0
			Case 6
				Color 0,c,0
			Case 7
				Color 0,0,c
			Default 
				Color c,c,c
		EndSelect 
		Line x,Max(0,-lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)
		Line x+1,Max(0,-lineHeight/2+h/2),x+1,Min(480,lineHeight/2+h/2)
		Select hit
			Case 1
				Color c/2,c/2,c/2
			Case 2
				Color c/2,c/2,0
			Case 3
				Color 0,c/2,c/2
			Case 4
				Color c/2,0,c/2
			Case 5
				Color c/2,0,0
			Case 6
				Color 0,c/2,0
			Case 7
				Color 0,0,c/2
			Default 
				Color c/2,c/2,c/2
		EndSelect 
		'Line x,Max(0,-lineHeight/2+h/2),x,0
		Line x,Min(480,lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)+lineHeight
		'Dot x,-lineheight/2+h/2
		'Dot x,lineheight/2+h/2
	Next x
	c=255
	Color 1,1,1
	Unlock 
	Box 2,1,64,32,1
	Lock 
	Color c,c,c
	For x=32 To 0 Step -1
		For y=0 To 32
			Select map(32-x,y)
				Case 1
					Color c,c,c
				Case 2
					Color c,c,0
				Case 3
					Color 0,c,c
				Case 4
					Color c,0,c
				Case 5
					Color c,0,0
				Case 6
					Color 0,c,0
				Case 7
					Color 0,0,c
				Default 
					Color c,c,c
			EndSelect 
			If map(32-x,y)<>0 Then Line x*2,y,x*2+1,y
			If Int(posX)=32-x And Int(posY)=y Then 
				Line x*2,y,x*2+1,y
				Line 2*x+dirX*-4,y-dirY*-2,2*x+dirX*-4+1,y-dirY*-2
			EndIf 
		Next y
	Next x
	Unlock 
	Text 70,0,posx+" "+posy
	Text 71,0,posx+" "+posy
	DrawScreen 
	tim#=Timer()-otim
Forever 
Hieno oli. Sitä tuntee itsensä täydelliseksi uunoksi, kun katselee näitä muiden aikaansaannoksia. Itse en edes paljoakaan kiinnittänyt huomiota itse päätarkoitukseen, ray castingiin, vaan siihen, että miten sulavasti oli saatu 3D-grafiikkaa piirrettyä normin cb:n tehoin. Itselläni oli 60FPS. Efektin hienoudesta en kyllä kykene sanomaan mitään, sillä ällistelen liikaa 3D-grafiikkaa. :D

Re: Efektit

Posted: Mon Sep 10, 2012 4:16 pm
by skorpioni-cb
Combatti wrote:
Wingman wrote:Pitkästä aikaa jotain järkevämpää toteutettu, eli raycaster. Pientä ongelmaa havaittavissa kun katsoo laatikoita tietyistä suunnista, tiedä sitten missä vika.

Code: Select all

SCREEN 640,480,0,1
h=479
w=639
Dim map(32,32)
Dim row(32) As String
row(1)= "1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(2)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(3)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(4)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(5)= "1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(6)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(7)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(8)= "1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(9)= "1,2,2,0,0,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(10)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(11)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(12)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(13)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(14)="2,0,0,0,0,0,2,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,"
row(15)="1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,1,5,5,5,5,5,6,6,6,6,6,7,7,7,7,7,1,"
row(16)="1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,"
row(17)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(18)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(19)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(20)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(21)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(22)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(23)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(24)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(25)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(26)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(27)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(28)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(29)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(30)="1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(31)="1,5,2,6,3,7,4,5,2,6,3,7,4,5,2,6,3,7,1,0,0,0,0,0,0,0,0,0,0,0,0,4,"
row(32)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3,1,"
For n=1 To 32
	For nn=1 To Len(row(n))
		For i=1 To 32
			map(32-i,n)=Int(Left(row(n),InStr(row(n),",")))
			row(n)=StrRemove(row(n),1,InStr(row(n),","))
		Next i
	Next nn
Next n
posX#=8
posY#=24
dirX#=-1
dirY#=0
planeX#=0
planeY#=0.66
rotSpeed#=2
otim#=Timer()
tim#=Timer()-otim
Repeat 
	otim#=Timer()
	rotSpeed#=tim/10
	moveSpeed#=tim/100
	If KeyDown(32) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(30) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(17) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(31) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	If KeyDown(205) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(-rotSpeed) - dirY * Sin(-rotSpeed)
		dirY = oldDirX * Sin(-rotSpeed) + dirY * Cos(-rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(-rotSpeed) - planeY * Sin(-rotSpeed)
		planeY = oldPlaneX * Sin(-rotSpeed) + planeY * Cos(-rotSpeed)
	EndIf
	If KeyDown(203) Then 
		oldDirX# = dirX
		dirX = dirX * Cos(rotSpeed) - dirY * Sin(rotSpeed)
		dirY = oldDirX * Sin(rotSpeed) + dirY * Cos(rotSpeed)
		oldPlaneX# = planeX
		planeX = planeX * Cos(rotSpeed) - planeY * Sin(rotSpeed)
		planeY = oldPlaneX * Sin(rotSpeed) + planeY * Cos(rotSpeed)
	EndIf
	If KeyDown(200) Then 
		If map(Int(posX + dirX * moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * moveSpeed
		If map(Int(posX),Int(posY + dirY * moveSpeed)) = 0 Then posY = posY + dirY * moveSpeed
	EndIf 
	If KeyDown(208) Then 
		If map(Int(posX + dirX * -moveSpeed),Int(posY)) = 0 Then posX = posX + dirX * -moveSpeed
		If map(Int(posX),Int(posY + dirY * -moveSpeed)) = 0 Then posY = posY + dirY * -moveSpeed
	EndIf 
	Lock 
	For x=0 To 640 Step 2
		camX# = Float(2) * Float(x) / Float(w) - 1 
		rayPosX# = Float(posX)
		rayPosY# = Float(posY)
		rayDirX# = dirX + planeX * camX
		rayDiry# = dirY + planeY * camX
		sideDistX#=0
		sideDistY#=0
		mapX = Int(rayPosX)
		mapY = Int(rayPosY)
		deltaDistX# = Sqrt(1+(rayDirY*rayDirY)/(rayDirX*rayDirX))
		deltaDistY# = Sqrt(1+(rayDirX*rayDirX)/(rayDirY*rayDirY))
		stepX=0
		stepY=0
		hit=0
		side=0
		If rayDirX<0 Then 
			stepX = -1
			sideDistX = (rayPosX-mapX)*deltaDistX
		Else 
			stepX = 1
			sideDistX = (mapX+1-rayPosX)*deltaDistX
		EndIf 
		If rayDirY<0 Then 
			stepY = -1
			sideDistY = (rayPosY-mapY)*deltaDistY
		Else 
			stepY = 1
			sideDistY = (mapY+1-rayPosY)*deltaDistY
		EndIf
		While hit=0
			If sideDistX<sideDistY Then 
				sideDistX=sideDistX+deltaDistX
				mapX=mapX+stepX
				side=0
			'Color 255,0,0
			'Dot mapX,mapY
			Else 
				sideDistY=sideDistY+deltaDistY
				mapY=mapY+stepY
				side=1
			'Color 0,255,0
			'Dot mapX,mapY
			EndIf 
			If map(mapX,mapY)>0 Then hit=map(mapX,mapY)
		Wend 
		If side=0 Then 
			perpWallDist# = Abs(Float((mapX-rayPosX+(1-stepX)/2)/rayDirX))
		Else 
			perpWallDist# = Abs(Float((mapY-rayPosY+(1-stepY)/2)/rayDirY))
		EndIf 
		side=side+1
		lineHeight#=Abs(h/perpWallDist)
		c#=Min(255,Max(0,255/side/perpWallDist))
		Select hit
			Case 1
				Color c,c,c
			Case 2
				Color c,c,0
			Case 3
				Color 0,c,c
			Case 4
				Color c,0,c
			Case 5
				Color c,0,0
			Case 6
				Color 0,c,0
			Case 7
				Color 0,0,c
			Default 
				Color c,c,c
		EndSelect 
		Line x,Max(0,-lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)
		Line x+1,Max(0,-lineHeight/2+h/2),x+1,Min(480,lineHeight/2+h/2)
		Select hit
			Case 1
				Color c/2,c/2,c/2
			Case 2
				Color c/2,c/2,0
			Case 3
				Color 0,c/2,c/2
			Case 4
				Color c/2,0,c/2
			Case 5
				Color c/2,0,0
			Case 6
				Color 0,c/2,0
			Case 7
				Color 0,0,c/2
			Default 
				Color c/2,c/2,c/2
		EndSelect 
		'Line x,Max(0,-lineHeight/2+h/2),x,0
		Line x,Min(480,lineHeight/2+h/2),x,Min(480,lineHeight/2+h/2)+lineHeight
		'Dot x,-lineheight/2+h/2
		'Dot x,lineheight/2+h/2
	Next x
	c=255
	Color 1,1,1
	Unlock 
	Box 2,1,64,32,1
	Lock 
	Color c,c,c
	For x=32 To 0 Step -1
		For y=0 To 32
			Select map(32-x,y)
				Case 1
					Color c,c,c
				Case 2
					Color c,c,0
				Case 3
					Color 0,c,c
				Case 4
					Color c,0,c
				Case 5
					Color c,0,0
				Case 6
					Color 0,c,0
				Case 7
					Color 0,0,c
				Default 
					Color c,c,c
			EndSelect 
			If map(32-x,y)<>0 Then Line x*2,y,x*2+1,y
			If Int(posX)=32-x And Int(posY)=y Then 
				Line x*2,y,x*2+1,y
				Line 2*x+dirX*-4,y-dirY*-2,2*x+dirX*-4+1,y-dirY*-2
			EndIf 
		Next y
	Next x
	Unlock 
	Text 70,0,posx+" "+posy
	Text 71,0,posx+" "+posy
	DrawScreen 
	tim#=Timer()-otim
Forever 
Hieno oli. Sitä tuntee itsensä täydelliseksi uunoksi, kun katselee näitä muiden aikaansaannoksia. Itse en edes paljoakaan kiinnittänyt huomiota itse päätarkoitukseen, ray castingiin, vaan siihen, että miten sulavasti oli saatu 3D-grafiikkaa piirrettyä normin cb:n tehoin. Itselläni oli 60FPS. Efektin hienoudesta en kyllä kykene sanomaan mitään, sillä ällistelen liikaa 3D-grafiikkaa. :D
Kyllä raaka laskentateho on hyvä

Re: Efektit

Posted: Mon Sep 10, 2012 5:51 pm
by Latexi95
skorpioni-cb wrote: Kyllä raaka laskentateho on hyvä
Riippuu paljolti hyvän määritelmästä, mutta ei se kovin kummoinen ole (varsinkaan cbE:llä liukulukuen kanssa x( )

Re: Efektit

Posted: Mon Sep 10, 2012 8:39 pm
by MrMonday
Wingman wrote:Pitkästä aikaa jotain järkevämpää toteutettu, eli raycaster. Pientä ongelmaa havaittavissa kun katsoo laatikoita tietyistä suunnista, tiedä sitten missä vika.
koodia..
No huh huh! :o :shock: Nyt oli kyllä jotain niin komiaa että huh huh! Pelottaa ajatellakkin, mitä foorumin mestarit saavat cbc:llä aikaan :D

Re: Efektit

Posted: Tue Sep 11, 2012 8:27 am
by Wingman
Combatti wrote:Hieno oli. Sitä tuntee itsensä täydelliseksi uunoksi, kun katselee näitä muiden aikaansaannoksia. Itse en edes paljoakaan kiinnittänyt huomiota itse päätarkoitukseen, ray castingiin, vaan siihen, että miten sulavasti oli saatu 3D-grafiikkaa piirrettyä normin cb:n tehoin. Itselläni oli 60FPS. Efektin hienoudesta en kyllä kykene sanomaan mitään, sillä ällistelen liikaa 3D-grafiikkaa. :D
Raycastaushan on juurikin se, mikä tuon 3d-grafiikan piirtää. eipä tuossa mitään ihmeempiä efektejä ole.

Re: Efektit

Posted: Tue Sep 11, 2012 12:40 pm
by Misthema
Wingman wrote:
Combatti wrote:Hieno oli. Sitä tuntee itsensä täydelliseksi uunoksi, kun katselee näitä muiden aikaansaannoksia. Itse en edes paljoakaan kiinnittänyt huomiota itse päätarkoitukseen, ray castingiin, vaan siihen, että miten sulavasti oli saatu 3D-grafiikkaa piirrettyä normin cb:n tehoin. Itselläni oli 60FPS. Efektin hienoudesta en kyllä kykene sanomaan mitään, sillä ällistelen liikaa 3D-grafiikkaa. :D
Raycastaushan on juurikin se, mikä tuon 3d-grafiikan piirtää. eipä tuossa mitään ihmeempiä efektejä ole.
Jep. Ja jostain syystä minulla töksähteli tuo jatkuvasti, niin kääntyessä kuin liikkuessakin (onko seinään törmättäessä joku pieni ponnahdus takaisinpäin? hiemahkostinohkosti näytti olevan jotain vastaavaa pomppimista).
Tykkäsin aivan hullusti noista heijastuksista ja muutenkin, kun tunnelma oli synkkä ja ehkä jollain tapaa pelottavakin! :D
Kauhupeliä kasaan!

START OFFTOPIC
Buke wrote:Ja ainoa ero, on, että toteutus on erilainen ja kuvia on enemmän? :P
Toteutus on sellainen kun sen yleensä oletetaan olevan. Luupit voittaa käsin kirjoitetut (*KRÖHÖM* kopipastetut) peräkkäiset, erilliset luupinpalaset. Ei välttämättä nopeudella tai vastaavalla, mutta ainakin siisteydellään ja selkeälukuisuudellaan (ja ovat myös nopeampi kirjoittaa, kun sitä ei tarvitse tehdä kuin kerran x).

Buke wrote:Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-
Öhm, "ilkeetä porukkaa" tuntuu ja kuulostaa jotenkin kaukaa haetulta, sillä hyvin harva näillä foorumein ovat ilkeitä (toisin kuin ylimieliset- tai valmista-koodia-vailla-aloittelijat). Enkä nyt sano, että sinä olisit mitenkään ilkeä - vaikkakin ylimielinen. :) Sinun ongelmasi vain on tuo turhanpäivänen leijailu siellä korkealla pilvissä, sinun kuvitellulla keijupölylläsi - sama kuin itse kuvittelisin omistavani kultamitalin, vaikka keppihyppelystä ja leijuisin sillä.

Kuten tuossa jo aikaisemmin sanottiin, pitää ensin oppia olemaan hieman nöyrä, selkä kyyryssä, mutta ei mitään kumartamisia, mleh! Sitten, kun olet saanut aikaiseksi jotain repäisevää, voit alkaa pikkuhiljaa suoristamaan sitä quasimodo-kyhmyäsi ja palauttaa tuon tämänhetkisen asenteesi. ;)

Image
END OFFTOPIC

Re: Efektit

Posted: Sun Jan 13, 2013 2:05 am
by CCE
Keksittekö mistä tämä on varastettu?

Code: Select all

start:
if o > -1 then text ((o mod ((400/7)*(300/7)-1)) mod (400/7))*7,((o mod ((400/7)*(300/7)-1))/(400/7))*7,chr(47+(int((o mod ((400/7)*(300/7)-1))^2.1) mod 2)*45) then o+1 then drawScreen OFF then goto start

Re: Efektit

Posted: Sun Jan 13, 2013 6:09 pm
by Ilmuri
CCE wrote:Keksittekö mistä tämä on varastettu?
Hmm, aivan kuin olisin nähnyt tuon kirjan jossain..

Re: Efektit

Posted: Wed Jan 16, 2013 6:17 pm
by skinkken
CCE wrote:Keksittekö mistä tämä on varastettu?

Code: Select all

start:
if o > -1 then text ((o mod ((400/7)*(300/7)-1)) mod (400/7))*7,((o mod ((400/7)*(300/7)-1))/(400/7))*7,chr(47+(int((o mod ((400/7)*(300/7)-1))^2.1) mod 2)*45) then o+1 then drawScreen OFF then goto start
Tuo on kyllä aika hieno, valmis sokkelo yhdellä laskulla. Mistä löysit tuon?


Tein vahingossa hauskan efektin:

Code: Select all

SCREEN 400,300,32,2

FrameLimit 30


'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'LIIKU NUOLISTA
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

x=200
y=150

Repeat
    
    If KeyDown(cbkeyleft) Then x=x-5
    If KeyDown(cbkeyright) Then x=x+5
    If KeyDown(cbkeyup) Then y=y-5
    If KeyDown(cbkeydown) Then y=y+5
    
    Color 0,0,0
    Box x,y,20,20
    
    For i=1 To 3000
        Color Rand(0,255),Rand(0,255),Rand(0,255)
        Dot Rand(0,400),Rand(0,300)
    Next i
    
    SetWindow ""+FPS()
    
    DrawScreen OFF
Forever




Re: Efektit

Posted: Sat Jan 19, 2013 8:13 pm
by Cooler
Tuli mieleen tällänen metapalloa muistuttava efekti:

Code: Select all

For x = 0 To 400
    For y = 0 To 300
        Color Min(255,Distance(x,y,200,150)),0,0
        Dot x,y
    Next y
Next x

DrawScreen
WaitKey

Re: Efektit

Posted: Sat Jan 19, 2013 8:32 pm
by atomimalli
Cooler wrote:Tuli mieleen tällänen metapalloa muistuttava efekti:

Code: Select all

For x = 0 To 400
    For y = 0 To 300
        Color Min(255,Distance(x,y,200,150)),0,0
        Dot x,y
    Next y
Next x

DrawScreen
WaitKey
Hurjan lähellä metapalloa tuo onkin!
Yhtä riviä vaan tarvii muuttaa.

Code: Select all

For x = 0 To 400
    For y = 0 To 300
        Color Min(255,10000/Distance(x,y,200,150)),0,0
        Dot x,y
    Next y
Next x

DrawScreen
WaitKey