Seite 1 von 1

Geradengleichung/Schnittpunkt berechnen

Verfasst: 12.03.2018 21:44
von diceman
Ich arbeite in meinem kleinen Roguelike-Projekt derzeit an Fernkampf-Funktionalität, dafür mußte ich etwas Schulwissen über Geradengleichungen wieder herauskramen.
Das mag für manch einen keine große Sache sein, mich hats aber doch ins Schleudern gebracht. :oops:
Vielleicht hilfts ja noch jemandem. :)
Das folgende Snippet zeichnet eine Strecke nur mittels Punkten auf der x-Achse, die in die nach y aufgelöste Geradengleichung eingesetzt werden (Zweipunktform).
Je krasser die Steigung, umso mehr Lücken zwischen den Punkten - logisch. ;-)

Code: Alles auswählen

EnableExplicit

Declare findPoints()
Declare drawLine()
Declare lineEquation(x0,y0,x1,y1,x)

#xRes = 800
#yRes = 600
Global Dim x(1)
Global Dim y(1)

InitSprite()
Global screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"Geradengleichung (Zweipunkteform) --- Press ESC to Exit ---",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
InitKeyboard()


findPoints()
drawLine()


Procedure findPoints()
	Protected s
	
	For s = 0 To 1
		x(s) = Random(#xRes-1,1)
		y(s) = Random(#yRes-1,1)
	Next
	If x(0) > x(1) 		;For/Next-Schleife zählt nach oben!
		Swap x(0), x(1)
		Swap y(0), y(1)
	EndIf
EndProcedure


Procedure drawLine()
	Protected x.i, y.f
	
	If StartDrawing(ScreenOutput())
		For x = x(0) To x(1)
			If x(0) <> x(1) ;Division durch Null abfangen!!!
				y = lineEquation(x(0),y(0),x(1),y(1),x)
				Plot(x,y)
			Else
				Debug "Steigung ist unendlich!"
				LineXY(x(0),y(0),x(1),y(1))
			EndIf
		Next
		StopDrawing()
	EndIf
	FlipBuffers()
	Repeat
		ExamineKeyboard()
		WaitWindowEvent(1)
	Until KeyboardPushed(#PB_Key_Escape)
EndProcedure


Procedure lineEquation(x0,y0,x1,y1,x)
	Protected num.f, denom.f, y.f
	
	num = y1-y0
	denom = x1-x0
	y = ((num/denom) * (x-x0)) + y0
	ProcedureReturn y
EndProcedure

Re: Geradengleichung/Schnittpunkt berechnen

Verfasst: 12.03.2018 21:46
von diceman
Verwandtes Thema, daher packe ich das mit in diesen Thread:
Das zweite Snippet berechnet den Schnittpunkt zweier Strecken, bzw. gibt Feedback, ob der Schnittpunkt außerhalb der Streckensegmente liegt (oder im Unendlichen = gleiche Steigung).

Code: Alles auswählen

;{ DECLARATIONS
Declare loop()
Declare createWindow(x,y,exeName.s)
Declare getLineIntersection(x1,y1,x2,y2,x3,y3,x4,y4)
;}


Global Dim x(4) ;x0, y0 = Schnittpunkt
Global Dim y(4)



#xRes = 800
#yRes = 600

InitSprite()
screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"Schnittpunkt zweier Strecken --- Press ESC to Exit ---",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
InitKeyboard()


For g = 1 To 4
	x(g) = Random(#xRes)
	y(g) = Random(#yRes)
Next

getLineIntersection(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4))



loop()

Procedure loop()
	Protected quit
	
	If StartDrawing(ScreenOutput())
		LineXY(x(1),y(1),x(2),y(2))
		LineXY(x(3),y(3),x(4),y(4))
		DrawingMode(#PB_2DDrawing_Outlined)
		Circle(x(0),y(0),5)
		StopDrawing()
	EndIf
	FlipBuffers()
	
	Repeat
		ExamineKeyboard()
		quit = KeyboardPushed(#PB_Key_Escape)
		WaitWindowEvent(1)
	Until quit
EndProcedure


Procedure getLineIntersection(x1,y1,x2,y2,x3,y3,x4,y4)
	Protected a1, a2, b1, b2, c1, c2
	Protected result
	
	a1 = y2-y1
	b1 = x1-x2
	c1 = (x2*y1) - (x1*y2) ;Geradengleichung von Strecke 1 (x1,y1,x2,y2)
	
	a2 = y4-y3
	b2 = x3-x4
	c2 = (x4*y3) - (x3*y4) ;Geradengleichung von Strecke 2 (x3,y3,x4,y4)
	
	result = (a1*b2) - (a2*b1)
	If result = 0
		Debug "No Intersection (Parallel Lines)"
		ProcedureReturn -1
	EndIf
	
	;Schnittpunkt berechnen
	x(0) = ((b1*c2) - (b2*c1)) / result
	y(0) = ((a2*c1) - (a1*c2)) / result
	
	;Schnittpunkt der Streckenabschnitte nur, wenn x(0),y(0) zwischen den Endpunkten beider Linien liegt
	If (x1 < x(0) And x2 < x(0)) Or (x1 > x(0) And x2 > x(0)) Or (y1 < y(0) And y2 < y(0)) Or (y1 > y(0) And y2 > y(0)) Or
		   (x3 < x(0) And x4 < x(0)) Or (x3 > x(0) And x4 > x(0)) Or (y3 < y(0) And y4 < y(0)) Or (y3 > y(0) And y4 > y(0))
		Debug "No Segment Intersection"
		ProcedureReturn 0
	EndIf

	
	Debug "Intersection: "+Str(x(0))+","+Str(y(0))
	ProcedureReturn 1
EndProcedure

Re: Geradengleichung/Schnittpunkt berechnen

Verfasst: 12.03.2018 22:36
von diceman
Es hatten sich oben ein paar Fehler eingeschlichen, da ich den Code mehrfach überarbeitet habe.
Jetzt sollte aber alles laufen. :)

Re: Geradengleichung/Schnittpunkt berechnen

Verfasst: 13.03.2018 19:23
von ccode_new
Sehr schön,

mathematisch passt es.

Was man noch ergänzen könnte wäre: Ob sich zwei Linien durch ihre Dicke überlappen. Dafür würde man aber die korrekte Liniendicke benötigen.

Das ist aber eigentlich auch insgesamt nicht von belangen.

Ich hoffe das dein Projekt gut voranschreitet.

:allright:

Re: Geradengleichung/Schnittpunkt berechnen

Verfasst: 13.03.2018 19:36
von diceman
Könnte man sicher noch sauberer programmieren, z.B. mit gebündelten Variablen (habe dazu bereits eine hilfreiche PM erhalten), aber erstmal gings mir natürlich darum, daß das "vong matematik her" einwandfrei läuft und korrekte Ergebnisse liefert. :)
Habe außerdem den Code, welcher eine Gerade anhand von Punkten zeichnet, noch etwas optimiert; bin bis morgen auf der Arbeit (Bereitschaftsdienst), dann poste ich ein Update ... und zwar wird jetzt noch überprüft, ob der Abstand zwischen den x-Koordinaten größer ist als der Abstand zwischen den y-Koordinaten - wenn ja, wird die Geradengleichung nicht nach y aufgelöst, sondern nach x! Dadurch erhält man tatsächlich in allen Raumesrichtungen schöne durchgezogene Linien (ein weiterer Check war hier nötig, ob y1 > y0, damit die For-Next-Schleife in die richtige Richtung zählt).

Was mein Projekt angeht, denke ich mal, daß ich bis morgen den Fernkampf auf die Kette bekommen habe - mechanisch/rechnerisch funktioniert das schon (bei freier Schußbahn kann man das Monster aus der Distanz "totklicken"), nur muß jetzt noch ein Projektil in die entsprechende Richtung fliegen, und dafür brauche ich genau diese Funktion. :)

Re: Geradengleichung/Schnittpunkt berechnen

Verfasst: 15.03.2018 17:54
von diceman
Hier ist die überarbeitete und verbesserte Version der Zweipunktform (Strecke zeichnen nur mit Punkten) - eine Division durch Null kann nicht mehr stattfinden, und auch bei extrem steilen Geraden wird diese unterbrechungslos gezeichnet - der Trick liegt darin, daß vorm Zeichnen einmal die Länge der x/y-Achsen des umschließenden Rechteckes geprüft, und dann eventuell die Gleichung nach x aufgelöst wird, anstatt standardmäßig nach y.

Code: Alles auswählen

EnableExplicit

Declare findPoints()
Declare drawLine()
Declare lineEquation(x0,y0,x1,y1,var,solveY)

#xRes = 800
#yRes = 600
Global Dim x(1)
Global Dim y(1)
Global screen

If InitSprite()
	screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"Geradengleichung (Zweipunkteform) --- Press ESC to Exit ---",#PB_Window_ScreenCentered)
	If OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
		InitKeyboard()
		InitMouse()
	EndIf
EndIf


findPoints()
drawLine()


Procedure findPoints()
	Protected s
	
	For s = 0 To 1
		x(s) = Random(#xRes-1,1)
		y(s) = Random(#yRes-1,1)
	Next
	
	If StartDrawing(ScreenOutput())
		LineXY(x(0),y(0),x(1),y(1),RGB(255,0,0))
		StopDrawing()
	EndIf
	
	If x(0) >= x(1) 		;For/Next-Schleife zählt nach oben!
		Swap x(0), x(1)
		Swap y(0), y(1)
	EndIf
EndProcedure


Procedure drawLine()
	Protected x, y, result.f
	
	If StartDrawing(ScreenOutput())
		
		If Abs(x(0)-x(1)) >= Abs(y(0)-y(1))
			For x = x(0) To x(1)
				result = lineEquation(x(0),y(0),x(1),y(1),x,1)
				Plot(x,result)
			Next
		Else
			If y(0) <= y(1)
				For y = y(0) To y(1)
					result = lineEquation(x(0),y(0),x(1),y(1),y,0)
					Plot(result,y)
				Next
			Else
				For y = y(1) To y(0)				
					result = lineEquation(x(0),y(0),x(1),y(1),y,0)
					Plot(result,y)
				Next
			EndIf
				
		EndIf
		StopDrawing()
	EndIf
	FlipBuffers()
	Repeat
		ExamineKeyboard()
		WaitWindowEvent(1)
	Until KeyboardPushed(#PB_Key_Escape)
EndProcedure


Procedure lineEquation(x0,y0,x1,y1,var,solveY)
	Protected num.f, denom.f, result.f
	
	If solveY
		num = y1-y0
		denom = x1-x0
		result = ((num/denom) * (var-x0)) + y0
	Else
		num = x1-x0
		denom = y1-y0
		result = ((num/denom) * (var-y0)) + x0
	EndIf
	ProcedureReturn result
EndProcedure