Page 1 of 1

LazerRay - Peili moottori

Posted: Wed Jan 23, 2008 8:45 pm
by JATothrim
Tulipa tämmönen väännettyä, Käyttäkää vapaasti:
"Peileistä Kimpoileva Lazer säde"

Code: Select all

SCREEN 800,600
Type Mirror
	Field x1 As Float
	Field y1 As Float
	Field x2 As Float
	Field y2 As Float
EndType

// globaalit LinerRay funktiolle
Global IntersX as Float,IntersY As Float
//Näitä Käytetään Peilien muokkauksessa
SMD.Mirror=NULL
SLP=0

// lisätään 5 peiliä
For i=1 To 5
	Mir.Mirror=New(Mirror)
	mir\x1=Rand(800)
	mir\y1=Rand(600)
	mir\x2=Rand(800)
	mir\y2=Rand(600)
Next i

//säteen sijainti, suunta
RayX#=0
RayY#=300
RayA#=0

Repeat
	//Peilien kääntely
	If MouseHit(1)
		For m.Mirror=Each Mirror
			If Distance(MouseX(),MouseY(),m\x1,m\y1)<10
				SMD=m
				SLP=1
				Exit
			ElseIf Distance(MouseX(),MouseY(),m\x2,m\y2)<10
				SMD=m
				SLP=2
				Exit
			Else
				SMD=NULL
				SLP=0
			EndIf
		Next m
	EndIf
	If MouseUp(1) Then SMD=NULL:SLP=0
	
	If SMD<>NULL And SLP<>0
		If SLP=1
			m\x1=MouseX()
			m\y1=MouseY()
		ElseIf SLP=2
			m\x2=MouseX()
			m\y2=MouseY()
		EndIf
	EndIf
	
	//pirretään peilit
	Color cbblue
	For mir.Mirror=Each Mirror
		Line mir\x1,mir\y1,mir\x2,mir\y2 
		Circle  mir\x1-3,mir\y1-3,6
		Circle  mir\x2-3,mir\y2-3,6
	Next mir
	
	
	iRayX#=RayX#
	iRayY#=RayY#
	iRayA#=RayA#
	CountedHits=0
	
	//Säteen väritys (!!HIENO!! efekti !!)
	iColX=iColX+5
	If iColX<100
		ColX=iColX
	ElseIf iColX>100 And iColX<200
		ColX=0
	ElseIf iColX>200
		iColX=0
	EndIf
	ColorTriBlend(ColX,255,0,0, 0,0,10, 255,0,0)
	
	
	//Käydään Peilejä läpi, kunnes säde ei osu mihinkään.
	Repeat
	
		FoundHit=0
		Nearest#=-1
		nMir.Mirror=NULL
		//Etsitään lähin peili.
		For mir.Mirror=Each Mirror
			//Tarkistetaan törmäys.
			If LineRay_Intersect(mir\x1,mir\y1,mir\x2,mir\y2, iRayX+Cos(iRayA)*0.1, iRayY-Sin(iRayA)*0.1, iRayX+Cos(iRayA), iRayY-Sin(iRayA))
				FoundHit=1
				Dist#=Distance(IntersX,IntersY,iRayX,iRayY)
				If Nearest#>Dist# Or Nearest#=-1
					Nearest#=Dist#
					nMir=mir
					HitX#=IntersX
					HitY#=IntersY
				EndIf
			EndIf
		Next mir
		//jos löytyi, asetetaan uusi kulma ja paikka.
		If nMir<>NULL
			HitAngle#=GetAngle(HitX,HitY,iRayX,iRayY)
			MirAngle#=GetAngle(nmir\x1,nmir\y1,nmir\x2,nmir\y2)
			iRayA=MirAngle*2-180-HitAngle
			Line iRayX,iRayY,HitX,HitY
			iRayX=HitX
			iRayY=HitY
			CountedHits=CountedHits+1
		EndIf
		
	Until FoundHit=0

	Text 0,0,"FPS:"+FPS()
	Text 0,12,"Reflections: "+CountedHits
	DrawScreen
Forever



// "muokattu" versio SDK:n Line_Intersect funktiosta.
//( Intersection_CD#>1 ehto jätetty pois, funktion toiminta muuttui radikaalisti :) ) 
Function LineRay_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
	Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
	Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)
	If Rd# = 0
		Return False
	Else
		Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)
		Intersection_AB# = Rn# / Rd#
		Intersection_CD# = Sn# / Rd#
		If Intersection_AB#>1  Or Intersection_AB#<0 Or Intersection_CD#<0 Then Return False
		IntersX = Ax# + Intersection_AB#*(Bx#-Ax#)
		IntersY = Ay# + Intersection_AB#*(By#-Ay#)
		Return True
	EndIf
End Function

Function ColorTriBlend(pros#, r1,g1,b1, r2,g2,b2, r3,g3,b3)
	p#=Float(pros)/100.0
	If 50.0<pros
		Color (1-p)*r1+p*r2, (1-p)*g1+p*g2, (1-p)*b1+p*b2
	Else
		p=1.0-p
		Color (1-p)*r3+p*r2, (1-p)*g3+p*g2, (1-p)*b3+p*b2
	EndIf
EndFunction
Kommentoikaa!
PS: Kokeilkaa tehdä peileistä "laatikko" jonka nurkasta säde menee sen sisään, tämä todistaa että cb EI ole HIDAS, Ennätys: 600 Heijastusta :)

Re: LazerRay - Peili moottori

Posted: Wed Jan 23, 2008 8:57 pm
by Harakka
Vau, yllättävän hieno systeemi. Samantapainen kuin Jaren SunBeam-peli. Ikävä kyllä säde ei tuntunut kimpoavan loivista kulmista.. Pistän kohta screenshotin esimerkkinä.

EDIT:
Image
Äh, tajusinkin että ihan oikein se toimii. Sädeteen viimeistä, ruudusta karkaavaa viivaa ei vaan piirretä. Paitsi tässä kuvassa se voisi vielä jatkua..? Tai sitten se karkaakin ulos alhaalta kahden viivan välistä. Syteemi olisi ehkä selkeämpi jos näytöltä karkaavat viivat piirrettäisiin.

EDIT2:
No on kyllä tosiaankin nopean tuntuinen. 959 heijastusta:
Image
Kannattaa kokeilla ottaa laserin väriefekti pois päältä niin editointi muuttuu helpommaksi (omasta mielestäni).

EDIT3: Jäin koukkuun. 3949 heijastusta: :P
Image

Re: LazerRay - Peili moottori

Posted: Wed Jan 23, 2008 9:25 pm
by JATothrim
^^ säteesi lähtee ulos näytöltä. Harkitsin kyllä pistää tarkistuksen että missä säde lähtee ulos näytöltä, vaan ajattelin pitää yksin kertaisena.
Ajattelin vielä jatkaa tätä pitemmälle, ja kenties tehdä jonkin asteinen peli.
Ja tällä se kyllä onnistuu:
Image
EDIT:

Ehh. Taisit lyödä kokeiluni, Mikä oli fps ?

EDIT:

Haa !! 6345 heijastusta.


Re: LazerRay - Peili moottori

Posted: Sat Feb 09, 2008 11:48 am
by Mickey
9985 heijastusta! Miten näihin viesteihin saa kuvia, pitääkö kuvat laittaa nettiin tai jotain? :oops:

Re: LazerRay - Peili moottori

Posted: Sat Feb 09, 2008 12:12 pm
by Harakka
Mickey wrote:9985 heijastusta! Miten näihin viesteihin saa kuvia, pitääkö kuvat laittaa nettiin tai jotain? :oops:
Jep, kuvat pitää ensin uploadata palveluun kuten imageshack.us tai imagevenue.com. Sieltä saa BBcode-koodin, joka kopioidaan viestiin.

Re: LazerRay - Peili moottori

Posted: Sat Feb 09, 2008 1:08 pm
by Raspful
Image

Itse pääsin VAIN 4009 heijastukseen.
Hienohan tämä oli ja koukuttava.


EDIT: Uusi ennätys 6782 kuvaa en jaksa laittaa.

Re: LazerRay - Peili moottori

Posted: Sun Feb 10, 2008 5:43 pm
by Pie2
Mukavaa ajanvietettä. Taisin vetää uuden ennätyksen...
Image
Perjaatteessahan tuo bugaa, mutta ennätys kuin ennätys ; P
EDIT: vetäsin 18k
EDIT2: 300k. Kuva on muokkaamaton.Fps johtuu Breakista(painoin alt+[space+prtscrn]). Score riippuu siitä kuinka kauan jaksaa odottaa ... Liekö tuo nyt sitten huijausta? ; P ... Koodi:

Code: Select all

    SCREEN 800,600
    Type Mirror
       Field x1 As Float
       Field y1 As Float
       Field x2 As Float
       Field y2 As Float
    EndType

    // globaalit LinerRay funktiolle
    Global IntersX as Float,IntersY As Float
    //Näitä Käytetään Peilien muokkauksessa
    SMD.Mirror=NULL
    SLP=0

    // lisätään 5 peiliä
    For i=1 To 5
       Mir.Mirror=New(Mirror)
       mir\x1=Rand(800)
       mir\y1=Rand(600)
       mir\x2=Rand(800)
       mir\y2=Rand(600)
    Next i

    //säteen sijainti, suunta
    RayX#=0
    RayY#=300
    RayA#=0

    Repeat
       //Peilien kääntely
       If MouseHit(1)
          For m.Mirror=Each Mirror
             If Distance(MouseX(),MouseY(),m\x1,m\y1)<10
                SMD=m
                SLP=1
                Exit
             ElseIf Distance(MouseX(),MouseY(),m\x2,m\y2)<10
                SMD=m
                SLP=2
                Exit
             Else
                SMD=NULL
                SLP=0
             EndIf
          Next m
       EndIf
       If MouseUp(1) Then SMD=NULL:SLP=0
       
       If SMD<>NULL And SLP<>0
          If SLP=1
             m\x1=MouseX()
             m\y1=MouseY()
          ElseIf SLP=2
             m\x2=MouseX()
             m\y2=MouseY()
          EndIf
       EndIf
       
       //pirretään peilit
       Color cbblue
       For mir.Mirror=Each Mirror
          Line mir\x1,mir\y1,mir\x2,mir\y2
          Circle  mir\x1-3,mir\y1-3,6
          Circle  mir\x2-3,mir\y2-3,6
       Next mir
       
       
       iRayX#=RayX#
       iRayY#=RayY#
       iRayA#=RayA#
       CountedHits=0
       
       //Säteen väritys (!!HIENO!! efekti !!)
       iColX=iColX+5
       If iColX<100
          ColX=iColX
       ElseIf iColX>100 And iColX<200
          ColX=0
       ElseIf iColX>200
          iColX=0
       EndIf
       ColorTriBlend(ColX,255,0,0, 0,0,10, 255,0,0)
       
       Color 200,0,0
       //Käydään Peilejä läpi, kunnes säde ei osu mihinkään.
       Repeat
       
          FoundHit=0
          Nearest#=-1
          nMir.Mirror=NULL
          //Etsitään lähin peili.
          For mir.Mirror=Each Mirror
             //Tarkistetaan törmäys.
             If LineRay_Intersect(mir\x1,mir\y1,mir\x2,mir\y2, iRayX+Cos(iRayA)*0.1, iRayY-Sin(iRayA)*0.1, iRayX+Cos(iRayA), iRayY-Sin(iRayA))
                FoundHit=1
                Dist#=Distance(IntersX,IntersY,iRayX,iRayY)
                If Nearest#>Dist# Or Nearest#=-1
                   Nearest#=Dist#
                   nMir=mir
                   HitX#=IntersX
                   HitY#=IntersY
                EndIf
             EndIf
          Next mir
          //jos löytyi, asetetaan uusi kulma ja paikka.
          If nMir<>NULL
             HitAngle#=GetAngle(HitX,HitY,iRayX,iRayY)
             MirAngle#=GetAngle(nmir\x1,nmir\y1,nmir\x2,nmir\y2)
             iRayA=MirAngle*2-180-HitAngle
             Line iRayX,iRayY,HitX,HitY
             iRayX=HitX
             iRayY=HitY
             CountedHits=CountedHits+1
             
          EndIf
          If KeyDown(57) Then Exit
       Until FoundHit=0
        Color 200,0,0
       
       Text 0,0,"FPS:"+FPS()
       Text 0,12,"Reflections: "+CountedHits
       If colx>40 then DrawScreen
    Forever



    // "muokattu" versio SDK:n Line_Intersect funktiosta.
    //( Intersection_CD#>1 ehto jätetty pois, funktion toiminta muuttui radikaalisti :) )
    Function LineRay_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
       Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
       Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)
       If Rd# = 0
          Return False
       Else
          Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)
          Intersection_AB# = Rn# / Rd#
          Intersection_CD# = Sn# / Rd#
          If Intersection_AB#>1  Or Intersection_AB#<0 Or Intersection_CD#<0 Then Return False
          IntersX = Ax# + Intersection_AB#*(Bx#-Ax#)
          IntersY = Ay# + Intersection_AB#*(By#-Ay#)
          Return True
       EndIf
    End Function

    Function ColorTriBlend(pros#, r1,g1,b1, r2,g2,b2, r3,g3,b3)
       p#=Float(pros)/100.0
       If 50.0<pros
          Color (1-p)*r1+p*r2, (1-p)*g1+p*g2, (1-p)*b1+p*b2
       Else
          p=1.0-p
          Color (1-p)*r3+p*r2, (1-p)*g3+p*g2, (1-p)*b3+p*b2
       EndIf
    EndFunction

Re: LazerRay - Peili moottori

Posted: Sun Feb 10, 2008 7:33 pm
by SPuntte
Hieno systeemi, tosin vähän tuntuu välillä bugaavan.

MUHAHA, ownasin kaikki enkat:
Image
+28k heijastusta :mrgreen:

Re: LazerRay - Peili moottori

Posted: Sun Feb 10, 2008 9:14 pm
by MaGetzUb
Mä sain uude oman enkan... Peilauksia oli 19,20k

Re: LazerRay - Peili moottori

Posted: Mon Feb 11, 2008 5:01 pm
by valscion
Pie2 wrote:300k. Kuva on muokkaamaton.Fps johtuu Breakista(painoin alt+[space+prtscrn]). Score riippuu siitä kuinka kauan jaksaa odottaa ... Liekö tuo nyt sitten huijausta? ; P
Missäs tuo kuva sitten on? Ja miksi tuon koodin laitoit, ihan samanlainen on kuin itse pelin tekijän.

Öfftöpik edit: Wuhuu 112 postausta! Melkeen kuin hätänumero :P

Re: LazerRay - Peili moottori

Posted: Mon Feb 11, 2008 6:54 pm
by Pie2
OonSuomesta wrote:
Pie2 wrote:300k. Kuva on muokkaamaton.Fps johtuu Breakista(painoin alt+[space+prtscrn]). Score riippuu siitä kuinka kauan jaksaa odottaa ... Liekö tuo nyt sitten huijausta? ; P
Missäs tuo kuva sitten on? Ja miksi tuon koodin laitoit, ihan samanlainen on kuin itse pelin tekijän.

Öfftöpik edit: Wuhuu 112 postausta! Melkeen kuin hätänumero :P
Näyttää siltä että sivusto, jolla hostasin kuvaa on alhaalla ;/.

Re: LazerRay - Peili moottori

Posted: Mon Feb 11, 2008 11:15 pm
by valscion
Pie2 wrote:Näyttää siltä että sivusto, jolla hostasin kuvaa on alhaalla ;/.
No nyt näkyy. On kyllä vähän xiit :D