2D-Drawing Kollisionsfunktionen

mk-soft · Beitrag von **mk-soft** » 03.03.2015 15:31

Hi,

aus einer Anfrage Endstand folgende Kollisionsfunktionen für 2D-Drawing zustande.

Update v1.1
Jetzt auch mit Hintergrundbild

Update v1.2
- Als Module geändert
- Bugfix Background Kollision

IncludeFile "Modul-2D-Collision.pbi"

Code: Alles auswählen

;-TOP

; ***************************************************************************************

; Comment   : Collision Functions for 2D-Drawing as Module
; Author    : mk-soft
; File      : 2D-Collsion.pbi
; Version   : v1.2
; Date      : 07.03.2015
; Update    : 11.06.2017

; ***************************************************************************************

DeclareModule Collision
  
  #CollisionColorDifferent = 0
  #CollisionColorEqual = 1
  #CollisionColorBackground = 2
  
  Declare CollisionCreateBackground(x, y, dx, dy)
  Declare CollisionBox(x, y, dx, dy, backcolor, mode=#CollisionColorDifferent)
  Declare CollisionCircle(x, y, r, backcolor, mode=#CollisionColorDifferent)
  
  Macro CollisionFreeBackground(buffer)
    FreeMemory(buffer) : buffer = 0
  EndMacro

EndDeclareModule

Module Collision
  
  EnableExplicit
  
  Structure udtBackground
    x0.i
    y0.i
    x1.i
    y1.i
    dx.i
    dy.i
    color.l[0]
  EndStructure

  Global IsCollision, CollisionBackColor, *CollisionBackground.udtBackground
    
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionCreateBackground(x, y, dx, dy)
    
    Protected *buffer.udtBackground, size
    Protected index, xi, yi, x0, x1, y0, y1
    
    size = dx * dy * 4 + OffsetOf(udtBackground\color)
    *buffer = AllocateMemory(size)
    If Not *buffer
      ProcedureReturn 0
    EndIf
    
    x1 = x + dx - 1
    y1 = y + dy - 1
      
    With *buffer
      
      \x0 = x
      \y0 = y
      \x1 = x1
      \y1 = y1
      \dx = dx
      \dy = dy
      
      index = 0
      For yi = y To y1
        For xi = x To x1
          \color[index] = Point(xi,yi) & $FFFFFF
          index + 1
        Next
      Next
    EndWith
    
    ProcedureReturn *buffer
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionCallbackDifferent(x, y, SourceColor, TargetColor)
    
    Static Color
    
    If IsCollision
      ProcedureReturn TargetColor
    EndIf
    
    Color = TargetColor & $FFFFFF
    
    If Color <> CollisionBackColor
      IsCollision = #True
    EndIf
    ProcedureReturn TargetColor
    
  EndProcedure
    
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionCallbackEqual(x, y, SourceColor, TargetColor)
    
    Static Color
    
    If IsCollision
      ProcedureReturn TargetColor
    EndIf
    
    Color = TargetColor & $FFFFFF
    
    If Color = CollisionBackColor
      IsCollision = #True
    EndIf
    ProcedureReturn TargetColor
    
  EndProcedure
    
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionCallbackBackGround(x, y, SourceColor, TargetColor)
    
    Static index, color
    
    If IsCollision
      ProcedureReturn TargetColor
    EndIf
    
    With *CollisionBackground
      If x < \x0 Or x > \x1 Or y < \y0 Or y > \y1
        ProcedureReturn TargetColor
      EndIf
      index = \dx * (y-\y0) + (x-\x0)
      
      color = TargetColor & $FFFFFF
      If color <> \color[index]
        IsCollision = #True
      EndIf
      
    EndWith
    
    ProcedureReturn TargetColor
    
  EndProcedure
    
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionBox(x, y, dx, dy, backcolor, mode=#CollisionColorDifferent)
    
    IsCollision = #False
    
    DrawingMode(#PB_2DDrawing_CustomFilter)
    
    Select mode
      Case #CollisionColorDifferent
        CollisionBackColor = BackColor
        CustomFilterCallback(@CollisionCallbackDifferent())
        
      Case #CollisionColorEqual
        CollisionBackColor = BackColor
        CustomFilterCallback(@CollisionCallbackEqual())
        
      Case #CollisionColorBackground
        *CollisionBackground = backcolor
        CustomFilterCallback(@CollisionCallbackBackGround())
        
    EndSelect
    
    Box(x, y, dx, dy, 0)
    
    DrawingMode(#PB_2DDrawing_Default)      
    
    ProcedureReturn IsCollision
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure CollisionCircle(x, y, r, backcolor, mode=#CollisionColorDifferent)
    
    IsCollision = #False
    
    DrawingMode(#PB_2DDrawing_CustomFilter)      
    
    Select mode
      Case #CollisionColorDifferent
        CollisionBackColor = BackColor
        CustomFilterCallback(@CollisionCallbackDifferent())
        
      Case #CollisionColorEqual
        CollisionBackColor = BackColor
        CustomFilterCallback(@CollisionCallbackEqual())
        
      Case #CollisionColorBackground
        *CollisionBackground = backcolor
        CustomFilterCallback(@CollisionCallbackBackGround())
        
    EndSelect
    
    Circle(x, y, r, 0)
    
    DrawingMode(#PB_2DDrawing_Default)      
    
    ProcedureReturn IsCollision
    
  EndProcedure
  
EndModule

; ***************************************************************************************

Example 3

Code: Alles auswählen

;-TOP

; ***************************************************************************************

; Comment   : Collision Functions for 2D-Drawing Example
; Author    : mk-soft
; File      : Example 3
; Version   : v1.0
; Date      : 07.03.2015

; ***************************************************************************************

EnableExplicit

IncludeFile "Modul-2D-Collision.pbi"

UseModule Collision

EnableExplicit

; Fenster
Enumeration
  #Main
EndEnumeration

; Gadgets
Enumeration
  #Canvas
EndEnumeration

; Pictures
Enumeration
  #pic0
  #pic1
EndEnumeration

Global exit

Procedure LoadPictures()

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  LoadImage(#pic0, #PB_Compiler_Home + "examples\sources\Data\Background.bmp")
  LoadImage(#pic1, #PB_Compiler_Home + "examples\sources\Data\PurebasicLogo.bmp")
CompilerElse
  LoadImage(#pic0, #PB_Compiler_Home + "examples/sources/Data/Background.bmp")
  LoadImage(#pic1, #PB_Compiler_Home + "examples/sources/Data/PurebasicLogo.bmp")
CompilerEndIf

EndProcedure : LoadPictures()


Procedure Draw()
  
  Static *background
  
  Protected x, y, dx, dy, r, c, c2
  Protected backcolor, color
  
  backcolor = RGB(192,192,192)
  
  dx = GadgetWidth(#Canvas)
  dy = GadgetHeight(#Canvas)
  
  If StartDrawing(CanvasOutput(#Canvas))
    ; Draw BackgroundImage
    DrawImage(ImageID(#pic0), 0, 0, dx, dx)
    
    ; Copy BackgroundImage to compare buffer
    If Not *background
      *background = CollisionCreateBackground(0, 0, dx, dy)
    EndIf
    
    Repeat
      x = Random(dx-1)
      y = Random(dy-1)
      r = Random(20)
      color = RGB(Random(255), Random(255), Random(255))    
      If Not CollisionCircle(x, y, r+2, *background, #CollisionColorBackground)
        Circle(x, y, r, color)
        c + 1
      EndIf
      c2 + 1
    Until c > 2000 Or c2 > 10000
    StopDrawing()
    
  EndIf
  
EndProcedure

Procedure Main()
  
  Protected Event
  
  If OpenWindow(#Main, #PB_Any, #PB_Any, 800, 600, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    CanvasGadget(#Canvas, 5, 5, WindowWidth(#Main) - 10, WindowHeight(#Main) - 10)
    
    Draw()
    
    Repeat
      Event = WaitWindowEvent()
      
      Select Event
          
        Case #PB_Event_CloseWindow
          exit = #True
          
      EndSelect
      
    Until exit
    
  EndIf
    
EndProcedure : Main()

Example 4

Code: Alles auswählen

;-TOP

; ***************************************************************************************

; Comment   : Collision Functions for 2D-Drawing Example
; Author    : mk-soft
; File      : Example 4
; Version   : v1.0
; Date      : 03.03.2015

; ***************************************************************************************

EnableExplicit

IncludeFile "Modul-2D-Collision.pbi"

UseModule Collision

; Fenster
Enumeration
  #Main
EndEnumeration

; Gadgets
Enumeration
  #Canvas
EndEnumeration

Global exit

Procedure Draw()
  
  Protected x, y, dx, dy, r, c, c2
  Protected backcolor, whitebox, color
  
  backcolor = RGB(192,192,192)
  whitebox = $FFFFFF
  
  dx = GadgetWidth(#Canvas)
  dy = GadgetHeight(#Canvas)
  
  If StartDrawing(CanvasOutput(#Canvas))
    Box(0, 0, dx, dy, backcolor)
    Box(100, 100, 100, 100, whitebox)
    Circle(370, 270, 100, whitebox)
    Box(540, 340, 100, 100, whitebox)
    
    Repeat
      x = Random(dx-1)
      y = Random(dy-1)
      r = Random(20)
      color = RGB(Random(255), Random(255), Random(255))    
      If CollisionCircle(x, y, r, whitebox, #CollisionColorEqual)
        Circle(x, y, r, color)
        c + 1
      EndIf
      c2 + 1
    Until c > 5000 Or c2 > 10000
    
    DrawingMode(#PB_2DDrawing_Outlined)
    Box(0, 0, dx, dy, backcolor)
    Box(100, 100, 100, 100, whitebox)
    Circle(370, 270, 100, whitebox)
    Box(540, 340, 100, 100, whitebox)
    
    StopDrawing()
    
  EndIf
  
EndProcedure

Procedure Main()
  
  Protected Event
  
  If OpenWindow(#Main, #PB_Any, #PB_Any, 800, 600, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    CanvasGadget(#Canvas, 5, 5, WindowWidth(#Main) - 10, WindowHeight(#Main) - 10)
    
    Draw()
    
    Repeat
      Event = WaitWindowEvent()
      
      Select Event
          
        Case #PB_Event_CloseWindow
          exit = #True
          
      EndSelect
      
    Until exit
    
  EndIf
    
EndProcedure : Main()

Baba_Smurf · Beitrag von **Baba_Smurf** » 04.03.2015 22:40

Hallo,

danke dafür, kann man das auch umbauen, so das man Bilder per loadimage einbinden kann ??

mfg

mk-soft · Beitrag von **mk-soft** » 05.03.2015 00:40

Mit der Funktion CollisionBox(...) wird ja nur der Bereich vorher geprüft. Danach kann man natürlich in den Bereich ein Bild zeichnen.

Baba_Smurf · Beitrag von **Baba_Smurf** » 05.03.2015 07:52

danke,

dauert wohl noch etwas bis ich da richtig durchblicke, aber danke nochmals

Baba_Smurf · Beitrag von **Baba_Smurf** » 06.03.2015 07:42

Guten Morgen,

ich habe mal etwas getestet, so das man laden kann.

habe folgendes geändert.

nur AUsschnitte vom ganzen Code.

Code: Alles auswählen

Enumeration
  #Bild1
  #Bild2
 EndEnumeration
UsePNGImageEncoder()
UsePNGImageDecoder()

LoadImage(#Bild1, "c:\VTerrazzo\1.png")
LoadImage(#Bild2, "c:\VTerrazzo\2.png")

Procedure CollisionCircle(x, y, r, backcolor, mode=#CollisionColorDifferent)
 
  Shared IsCollision, CollisionBackColor
 
  IsCollision = #False
  CollisionBackColor = backcolor
 
  DrawingMode(#PB_2DDrawing_CustomFilter)     
  If mode
    CustomFilterCallback(@CollisionCallbackEqual())
  Else
    CustomFilterCallback(@CollisionCallbackDifferent())
  EndIf 


  DrawAlphaImage(ImageID(#Bild1) ,x ,y,255)
   DrawAlphaImage(ImageID(#Bild2) ,x-20 ,y-20,255)
  DrawingMode(#PB_2DDrawing_Default)     
 
  ProcedureReturn IsCollision
 
EndProcedure

  Procedure Draw()
   
    Protected x, y, dx, dy, r, c, c2
    Protected backcolor, color
   
    backcolor = RGB(192,192,192)
   
    dx = GadgetWidth(#Canvas)
    dy = GadgetHeight(#Canvas)
   
    If StartDrawing(CanvasOutput(#Canvas))
      Box(0, 0, dx, dy, backcolor)
      Repeat
        x = Random(dx-1)
        y = Random(dy-1)
        r = Random(20)
        color = RGB(Random(255), Random(255), Random(255))   
        If Not CollisionCircle(x, y, r, backcolor)
       
          DrawAlphaImage(ImageID(#Bild1) ,x ,y,255)
           DrawAlphaImage(ImageID(#Bild2) ,x-20 ,y-20,255)
          c + 1
        EndIf
        c2 + 1
      Until c > 500 Or c2 > 10000
      StopDrawing()
     
    EndIf
   
  EndProcedure

Jetzt ist es nur so, das es relativ lange dauert, bis das auf den Bildschirm gezeichnet wird, dauert zwischen 10-15 Sekunden grob geschätzt.

wenn ich statt LoadImage, LoadSprite nutzen würde, wäre das generell schneller als die Bilder so laden, oder gibt es eine Möglichkeit das ganze so schneller zu machen ??

mfg

mk-soft · Beitrag von **mk-soft** » 06.03.2015 22:23

Deine änderungen in der CollisionFunction machen keinen sinn und sind falsch.
Im Prinzip wird in der Kollisionsprüfung nicht gezeichnet. Dazu nutze ich Funktion CustomFilterCallback die mir für jeden Pixel die Farben übergibt.
Gebe einfach immer die Zielfarbe zurück und werte dabei die Zielfarbe aus um eine Kollision zu erkennen.

Siehe Dir die Hilfe zu CustomFilterCallback mal an.

Baba_Smurf · Beitrag von **Baba_Smurf** » 07.03.2015 00:00

hmm,

funktioniert das nur mit einfarbigen Objekten, oder auch generell mit bildern, die unterschiedliche Farben haben, bekomme es um ehrlich zu sein nicht in den Kopf.
Ich dachte halt das ich die geladenen Bilder einfach durch die Kreise ersetze, hat ja auch funktioniert, zumindest einigermaßen.

mfg

mk-soft · Beitrag von **mk-soft** » 07.03.2015 00:39

So nur mit einfarbigen Hintergrund...

mk-soft · Beitrag von **mk-soft** » 08.03.2015 01:46

Update v1.1

Es kann jetzt mit der Option #CollisionColorBackground auch Hintergrundbilder verwendet werden

mk-soft · Beitrag von **mk-soft** » 11.06.2017 15:45

Update v1.2
- Als Module geändert
- Bugfix Background Kollision

PureBoard

2D-Drawing Kollisionsfunktionen

2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen

Re: 2D-Drawing Kollisionsfunktionen - Update v1.1

Re: 2D-Drawing Kollisionsfunktionen