2D Funktions-Sammelsurium
Übersicht

KrümelBetreff: 2D Funktions-Sammelsurium |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Ich hab hier mal eine Auswahl an 2D Algorithmen, die sich im Laufe der Zeit so angesammelt haben, zusammengestellt.
Eventuell hat der eine oder andere von euch ja noch ein paar nützliche Funktionen rumfliegen die er dieser Liste anhängen möchte. Code: [AUSKLAPPEN] Graphics 800,600,16,2 SetBuffer BackBuffer() ClsColor 255,255,255 ;Polygon Types: Type Polygon2D Field Line2D_Bank End Type Type Line2D ; Polygon Kanten Field P1.Point2D , P2.Point2D End Type Type Point2D ; Polygon Punkte Field X , Y End Type ;Globals für Rückgabewerte Global p_x1# , p_y1# , p_x2# , p_y2#, p_r# Function KreisTangente(x#,y# , cx#,cy#, r#) dx#=cx - x dy#=cy - y c# = Sqr(dx * dx + dy * dy) If c > r a# = Sqr(c*c - r*r) ac# = ACos(a / c) at# = ATan2(dx , dy) w1# = at + ac w2# = at - ac p_x1 = x + Sin(w1) * a p_y1 = y + Cos(w1) * a p_x2 = x + Sin(w2) * a p_y2 = y + Cos(w2) * a Return True Else Return False EndIf End Function Function PunktInKreis(x# , y# , cx# , cy# , r#) dx#=cx - x dy#=cy - y If (dx * dx + dy * dy) < (r * r) Return True Return False End Function Function PunktInRechteck(x# , y# , x1# , y1# , x2# ,y2#) If x < x1 Or x > x2 Or y < y1 Or y > y2 Return False Return True End Function Function PunktInPolygon(x# , y#) For p.Polygon2D=Each Polygon2D For o=0 To BankSize(p\Line2D_bank)-4 Step 4 l.Line2D = Object.Line2D(PeekInt(p\Line2D_bank , o)) If (l\P1\X-X) > 0 And (l\P2\X-X) <= 0 If ( (l\P1\Y-l\P2\Y) * (l\P1\X-X)) + ((l\P2\X-l\P1\X) * (l\P1\Y-Y)) < 0 Inside = Not Inside ElseIf (l\P1\X-X) <=0 And (l\P2\X-X) > 0 If ( (l\P1\Y-l\P2\Y) * (l\P1\X-X)) + ((l\P2\X-l\P1\X) * (l\P1\Y-Y)) >=0 Inside = Not Inside EndIf Next If Inside Return True Next Return False End Function Function LinieSchneidetKreis(x1# , y1# , x2# , y2# , cx# , cy# , r#) dx# = x2 - x1 dy# = y2 - y1 A# = dx * dx + dy * dy B# = 2.0 * (dx * (x1 - cx) + dy * (y1 - cy)) C# = (x1 - cx) * (x1 - cx) + (y1 - cy) * (y1 - cy) - (r * r) det# = B * B - 4.0 * A * C If (A <= 0.0000001) Or (det < 0) Then Return 0 ElseIf det = 0 Then t# = -B / (2.0 * A) p_x1 = x1 + t * dx p_y1 = y1 + t * dy Return 1 Else t1# = (-B + Sqr(det)) / (2.0 * A) t2# = (-B - Sqr(det)) / (2.0 * A) If (t1 >= 0 And t1 <= 1) i1 = 1 p_x1 = x1 + t1 * dx p_y1 = y1 + t1 * dy EndIf If (t2 >= 0 And t2 <= 1) i2 = 1 If i1 = 0 p_x1 = x1 + t2 * dx p_y1 = y1 + t2 * dy Return 1 Else p_x2 = x1 + t2 * dx p_y2 = y1 + t2 * dy Return 2 EndIf EndIf If i1 = 1 Return 1 End If End Function Function LinieSchneidetRechteck(x1#,y1#, x2#,y2# , rx1#,ry1#,rx2#,ry2#) If LinieSchneidetLinie(x1,y1,x2,y2 , rx1,ry1 , rx2,ry1) p = 1 : xa# = p_x1 : ya# = p_y1 EndIf If LinieSchneidetLinie(x1,y1,x2,y2 , rx2,ry1 , rx2,ry2) If p = 1 p_x2 = p_x1 : p_y2 = p_y1 : p_x1 = xa : p_y1 = ya Return 2 p = 1 : xa# = p_x1 : ya# = p_y1 EndIf If LinieSchneidetLinie(x1,y1,x2,y2 , rx2,ry2 , rx1,ry2) If p = 1 p_x2 = p_x1 : p_y2 = p_y1 : p_x1 = xa : p_y1 = ya Return 2 p = 1 : xa# = p_x1 : ya# = p_y1 EndIf If LinieSchneidetLinie(x1,y1,x2,y2 , rx1,ry2 , rx1,ry1) If p = 1 p_x2 = p_x1 : p_y2 = p_y1 : p_x1 = xa : p_y1 = ya Return 2 p = 1 : xa# = p_x1 : ya# = p_y1 EndIf If p = 1 p_x1 = xa : p_y1 = ya : Return 1 End Function Function LinieSchneidetLinie(x0#,y0#,x1#,y1#,x2#,y2#,x3#,y3#) d#=(y3-y2)*(x1-x0)-(x3-x2)*(y1-y0) If d = 0 Return False ua#=((x3-x2)*(y0-y2)-(y3-y2)*(x0-x2)) / d ub#=((x1-x0)*(y0-y2)-(y1-y0)*(x0-x2)) / d If (ua>=0 And ua<=1) And (ub>=0 And ub<=1) p_x1=x0+ua*(x1-x0) p_y1=y0+ua*(y1-y0) Return True Else Return False EndIf Return False End Function Function StrahlSchneidetStrahl(x0#,y0#,x1#,y1#,x2#,y2#,x3#,y3#) d#=(y3-y2)*(x1-x0)-(x3-x2)*(y1-y0) If d = 0 Return False ua#=((x3-x2)*(y0-y2)-(y3-y2)*(x0-x2)) / d ub#=((x1-x0)*(y0-y2)-(y1-y0)*(x0-x2)) / d p_x1=x0+ua*(x1-x0) p_y1=y0+ua*(y1-y0) Return True End Function Function Umkreis(x0# , y0# , x1# , y1# , x2# , y2#) d#=(2.0*(-x2*y1+x2*y0+x0*y1+x1*y2-x0*y2-x1*y0)) If d <> 0 my# = (-x1*x2 + x2*x2 + x0*x1 - x0*x2 - y1*y2 + y2*y2 + y0*y1 - y0*y2) / d p_x1# = 0.5 * x0 + 0.5 * x1 - my * y1 + my * y0 p_y1# = 0.5 * y0 + 0.5 * y1 + my * x1 - my * x0 p_r# = Sqr((x0 - p_x1) * (x0 - p_x1) + (y0 - p_y1) * (y0 - p_y1)) Return True Else Return False EndIf End Function Function PunktInKreisabschnitt(x#,y# , cx#,cy# , r# , dir# , ang#) dx = cx - x dy = cy - y If ( dx * dx + dy * dy) > (r * r) Return False a = Abs(ATan2(dx , dy) - dir + 180) If a > 180 a = 360 - a If a <= ang * 0.5 Return True EndIf End Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Funktionen Testen ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; pl.Polygon2d = New Polygon2d pl\Line2D_Bank = CreateBank(16*4) For t=0 To 15 pt2.point2d = pt1.point2d pt1.point2d = New point2d pt1\x=700 + Sin(t*20)*Rand(20,80) : pt1\y= 150 + Cos(t*20)*Rand(20,80) If t > 0 li.line2d = New line2d : li\p1 = pt1 : li\p2 = pt2 PokeInt pl\Line2D_Bank , t*4 - 4 , Handle(li) Else pt0.point2d=pt1 EndIf Next li.line2d = New line2d : li\p1 = pt1 : li\p2 = pt0 PokeInt pl\Line2D_Bank,15 * 4 , Handle(li) cx# = 200 : cy# = 200 : r = 100 x1# = 650 : y1# = 400 x2# = 550 : y2# = 550 x3# = 550 : y3# = 150 x4# = 50 : y4# = 550 x5# = 50 : y5# = 320 Rx1# = 350 : Ry1# = 350 Rx2# = 450 : Ry2# = 450 sx# = 450 : sy# = 150 : a# = 250 : d# = 15 : r2# = 75 While Not KeyHit(1) x=MouseX() y=MouseY() Color 0 , 0 , 0 Oval cx-r,cy-r,r*2,r*2,0 Oval x -4 , y -4 , 8,8,0 Oval x1-4 , y1-4 , 8,8,0 Oval x2-4 , y2-4 , 8,8,0 Rect Rx1,Ry1,Rx2-Rx1,Ry2-Ry1,0 Line x1,y1,x3,y3 Line sx,sy, sx + Sin(d-a*0.5)*r2, sy + Cos(d-a*0.5)*r2 Line sx,sy, sx + Sin(d+a*0.5)*r2, sy + Cos(d+a*0.5)*r2 For w = d - a * 0.5 To d + a * 0.5 Plot sx + Sin(w) * r2 , sy + Cos(w) * r2 Next For l.Line2D = Each Line2D Line l\P1\X , l\P1\Y , l\P2\X , l\P2\Y Next Color 128,250,100 For yy = -1 To 1 For xx = -1 To 1 Line x+xx ,y+yy ,x4+xx,y4+yy Next Next If KreisTangente(x,y, cx,cy ,r) Color 0,0,255 Line x , y , p_x1 , p_y1 Line x , y , p_x2 , p_y2 EndIf If PunktInKreis(x,y , cx,cy , r) Color 255,0,0 Oval x-6 , y-6 , 12 , 12 , 1 EndIf If PunktInKreisabschnitt(x , y , sx , sy , r2 , d , a) Color 255,0,0 Oval x-6 , y-6 , 12 , 12 , 1 EndIf If PunktInRechteck(x,y , rx1,ry1,rx2,ry2) Color 255,0,0 Oval x-6 , y-6 , 12 , 12 , 1 EndIf If PunktInPolygon(x,y) Color 255,0,0 Oval x-6 , y-6 , 12 , 12 , 1 EndIf If Umkreis(x1,y1,x2,y2, x , y) Color 0,128,255 Oval p_x1 - p_r , p_y1 - p_r , p_r*2 , p_r*2 , 0 Text p_x1 , p_y1 , "+" , 1 , 1 EndIf ret = LinieSchneidetKreis(x,y, x4,y4 , cx,cy , r) If ret > 0 Color 255,0,255 Oval p_x1 - 5 , p_y1 - 5 , 10 , 10 If ret = 2 Oval p_x2 - 5 , p_y2 - 5 , 10 , 10 EndIf ret = LinieSchneidetRechteck(x,y, x4,y4 , rx1,ry1,rx2,ry2) If ret > 0 Color 255,0,255 Oval p_x1 - 5 , p_y1 - 5 , 10 , 10 If ret = 2 Oval p_x2 - 5 , p_y2 - 5 , 10 , 10 EndIf If LinieSchneidetLinie(x,y , x4,y4 , x1,y1 , x3,y3) Color 255,0,255 Oval p_x1 - 5, p_y1 - 5, 10 , 10 EndIf Flip 0 Cls Wend |
||
Mashed Crashed |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Ich hätte da nur eine kleine Anfügung: Eine Mouse-Rect Collisions Function
Ist zwar ent grafisch, aber das erspart einem bei einigen Sachen ne Menge tipp Arbeit Code: [AUSKLAPPEN] Function MouseCollide(x_start,y_start,breite,hoehe)
If MouseX() > x_start And MouseX() < x_start+breite Then If MouseY() > y_start And MouseY() < y_start+hoehe Then Return 1 EndIf EndIf End Function kann man eifnach in eine if abfragen einbauen If MouseCollide(x,y,b,h) = 1 Then ... |
||
![]() |
Smily |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ich glaube, dass
Code: [AUSKLAPPEN] Rectscollide(rectX,rectY,rectW,rectH,mousex(),mousey(),1,1) besser ist ^^ Gruß Smily0412 |
||
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets "Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!" stummi.org |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group