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 » Thu Sep 06, 2012 9:48 pm

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


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

Re: Efektit

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 :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: 377
Joined: Fri Oct 10, 2008 2:35 pm

Re: Efektit

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? :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 :)

User avatar
naputtelija
Devoted Member
Posts: 718
Joined: Wed Nov 03, 2010 8:56 pm
Location: Joku piste pohjoisessa.

Re: Efektit

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? :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...

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

Re: Efektit

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

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?

User avatar
Awaclus
Forum Veteran
Posts: 2938
Joined: Tue Aug 28, 2007 2:50 pm
Location: Sulkava

Re: Efektit

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.
Last edited by Awaclus on Sun Sep 09, 2012 5:00 pm, edited 1 time in total.
Every day I'm reshuffling.
[22:19] <@Grandi> Ha! Tiesin koko ajan, että Awaclus_ oli Awaclus. Hieno peitenimimerkki, mutta Grandia et huiputtanut.

User avatar
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 4:48 pm
Location: Turku

Re: Efektit

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 :roll:
Minä en tiedä mitä tiedän, mutta sen tiedän ettei se ole mitään kaunista.

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

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

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.

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

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

User avatar
Combatti
Active Member
Posts: 101
Joined: Fri Jun 29, 2012 6:23 pm
Location: Kuhmo

Re: Efektit

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. :D
~Yhteiskuntaan kyllästynyt koodari.

User avatar
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 4:48 pm
Location: Turku

Re: Efektit

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. :D
Kyllä raaka laskentateho on hyvä
Minä en tiedä mitä tiedän, mutta sen tiedän ettei se ole mitään kaunista.

User avatar
Latexi95
Guru
Posts: 1163
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Efektit

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
Advanced Member
Posts: 377
Joined: Fri Oct 10, 2008 2:35 pm

Re: Efektit

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! :o :shock: Nyt oli kyllä jotain niin komiaa että huh huh! Pelottaa ajatellakkin, mitä foorumin mestarit saavat cbc:llä aikaan :D

User avatar
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Efektit

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. :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 » Tue Sep 11, 2012 12:40 pm

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 » Sun Jan 13, 2013 3:05 am

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 » Sun Jan 13, 2013 7:09 pm

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: 452
Joined: Sat Sep 01, 2007 4:00 pm
Location: Helsinki

Re: Efektit

Post by skinkken » Wed Jan 16, 2013 7:17 pm

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 9:49 pm

Re: Efektit

Post by Cooler » Sat Jan 19, 2013 9:13 pm

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...

User avatar
atomimalli
Moderator
Moderator
Posts: 226
Joined: Wed Aug 29, 2007 3:55 pm

Re: Efektit

Post by atomimalli » Sat Jan 19, 2013 9:32 pm

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

Who is online

Users browsing this forum: No registered users and 1 guest