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
; ***************************************************************************************
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()
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()