Aktuelle Zeit: 12.12.2018 08:56

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 6 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 12.03.2018 21:44 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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:
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

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Zuletzt geändert von diceman am 12.03.2018 22:43, insgesamt 8-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 12.03.2018 21:46 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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:
;{ 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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 12.03.2018 22:36 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 13.03.2018 19:23 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
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:


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 13.03.2018 19:36 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Geradengleichung/Schnittpunkt berechnen
BeitragVerfasst: 15.03.2018 17:54 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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:
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.


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 6 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: Lord und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye