Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Efektit

Post 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

Buke
Newcomer
Posts: 11
Joined: Mon Aug 27, 2012 5:51 pm
Location: Helsinki

Re: Efektit

Post 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
Intel 3960X @ 4.2ghz
4 x nVidia GTX 690 SLI
64GB RAM
960GB SSD
12TB HDD

Unelmointi ei ole rikos, eihän?
MrMonday
Advanced Member
Posts: 378
Joined: Fri Oct 10, 2008 2:35 pm

Re: Efektit

Post 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 :)
naputtelija
Devoted Member
Posts: 718
Joined: Wed Nov 03, 2010 7:56 pm
Location: Joku piste pohjoisessa.

Re: Efektit

Post 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ää...
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...
Buke
Newcomer
Posts: 11
Joined: Mon Aug 27, 2012 5:51 pm
Location: Helsinki

Re: Efektit

Post by Buke »

Taidanpa lopettaa ohjelmoinnin, kun tääl on näi ilkeetä porukkaa -.-
Intel 3960X @ 4.2ghz
4 x nVidia GTX 690 SLI
64GB RAM
960GB SSD
12TB HDD

Unelmointi ei ole rikos, eihän?
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Efektit

Post 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.
Last edited by Awaclus on Sun Sep 09, 2012 5:00 pm, edited 1 time in total.
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 3:48 pm
Location: Turku

Re: Efektit

Post 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:
Minä en tiedä mitä tiedän, mutta sen tiedän ettei se ole mitään kaunista.
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post 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
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post 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 
- - - -
User avatar
Combatti
Active Member
Posts: 101
Joined: Fri Jun 29, 2012 6:23 pm
Location: Kuhmo

Re: Efektit

Post 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
~Yhteiskuntaan kyllästynyt koodari.
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 3:48 pm
Location: Turku

Re: Efektit

Post 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ä
Minä en tiedä mitä tiedän, mutta sen tiedän ettei se ole mitään kaunista.
Latexi95
Guru
Posts: 1165
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Efektit

Post 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( )
MrMonday
Advanced Member
Posts: 378
Joined: Fri Oct 10, 2008 2:35 pm

Re: Efektit

Post 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
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

Post 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.
- - - -
User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Efektit

Post 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
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: Efektit

Post 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
User avatar
Ilmuri
Developer
Developer
Posts: 277
Joined: Sun Aug 26, 2007 2:46 pm
Location: \o

Re: Efektit

Post by Ilmuri »

CCE wrote:Keksittekö mistä tämä on varastettu?
Hmm, aivan kuin olisin nähnyt tuon kirjan jossain..
CoolBasic henkilökuntaa
Kehittäjä
CoolBasic Classic
User avatar
skinkken
Advanced Member
Posts: 453
Joined: Sat Sep 01, 2007 4:00 pm
Location: Helsinki

Re: Efektit

Post 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



Valmiit pelit: House of Horrors , Battle Zone , Über Ball , Itdoti , Space Chaos , Bloxxplosives
Projekti jota teen ehkä joskus vielä: viewtopic.php?f=11&t=2636 <-- Tämä rivi päivitetty 14.1.2013
User avatar
Cooler
Newcomer
Posts: 6
Joined: Thu Jan 17, 2013 8:49 pm

Re: Efektit

Post 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
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post 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
Post Reply