PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

2D-Drawing Collisionfunctions - Update v1.1

https://www.purebasic.fr/english/viewtopic.php?t=61784

Page 1 of 1

2D-Drawing Collisionfunctions - Update v1.1

Posted: Tue Mar 03, 2015 2:49 pm
by mk-soft
Hi,
result of a request following functions for 2D-Drawing

Update v1.1
Now with BackgroundImage :wink:

IncludeFile "2D-Collision.pbi"

Code: Select all

;-TOP

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

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

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

#CollisionColorDifferent = 0
#CollisionColorEqual = 1
#CollisionColorBackground = 2

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

Define IsCollision, CollisionBackColor, *CollisionBackground.udtBackground

; ---------------------------------------------------------------------------------------

Procedure CollisionCreateBackground(x, y, dx, dy)
  
  Protected *buffer.udtBackground, size, image
  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

; ---------------------------------------------------------------------------------------

Macro CollisionFreeBackground(buffer)
  FreeMemory(buffer) : buffer = 0
EndMacro

; ---------------------------------------------------------------------------------------

Procedure CollisionCallbackDifferent(x, y, SourceColor, TargetColor)
  
  Shared IsCollision, CollisionBackColor
  
  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)
  
  Shared IsCollision, CollisionBackColor
  
  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)
  
  Shared IsCollision, *CollisionBackground.udtBackground
  
  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 + x
    
    color = TargetColor & $FFFFFF
    If color <> \color[index]
      IsCollision = #True
    EndIf
    
  EndWith
  
  ProcedureReturn TargetColor
  
EndProcedure
  
; ---------------------------------------------------------------------------------------

Procedure CollisionBox(x, y, dx, dy, backcolor, mode=#CollisionColorDifferent)
  
  Shared IsCollision, CollisionBackColor, *CollisionBackground.udtBackground
  
  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)
  
  Shared IsCollision, CollisionBackColor, *CollisionBackground.udtBackground
  
  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

; ***************************************************************************************
Example 2

Code: Select all

;-TOP

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

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

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

EnableExplicit

IncludeFile "2D-Collision.pbi"

; Fenster
Enumeration
  #Main
EndEnumeration

; Gadgets
Enumeration
  #Canvas
EndEnumeration

Global exit

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)
        Circle(x, y, r, color)
        c + 1
      EndIf
      c2 + 1
    Until c > 1000 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 with BackgroundImage

Code: Select all

;-TOP

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

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

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

EnableExplicit

IncludeFile "2D-Collision.pbi"

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, *background, #CollisionColorBackground)
        Circle(x, y, r, color)
        c + 1
      EndIf
      c2 + 1
    Until c > 1000 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()
:wink:

Re: 2D-Drawing Collisionfunctions

Posted: Tue Mar 03, 2015 5:29 pm
by Little John
Very interesting, thank you!

And the resulting pictures are pretty nice. :-)

Re: 2D-Drawing Collisionfunctions

Posted: Sun Mar 08, 2015 12:22 am
by mk-soft
Update v1.1

Collision function now with option CollisionColorBackground for Background with Images :wink:

Show first post...

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

Posted: Sun Mar 08, 2015 7:09 am
by Little John
Hi,

thanks for the update!

The forward slash '/' works as delimiter in a path also on Windows.
So in your "Example with BackgroundImage", instead of

Code: Select all

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()
you can just write

Code: Select all

Procedure LoadPictures()
   
   LoadImage(#pic0, #PB_Compiler_Home + "examples/sources/Data/Background.bmp")
   LoadImage(#pic1, #PB_Compiler_Home + "examples/sources/Data/PurebasicLogo.bmp")
   
EndProcedure : LoadPictures()
:-)

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

Posted: Sun Mar 08, 2015 8:18 am
by Little John
Hi mk-soft,

what is the purpose of the flag #CollisionColorEqual ?

The default mode e.g. for CollisionCircle() is #CollisionColorDifferent, and that works fine.
But when I use the mode #CollisionColorEqual, then your first example only shows a grey background. :?

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

Posted: Sun Mar 08, 2015 11:21 am
by mk-soft
Hi john,

the option "#CollisionColorEqual" is to find a color in the area.

Example #CollisionColorEqual

Code: Select all

;-TOP

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

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

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

EnableExplicit

IncludeFile "2D-Collision.pbi"

; 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)
    Box(320, 220, 100, 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 > 500 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()
thanks for the test and answers

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

Posted: Sun Mar 08, 2015 7:21 pm
by Little John
Cool. 8)
Many thanks for the additional example!
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited