Efektit

Buke · Post by **Buke** » Tue Aug 28, 2012 3:55 pm

koodaaja wrote:Ei vaan renderöintiin kuluneen ajan, koska sitä on mielekkäämpää mitata - jos 2ms kestävä renderöinti suoritetaan kuudesti framessa, se kestää 12ms. Jos ilmoitetaan että FPS on 800 ja sama asia tehdään kuusi kertaa, on huomattavasti haastavampaa suoraan päässä arvioida, mikä FPS sen jälkeen on. Lisäksi millisekunteina ilmoitettaessa voidaan kertoa yksittäisen osaoperaation kesto luontevammin, vaikka "blur-passiin menee 3ms" kun taas FPS-lukema on aina koko silmukan viemä aika.

Koodissasi on muuten aivan turhaan makeimagella kolmas parametri, tallennat syyttä levylle vaikka voisit käyttää kuvia suoraan muistista (yksinkertaisesti poistaa kaikki saveimage/deleteimage/loadimage-kohdat) ja unohdit precalccien jälkeen drawtoscreenin, minkä takia efekti tökkii julmetusti vaikka fps-mittari sanookin kovaa lukua. Minkä lisäksi kolmen framen noise näytä kovin uskottavalta.

Kiitos neuvoista. Tarkoitukseni ei kuitenkaan ollut tehdä efektistä uskottavaa, ajoin vain takaa sitä, että se olisi nopeampi, kuin Wingmanin. Mutta, jos halutaan uskottavuutta, niin tässä versio, joka renderöi yhden kuvan 16-17 millisekunnissa ja frameja on 12 ja niitähän voi lisätä kokoajan enemmän, mutta tämäkin on jo melko uskottava noise-efekti(kiitos, nyt tiedän sen oikean terminkin!):

Code: Select all

kuva1 = MakeImage(399,299,4)
DrawToImage kuva1

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva2 = MakeImage(399,299,4)
DrawToImage kuva2

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva3 = MakeImage(399,299,4)
DrawToImage kuva3

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 
   
kuva4 = MakeImage(399,299,4)
DrawToImage kuva4

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva5 = MakeImage(399,299,4)
DrawToImage kuva5

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva6 = MakeImage(399,299,4)
DrawToImage kuva6

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 
   
kuva7 = MakeImage(399,299,4)
DrawToImage kuva7

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva8 = MakeImage(399,299,4)
DrawToImage kuva8

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva9 = MakeImage(399,299,4)
DrawToImage kuva9

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 
   
kuva10 = MakeImage(399,299,4)
DrawToImage kuva10

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva11 = MakeImage(399,299,4)
DrawToImage kuva11

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

kuva12 = MakeImage(399,299,4)
DrawToImage kuva12

   Lock 
        For x=0 To 399
            For y=0 To 299
                PutPixel2 x,y,Rand(255)*65793
            Next y
        Next x
   Unlock 

DrawToScreen 

alku:

start = Timer()
DrawImage kuva1,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva2,0,0
DrawScreen 
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva3,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva4,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva5,0,0
DrawScreen 
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva6,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva7,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva8,0,0
DrawScreen 
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva9,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva10,0,0
DrawScreen
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva11,0,0
DrawScreen 
SetWindow Str(FPS()) + " " + Str(Timer()-start)

start = Timer()
DrawImage kuva12,0,0
DrawScreen 
SetWindow Str(FPS()) + " " + Str(Timer()-start)

Goto alku

Miksikäs en voi ajaa tuota koodia 640x480 tilassa, vaan tulee MAV. Olisi mukava pystyä ajamaan tuo koodi 640x480 tilassa, että se olisi vertailukelpoinen sinun koodiisi.

legend · Post by **legend** » Tue Aug 28, 2012 4:17 pm

Buke wrote:*#"(&%)*

Realiaikaista ja randomisoitua on turha verrata etukäteen laskettuun versioon...
Etukäteen laskettu voittaa melkein aina

Buke · Post by **Buke** » Tue Aug 28, 2012 4:25 pm

legend wrote:
Buke wrote:*#"(&%)*
Realiaikaista ja randomisoitua on turha verrata etukäteen laskettuun versioon...
Etukäteen laskettu voittaa melkein aina

Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?

Latexi95 · Post by **Latexi95** » Tue Aug 28, 2012 4:49 pm

Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?

Protip: Jos haluat kenenkään täällä yhtään pitävän sinusta, niin en suosittele ylpeilemään tuolla saavutuksella.

Wingman · Post by **Wingman** » Tue Aug 28, 2012 5:28 pm

Kuten sanottu, oma noiseni tosiaankaan ei ole esilaskettu, ja esilaskemalla noisesta saa vaikka kuinka nopeaa.

Mutta niin, nyt kun emme atomimallin kanssa oikeastaan saaneetkaan demoa/introa kasaan niin voisin paljastella yhden efektinpoikasen jonka tein introon, digisäröily/noise/rikkominen/mikävain. Efekti on tarkoituksella 'liian' voimakas, tämä tosiaan on vain testiversio;

Code: Select all

Const SW=320
Const SH=240
SCREEN SW*2,SH*2,0,1
zoomed_screen_a = MakeImage(ScreenWidth(), ScreenHeight())
zoomed_screen 	= MakeImage(ScreenWidth(), ScreenHeight())
MaskImage zoomed_screen_a, 255, 0, 254
MaskImage zoomed_screen, 255, 0, 254
damage_screen_a = MakeImage(ScreenWidth(), ScreenHeight())
damage_screen 	= MakeImage(ScreenWidth(), ScreenHeight())
MaskImage damage_screen_a, 255, 0, 254
MaskImage damage_screen, 255, 0, 254
img=MakeImage(320,240) //tämä nyt vain jotta efektistä näkee jotain
DrawToImage img
	For i=0 To 100
		Color Rand(255),Rand(255),Rand(255)
		Box Rand(SW),Rand(SH),Rand(80),Rand(60),Rand(1)
	Next i
DrawToScreen 
blockynes=1
mode=1
power=10 		//tällä voi säätää särön voimakkuutta
dh=sh
dw=sw
Dim c(dh*2)
Dim rn(dh*2)
Dim digibox(dw,dh)
Dim digi(dw,dh)
For x=0 To dw
	For y=0 To dh
		digibox(x,y)=Rand(-4,4)
	Next y
Next x
Repeat 
	//säröilyn koordinaatit 
	dx=0'MouseX()/2-20
	dy=0'MouseY()/2-20
	dw=sw'40
	dh=sh'40
	If KeyHit(29) Then mode=Not mode
	DrawImage img,0,0
	If KeyHit(28) Then 
		lin=dh*5
	EndIf 
	If KeyDown(57) Then 
		Gosub damage
	EndIf 
	If Rand(10)=0 Then 
		lin=dh*5
		For x=0 To dw
			For y=0 To dh
				digi(x,y)=0
			Next y
		Next x
	EndIf 
	'dx=sw-MouseX()/2-20
	'dy=sh-MouseY()/2-20
	'dw=40
	'dh=40
	'If KeyDown(57) Then 
	'	Gosub damage
	'EndIf 
	//tähän väliin kaikki joka ei säröydy
	Color 255,255,255
	Text 0,0,FPS()
	Gosub doublepixel
	DrawScreen 
Forever 
doublePixel:  //Peisikin sedät tehny hyvää työtä, kätevä doublepixel ;P
	For y=0 To ScreenHeight() / 2
		CopyBox 0, y/blockynes*blockynes, SW*2, 1, 0, y*2, SCREEN(), Image(zoomed_screen_a)
		CopyBox 0, (y+1)/blockynes*blockynes, SW*2, 1, 0, y*2+1, SCREEN(), Image(zoomed_screen_a)
	Next y
	For x=0 To ScreenWidth() / 2
		CopyBox x/blockynes*blockynes,0, 1, SH*2, x*2, 0, Image(zoomed_screen_a), Image(zoomed_screen)
		CopyBox x/blockynes*blockynes,0, 1, SH*2, x*2+1, 0, Image(zoomed_screen_a), Image(zoomed_screen)
	Next x
	DrawImage zoomed_screen, 0, 0
Return 
damage: //jahas ja digi-säröilyä pitäis tehdä
	CopyBox 0,0,sw,sh,0,0,SCREEN(),Image(damage_screen_a)
	If Rand(20)=0 And mode=1 Then lin=dh*Rnd(0.5,5)
	linn#=CurveValue(lin,linn,100)
	linn=Max(0,lin)
	For y=dy To dy+dh
		If y Mod 8 = 0 And mode=1 Then
			cc=Rand(64,255)
			For ii=y To y+8
				c(ii)=cc
			Next ii
		EndIf 
		If mode=1 Then  rn(y)=Rand(-power,power)*(linn*8+1)
		lin=Max(0,lin)
		If Rand(1,50)<>1 And lin=0 Then 
			CopyBox dx+rn(y),y,dw,1,dx+rn(y)/2,y,SCREEN(),Image(damage_screen_a)
		Else
			If mode=1 Then lin=lin-1
			DrawToImage damage_screen_a
				Color c(y),c(y),c(y)
				Box dx,y,dw,1,1
			DrawToScreen 
		EndIf 
	Next y
	CopyBox 0,0,sw,sh,0,0,Image(damage_screen_a),Image(damage_screen)
	For y=dy To dy+dh Step 8
		For x=dx To dx+dw Step 8
			If Rand(20)=0 Then 
				digi(x,y)=Rand(20,100)
			EndIf 
			If digi(x,y)>0 Then 
				digi(x,y)=digi(x,y)-1
				PickColor Max(0,Min(dw,x+(8*digibox(x,y)))),y
				DrawToImage damage_screen
					Box x,y,8,8
				DrawToScreen 
			EndIf 
		Next x
	Next y
	DrawImage damage_screen,0,0
Return

EDIT:

Koodissa tosiaan käytän peisikin setien tuplapikseliä, koska sillä sai grafiikan kivan kokoiseksi, ja siitä kattelin myös vähän miten itse tekisin mitäkin. Kiitosta Peisikin leiriin

Post by **koodaaja** » Tue Aug 28, 2012 8:21 pm

Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?

Noisesi rendautuu yhtä nopeasti kuin muidenkin, teet vain vähemmän frameja ja toistat niitä :) Piirtämällä parisataa framea tauluun voisi saada jo varsin pehmeää jälkeä, etenkin jos randomoisi esitysjärjestyksen.

Misthema · Post by **Misthema** » Thu Sep 06, 2012 9:48 pm

Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?

Bwahahhahah

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

Buke · Post by **Buke** » Sat Sep 08, 2012 7:54 am

Misthema wrote:

Buke wrote:Eli minulla on tällä hetkellä koko Coolbasic-yhteisön nopein noise-efekti?

Bwahahhahah

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?

MrMonday · Post by **MrMonday** » Sat Sep 08, 2012 12:40 pm

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

"Ja ainoa ero, on, että toteutus on erilainen..."

Nyt sitten

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

naputtelija · Post by **naputtelija** » Sat Sep 08, 2012 4:40 pm

MrMonday wrote:
Buke wrote:Ja ainoa ero, on, että toteutus on erilainen ja kuvia on enemmän?
"Ja ainoa ero, on, että toteutus on erilainen..."

Nyt sitten 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ää...

Buke · Post by **Buke** » Sat Sep 08, 2012 8:39 pm

Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-

Awaclus · Post by **Awaclus** » Sat Sep 08, 2012 8:49 pm

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.

skorpioni-cb · Post by **skorpioni-cb** » Sun Sep 09, 2012 3:52 pm

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

MaGetzUb · Post by **MaGetzUb** » Sun Sep 09, 2012 5:15 pm

Tein tämmöisen 3D anaglyyffitestin cbEnchantedille, kokeilkaa pois ja kertokaa mielipiteenne..

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

Wingman · Post by **Wingman** » Sun Sep 09, 2012 5:16 pm

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

Combatti · Post by **Combatti** » Mon Sep 10, 2012 2:41 pm

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.

skorpioni-cb · Post by **skorpioni-cb** » Mon Sep 10, 2012 4:16 pm

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.

Kyllä raaka laskentateho on hyvä

Latexi95 · Post by **Latexi95** » Mon Sep 10, 2012 5:51 pm

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( )

MrMonday · Post by **MrMonday** » Mon Sep 10, 2012 8:39 pm

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!

Nyt oli kyllä jotain niin komiaa että huh huh! Pelottaa ajatellakkin, mitä foorumin mestarit saavat cbc:llä aikaan

Wingman · Post by **Wingman** » Tue Sep 11, 2012 8:27 am

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.

Raycastaushan on juurikin se, mikä tuon 3d-grafiikan piirtää. eipä tuossa mitään ihmeempiä efektejä ole.

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

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit