Überlappende Rechtecke in nicht mehr überlappende zerlegen
Übersicht
BlitzBasic Codearchiv
walskiEhemaliger AdminBetreff: Überlappende Rechtecke in nicht mehr überlappende zerlegen |
 So, Feb 22, 2004 18:29Antworten mit Zitat 
|
|
|---|---|---|
Ich habe dafür recht lang gebraucht, was aber wahrscheinlich eher an einer gesteigerten Dummheit meinerseits, als an einem komplexen Problem ansich liegen dürfte 
Aber naja, da das Niveau hier ja eh nicht allzu hoch ist, poste ich es trotzdem mal. Die Ausgangsposition war folgende: Man hat mehrere Rechtecke die sich überschneiden und diese sollen nun in mehrere Rechtecke zerlegt werden, die sich nicht mehr überschneiden. Das ist zum Beispiel gut, wenn man die Fläche von solch einer "Rechteck Menge" errechnen will, ohne die überlappenden Flächen eben 2,3,4 oder 5 mal zu berechnen. Meine Lösung ist nicht sehr sauber, nicht sehr kommentier und schon gar nicht optimiert! Es entstehen VIEL zu viele Rechtecke, aber ich hatte keine Lust mehr den Schreibkram zu machen und mir langt es so. Wenn es dennoch jemand optimeirt, wäre ich super dankbar! Hier jetz aber der (wie gesagt, miserabel kommentierte) Code: Code: [AUSKLAPPEN] ; just a tiny RectIntersection Demo ; (c) 2004 by walski ;Rect Type construct Type Ground Field x,y Field width,height End Type ;SAMPLE Const screen_w = 800, screen_h = 600, screen_d = 32, screen_m = 2 Graphics screen_w,screen_h,screen_d,screen_m SetBuffer BackBuffer() timer = CreateTimer(100) SeedRnd MilliSecs() DragMode = 0 While Not KeyHit(1) Cls If DragMode Then If Not MouseDown(1) GroundSpace.Ground = New Ground mX = MouseX() mY = MouseY() If RBx < mX Then GroundSpace\width = mX - RBx GroundSpace\x = RBx Else GroundSpace\width = RBx - mX GroundSpace\x = mX EndIf If RBy < mY Then GroundSpace\height = mY - RBy GroundSpace\y = RBy Else GroundSpace\height = RBy - mY GroundSpace\y = mY EndIf DragMode = 0 Else Rect2 RBx,RBy,MouseX() - RBx,MouseY() - RBy,0 EndIf Else If MouseDown(1) DragMode = 1 RBx = MouseX() RBy = MouseY() EndIf EndIf DrawGround() DoIntersection() Flip() Wend ;SAMPLE END ;Draw any Rect Function DrawGround() For GroundSpace.ground = Each Ground Rect2 GroundSpace\x,GroundSpace\y,GroundSpace\width,GroundSpace\height,1 Next Text 10,10,i End Function ;This is detecting overlaps on any rect and then intersect the specific rect until there are no more overlaps Function DoIntersection() ;Outer Loop OuterSpace.Ground = First Ground For OuterSpace.Ground = Each Ground ;Inner Loop InnerSpace.Ground = First Ground For InnerSpace.Ground = Each Ground If InnerSpace <> OuterSpace And RectsOverlap(OuterSpace\x,OuterSpace\y,OuterSpace\width,OuterSpace\height,InnerSpace\x,InnerSpace\y,InnerSpace\width,InnerSpace\height) Then ;Setting the point of intersection coordinates If OuterSpace\x > InnerSpace\x Then SPx = OuterSpace\x If InnerSpace\x + InnerSpace\width <= OuterSpace\x + OuterSpace\width Then SPwidth = (InnerSpace\x + InnerSpace\width) - OuterSpace\x Else SPwidth = InnerSpace\width If SPx + SPwidth > OuterSpace\x + OuterSpace\width Then SPwidth = OuterSpace\x + OuterSpace\width - SPx EndIf EndIf Else SPx = InnerSpace\x If (InnerSpace\x + InnerSpace\width) >= (OuterSpace\x + OuterSpace\width) Then SPwidth = (OuterSpace\x + OuterSpace\width) - InnerSpace\x Else SPwidth = InnerSpace\width EndIf EndIf If OuterSpace\y > InnerSpace\y Then SPy = OuterSpace\y If (InnerSpace\y + InnerSpace\height) >= (OuterSpace\y + OuterSpace\height) Then SPheight = (InnerSpace\y + InnerSpace\height) - OuterSpace\y If SPy + SPheight > OuterSpace\y + OuterSpace\height Then SPheight = (OuterSpace\y + OuterSpace\height) - SPy EndIf Else SPheight = InnerSpace\y + InnerSpace\height - SPy EndIf Else SPy = InnerSpace\y If (InnerSpace\y + InnerSpace\height) >= (OuterSpace\y + OuterSpace\height) Then SPheight = (OuterSpace\y + OuterSpace\height) - InnerSpace\y If SPy + SPheight > OuterSpace\y + OuterSpace\height Then SPheight = (OuterSpace\y + OuterSpace\height) - SPy EndIf Else SPheight = InnerSpace\height EndIf EndIf ;Debug Mode If DebugMode Then Color 255,0,0 Rect OuterSpace\x,OuterSpace\y,OuterSpace\width,OuterSpace\height,1 Color 0,0,255 Rect InnerSpace\x,InnerSpace\y,InnerSpace\width,InnerSpace\height,1 Color 0,255,0 Rect SPx,SPy,SPwidth,SPheight,1 Flip() Repeat Until MouseHit(2) Color 255,255,255 EndIf ;Intersect the current collision IntersectRect OuterSpace,SPx,SPy,SPwidth,SPheight ;Jump to the next "Outer Rect" because the current one was deleted by the Intersect Routine Goto Begin EndIf Next .Begin Next End Function ;This function intersects an specific rect. R2 gives the data of the "overlapped area" Function IntersectRect(R1.Ground,R2x,R2y,R2w,R2h) If (R2x > R1\x) Then NewSpace.Ground = New Ground NewSpace\x = R1\x NewSpace\y = R1\y NewSpace\width = R2x - R1\x NewSpace\height = R1\height EndIf If (R2x + R2w < R1\x + R1\width) Then NewSpace.Ground = New Ground NewSpace\x = R2x + R2w NewSpace\y = R1\y NewSpace\width = (R1\x + R1\width) - (R2x + R2w) NewSpace\height = R1\height EndIf If (R2y > R1\y) Then NewSpace.Ground = New Ground NewSpace\x = R2x NewSpace\y = R1\y NewSpace\width = R2w NewSpace\height = R2y - R1\y EndIf If (R2y + R2h) < (R1\y + R1\height) Then NewSpace.Ground = New Ground NewSpace\x = R2x NewSpace\y = R2y + R2h NewSpace\width = R2w NewSpace\height = (R1\y + R1\height) - (R2y + R2h) EndIf Delete R1 End Function ;This function corrects the problem with negative widths and heights while using rect Function Rect2(x,y,width,height,solid=0) If width < 0 Then x = x + width width = Abs(width) EndIf If height < 0 Then y = y + height height = Abs(height) EndIf Rect x,y,width,height,solid End Function walski |
||
| buh! | ||
Übersicht
BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group