Geradengleichung/Schnittpunkt berechnen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Geradengleichung/Schnittpunkt berechnen

Beitrag 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
Zuletzt geändert von diceman am 12.03.2018 22:43, insgesamt 8-mal geändert.
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Geradengleichung/Schnittpunkt berechnen

Beitrag 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
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Geradengleichung/Schnittpunkt berechnen

Beitrag von diceman »

Es hatten sich oben ein paar Fehler eingeschlichen, da ich den Code mehrfach überarbeitet habe.
Jetzt sollte aber alles laufen. :)
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Geradengleichung/Schnittpunkt berechnen

Beitrag 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:
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Geradengleichung/Schnittpunkt berechnen

Beitrag 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. :)
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Geradengleichung/Schnittpunkt berechnen

Beitrag 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
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Antworten