collision detection by color overlap

dodicat · Post by **dodicat** » Jun 18, 2015 1:16

Here's collision detection between a ball and lines only.

Using standard Dynamics with the help of some vector properties:

Using similar to basiccoder's step back (line~78), where digital motion must be compensated (fudged) a little to make it analogue like.
I have kept the ball white so you can just see it overshooting the contact line before being positioned a step back.

Code: Select all

 
Screen 19
Type V3
    As Single x,y,z
    Declare Property length As Single
    Declare Property unit As V3
End Type

Type _object
    As v3 position,velocity
    As Integer radius
End Type

Type line3d
    As V3 v1,v2
End Type
'_______________________
Operator + (v1 As V3,v2 As V3) As V3
Return Type<V3>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator

Operator -(v1 As V3,v2 As V3) As V3
Return Type<V3>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator

Operator *(f As Single,v1 As V3) As V3 'scalar*V3
Return Type<V3>(f*v1.x,f*v1.y,f*v1.z)
End Operator

Operator * (v1 As V3,v2 As V3) As Single 'dot product
Return v1.x*v2.x+v1.y*v2.y+v1.z+v2.z',v1.mw*v2.mw
End Operator

Operator ^ (v1 As V3,v2 As V3) As V3 'cross product
Return Type<V3>(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator

Property v3.length As Single
Return Sqr(this.x*this.x+this.y*this.y+this.z*this.z)
End Property

Property v3.unit As v3
Dim n As Single=this.length
If n=0 Then n=1e-20
Return Type<V3>(this.x/n,this.y/n,this.z/n)
End Property

#define dot *
#define cross ^

Function segment_distance(l As Line3d,p As v3,Byref ip As v3=Type<V3>(0,0,0)) As Single
    Var s=l.v1,f=l.v2
    Dim As Single linelength=(s-f).length
    Dim As Single dist= ((1/linelength)*((s-f) cross (p-s))).length
    Dim As Single lpf=(p-f).length,lps=(p-s).length
    If lps >= lpf Then
        Var temp=Sqr(lps*lps-dist*dist)/linelength
        If temp>=1 Then temp=1:dist=lpf
        ip=s+(temp)*(f-s)
        Return dist
    Else
        Var temp=Sqr(lpf*lpf-dist*dist)/linelength
        If temp>=1 Then temp=1:dist=lps
        ip=f+(temp)*(s-f)
        Return dist
    End If
    Return dist
End Function

Sub check_ball_to_line_collisions(LN() As Line3d, ball() As _object)
    For z As Integer=Lbound(ball) To Ubound(ball)
        For z2 As Integer=Lbound(Ln) To Ubound(Ln)
            Dim As v3 closepoint
            Var seperation=segment_distance(Ln(z2),ball(z).position,closepoint)
            If seperation<=ball(z).radius Then
                Var impact=-1*ball(z).velocity
                Var impulse=(closepoint-ball(z).position).unit
                'put ball into real physical location(digital motion simulates analogue motion)
                ball(z).position=closepoint-(ball(z).radius)*impulse
                Var dv=(impact dot impulse) 
                ball(z).velocity=ball(z).velocity+2*dv*impulse 
            End If
        Next z2
    Next z
End Sub

Sub drawline(L As line3d)
    Line(L.v1.x,L.v1.y)-(L.v2.x,L.v2.y)
End Sub

Dim As _object B(1 To 1)
b(1).position=Type<V3>(100,200)
b(1).velocity=Type<V3>(5,-5)
b(1).radius=10

Dim As v3 Tmp(1 To 15)
Redim As line3d linesegments(1 To 14)

For n As Integer=1 To 15
    Read Tmp(n).x
Next n

For n As Integer=1 To 15
    Read Tmp(n).y
Next n

For n As Integer=1 To 13
    linesegments(n).v1=Type<v3>(Tmp(n).x,Tmp(n).y)
    linesegments(n).v2=Type<v3>(Tmp(n+1).x,Tmp(n+1).y)
Next n
linesegments(14).v1=linesegments(13).v2
linesegments(14).v2=linesegments(1).v1
'screen edge
Redim Preserve linesegments(Lbound(linesegments) To Ubound(linesegments)+4)
linesegments(15).v1=Type<v3>(0,0)
linesegments(15).v2=Type<v3>(799,0)

linesegments(16).v1=Type<v3>(799,0)
linesegments(16).v2=Type<v3>(799,599)

linesegments(17).v1=Type<v3>(799,599)
linesegments(17).v2=Type<v3>(0,599)

linesegments(18).v1=Type<v3>(0,599)
linesegments(18).v2=Type<v3>(0,0)

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
Dim As Integer fps

Do
    check_ball_to_line_collisions(Linesegments(),b())
    b(1).position+=b(1).velocity
    Screenlock
    Cls
    Draw String(20,20),"FPS = " &fps
    For n As Integer=Lbound(linesegments) To Ubound(linesegments)
        drawline(linesegments(n))
    Next n
    Circle(b(1).position.x,b(1).position.y),b(1).radius,,,,,f
    Screenunlock
    Sleep regulate(70,fps),1
    
Loop Until Len(Inkey)
'the line segments
X_values:

Data _
247, 409, 420, 458, 654, 569, 599, 468, 470, 408, 323, 352, 210, 398, 247 

Y_values:

Data _
132, 189, 78, 215, 78, 263, 417, 295, 443, 314, 451, 297, 342, 234, 132

BasicCoder2 · Post by **BasicCoder2** » Jun 18, 2015 23:41

@dodicat,

I placed the start of the ball inside the polygon and it worked well.
It seems to me this could be used to make a minigolf game?

Code: Select all

b(1).position=Type<V3>(500,255)

Your program is good enough to place in tips and tricks under a subject line like circle line-segment collision.
If you decide to move it to its own thread i will delete this post and you can, if you wish, delete yours as well.
It would be even better with a tutorial stepping through the sophisticated math and programming techniques used :)
Compare your methods with my crude not so precise or mathematical solution for circle line intersection detection.
It needs to have a rebound calculation added to change the direction of the circle according to the angle it hits a segment.

Code: Select all

screenres 640,480,32

const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

dim shared as double px,py,pdx,pdy,rad ' ball position,velocity,radius
dim shared as double angle1,angle2     ' direction of ball, angle of line
dim shared as double dx,dy             ' working variables
dim as double hit

type SEGMENT
    as integer x1
    as integer x2
    as integer y1
    as integer y2
end type

dim shared as SEGMENT seg(3)

seg(0).x1 = 150
seg(0).y1 = 200
seg(0).x2 = 400
seg(0).y2 = 60

seg(1).x1 = 400
seg(1).y1 = 60
seg(1).x2 = 348
seg(1).y2 = 354


seg(2).x1 = 348
seg(2).y1 = 354
seg(2).x2 = 150
seg(2).y2 = 200


px = 20
py = 40
pdx = 0.4
pdy = 0.6
rad = 20

function drawLine(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,c As UInteger) as integer
    dim as integer x,y,dd,hit
    hit = 0
    if x1 = x2 and y1 = y2 then
        pset (x,y),rgb(255,0,0)
    elseif abs(x2 - x1) >= abs(y2 - y1) then
        dim K as Single = (y2 - y1) / (x2 - x1)
        for I as Integer = x1 To x2 step sgn(x2 - x1)
            x = I
            y = K * (I - x1) + y1
            pset (x,y)
            dx = (x-px)
            dy = (y-py)
            dd = sqr(dx^2+dy^2)
            if rad>dd then
                hit = 1
            end if
        next I
    else
        dim L as Single = (x2 - x1) / (y2 - y1)
        for J as Integer = y1 To y2 step sgn(y2 - y1)
            x = L * (J - y1) + x1
            y = J
            pset (x,y)
            dx = (x-px)
            dy = (y-py)
            dd = sqr(dx^2+dy^2)

            if rad>dd then
                hit = 1
            end if
        next J
    end if

    return hit
    
end function


sub update()
    dim as integer hit
    screenlock
    cls
    for i as integer = 0 to 2
        hit = 0
        hit = drawLine(seg(i).x1,seg(i).y1,seg(i).x2,seg(i).y2,rgb(255,255,255))
        if hit = 1 then
            print "LINE #";i;" HIT"
        end if
    next i
    
    circle (px,py),rad,rgb(255,255,255)

    screenunlock
end sub


dim as double time1
time1 = timer
update()
do
    if timer - time1 > 0.002 then
        time1 = timer
        'move circle
        px = px + pdx
        py = py + pdy
        if px>=640-rad or px<=rad then
            pdx = -pdx
        end if
        if py>480-rad or py<=rad then
            pdy = -pdy
        end if
        update()        

    end if

    sleep 2
        
loop until multikey(&H01)


sleep

Tourist Trap · Post by **Tourist Trap** » Jun 28, 2015 18:53

Hello,

I've also crafted something from this nice per color collision detection stuff. I must admit that I still don't get it totally. I wouldn't write the things this way, however as this works well , I've just reused it with very few modifications. The styles being very different it is hard to keep homogeneity but I've tried to make something readable... The code below is neither the simplest possible nor it is really finished since some angle calculations must fail eventually, but despite this it does something slightly more general than the initial program.

Code: Select all

'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
''
''Addition over 'BasicCoder2&al per-color pixel collision code'
''
'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 																		 .----.
'  																		 | 00 |
'  																		 .----.
#Include "fbgfx.bi"
Using FB
' 																		 .----.
'  																		 | 01 |
'  																		 .----.
Enum _COLOR
	 _SP1 = RGB(0,0,0)
	 _SP2 = RGB(237,28,36)
	 _SP3 = RGB(255,255,255)
	 _SP4 = RGB(255,0,255)
	 _BKG = RGB(190,235,200)
	 _Black = RGB(0, 0, 0)
	 _White = RGB(255, 255, 255)
	 _DarkGreen = RGB(50,200,0)   
	 _LemonGreen = RGB(150, 200, 50)
	 _DelightGreen = RGB(200,225,200)   
End Enum '_COLOR
' 																		 .----.
'  																		 | 02 |
'  																		 .----.
Const As Double _PI   = 4 * Atn(1)
Const As Double _RTOD = 180 / _PI     ' Rad * RtoD = Deg
Const As Double _DTOR = _PI / 180     ' Deg * DtoR = Rad
Const As Long   _SCRW = 640
Const As Long   _SCRH = 480
Const As Double _RADIUS = ( _SCRW + _SCRH - Abs( _SCRW - _SCRH) )/4 - 10
	                 ''Radius formula related to screen minimum dimension

ScreenRes _SCRW, _SCRH, 32
Color _COLOR._Black, _COLOR._BKG
' 																		 .----.
'  																		 | 03 |
'  																		 .----.
Namespace PRG
	Declare Function BasicLength(ByVal A As Double, _
   	                          ByVal B As Double) _
      	                       As Double
	Function BasicLength(ByVal A As Double, _
                     ByVal B As Double) _
                     As Double
	 Return Sqr(A*A + B*B)  
	End Function ' DOUBLE := BasicLength(DOUBLE A, DOUBLE B)
End Namespace 'PRG
' 																		 .----.
'  																		 | 04 |
'  																		 .----.
Type POINT2D
	Declare Function BasicLength() As Double
	Declare Sub Show(ByVal Radius As UByte = 2, _ 
	                 ByVal _Color As ULong = _COLOR._Black)

	 As String _name = "POINT2D"

	 As Double _x
	 As Double _y
End Type 'POINT2D
Function POINT2D.BasicLength() As Double
	 Return PRG.BasicLength(This._x, This._y)
End Function 'DOUBLE := POINT2D.BasicLength()
Sub POINT2D.Show(ByVal Radius As UByte = 2, _ 
	              ByVal _Color As ULong = _COLOR._Black)
	 Draw String (This._x, This._y), This._name, _Color
	 Circle (This._x, This._y), Radius, _Color
End Sub 'POINT2D.Show(UByte Radius=2, ULong _Color=RGB(0,0,0))
' 																		 .----.
'  																		 | 05 |
'  																		 .----.
Type LINE2D Extends Object
'' _xcoefficient*X + _xcoefficient * Y + _constant == 0
'' Useful reference : 
'' http://mathinsight.org/tangent_normal_lines_refresher

	Declare Virtual Function SetFromTangent(ByVal WayPoint As POINT2D, _
	                                        ByVal TangentXCoefficient As Double, _ 
	                                        ByVal TangentYCoefficient As Double, _
	                                        ByVal TangentConstant As Double) _
	                                        As LINE2D
	Declare Virtual Function SetFromNormal(ByVal WayPoint As POINT2D, _
	                                       ByVal NormalXCoefficient As Double, _ 
	                                       ByVal NormalYCoefficient As Double, _
	                                       ByVal NormalConstant As Double) _
	                                       As LINE2D
	Declare Virtual Function ReturnTangent() As LINE2D
	Declare Virtual Function ReturnNormal() As LINE2D
	Declare Virtual Function EvaluateAtPoint(ByVal _Point2D As POINT2D) As Double
	Declare Virtual Sub Show(ByVal Length As ULong = 10)

	 As String _name = "LINE2D"

	 As Double _xCoefficient
	 As Double _yCoefficient
	 As Double _constant
	
	 As POINT2D _contactPoint
End Type 'LINE2D <-- OBJECT
Function LINE2D.SetFromTangent(ByVal WayPoint As POINT2D, _
                        		 ByVal TangentXCoefficient As Double, _ 
                        		 ByVal TangentYCoefficient As Double, _
                        		 ByVal TangentConstant As Double) _
                        		 As LINE2D
	Dim As LINE2D line2DReturn
	With line2DReturn
 		 ._contactPoint = WayPoint
		 ._xCoefficient = TangentXCoefficient
		 ._yCoefficient = TangentYCoefficient
		 ._constant = TangentConstant
	End With 'line2DReturn
	Return line2DReturn
End Function 'LINE2D := LINE2D.SetFromTangent(POINT2D, LINE2D)
Function LINE2D.SetFromNormal(ByVal WayPoint As POINT2D, _
	                    			ByVal NormalXCoefficient As Double, _ 
	                    			ByVal NormalYCoefficient As Double, _
	                    			ByVal NormalConstant As Double) _
	                    			As LINE2D
	Dim As LINE2D line2DReturn
	With line2DReturn
 		 ._contactPoint = WayPoint
		 ._xCoefficient = - NormalYCoefficient
		 ._yCoefficient = NormalXCoefficient
		 ._constant = NormalYCoefficient * WayPoint._x - NormalXCoefficient * WayPoint._y
	End With 'line2DReturn
	Return line2DReturn
End Function 'LINE2D := LINE2D.SetFromNormal(POINT2D, LINE2D)
Function LINE2D.ReturnTangent() As LINE2D
		 Dim As LINE2D tangent2DReturn
		 tangent2DReturn = This
		 Return tangent2DReturn
End Function 'LINE2D.ReturnTangent()
Function LINE2D.ReturnNormal() As LINE2D
		Dim As LINE2D normal2DReturn
		With normal2DReturn
 		 	 ._contactPoint = This._contactPoint
		 	 ._xCoefficient = -This._yCoefficient
		 	 ._yCoefficient = This._xCoefficient
		End With 'line2DReturn
		With This
			 normal2DReturn._constant = _ 
			 -(._xCoefficient*._contactPoint._x + ._yCoefficient*._contactPoint._y)
		End With 'This
		 Return normal2DReturn
End Function 'LINE2D.ReturnNormal()
Function LINE2D.EvaluateAtPoint(ByVal _Point2D As POINT2D) As Double
	 With This
	 	._constant = _ 
	 	-(._xCoefficient*._contactPoint._x + ._yCoefficient*._contactPoint._y)
	 End With 'This

	 Return _ 
	 This._xCoefficient * _Point2D._x + _
	 This._yCoefficient * _Point2D._y + _
	 This._constant
End Function 'Double := LINE2D.ReturnNormal(POINT2D)
Sub LINE2D.Show(ByVal Length As ULong = 10)
	Dim As Double directorLength
	With This
 		 directorLength = PRG.BasicLength(._xCoefficient,._yCoefficient)
	 	For _t As ULong = 1 To Length
	 		 PSet (._contactPoint._x -  _t * ._yCoefficient/directorLength, _ 
	 	    	    ._contactPoint._y +  _t * ._xCoefficient/directorLength ), _ 
	 	      	 _COLOR._Black
	 		 PSet (._contactPoint._x + _t * ._yCoefficient/directorLength, _ 
	 	    	    ._contactPoint._y - _t * ._xCoefficient/directorLength ), _ 
	 	      	 _COLOR._Black
	 	Next _t
 	    Draw String (._contactPoint._x + 5, ._contactPoint._y + 5), This._name
	End With 'This
End Sub ''LINE2D.Show(Long Length=10)
' 																		 .----.
'  																		 | 06 |
'  																		 .----.
Type CIRCLE2D

	Declare Function ReturnTangent(ByVal _AtContactPoint As POINT2D) _
                                                        As LINE2D
   Declare Sub Show(ByVal _Color As Long)
   Declare Sub Show(ByVal _Color As Long, ByVal _Thickness As Long)
   Declare Sub Show(ByVal _BorderColor As Long, _
                    ByVal _InnerColor As Long, _ 
                    ByVal _Thickness As Long)

	 As String _name = "CIRCLE2D"

	 As POINT2D _centerPoint
	 As Double _radius
End Type 'CIRCLE2D <-- CURVE2D
Function CIRCLE2D.ReturnTangent(ByVal _AtContactPoint As POINT2D) As LINE2D
	''Normal equation
	Dim As LINE2D normal
	Dim As LINE2D tangent

	With normal
		 ._xCoefficient = _AtContactPoint._y - This._centerPoint._y
		 ._yCoefficient = This._centerPoint._x - _AtContactPoint._x
		 ._constant = _
		 -(._xCoefficient * This._centerPoint._x + ._yCoefficient * This._centerPoint._y)
		 ._contactPoint = _AtContactPoint
	End With 'normal

	tangent = tangent.SetFromNormal(_AtContactPoint, _ 
	                                normal._xcoefficient, _
	                                normal._ycoefficient, _ 
	                                normal._constant)

	Return tangent
End Function 'LINE2D := CIRCLE2D.ReturnTangent(POINT2D _AtContactPoint)
Sub CIRCLE2D.Show(ByVal _Color As Long)

	Dim  As POINT2D namePosition
	 namePosition._x= This._centerPoint._x + This._radius * Cos(0.7)
 	 namePosition._y= This._centerPoint._y + This._radius * Sin(0.7)
	 Draw String (namePosition._x, namePosition._y), This._name, _Color

	With This
		 Circle (._centerPoint._x, _centerPoint._y), ._radius, _Color
	End With 'This
End Sub 'CIRCLE2D.Show(_Color)
Sub CIRCLE2D.Show(ByVal _Color As Long, ByVal _Thickness As Long)
	''This._name not displayed
	
	With This
		Select Case _Thickness
			Case Is < 1
				 _Thickness = 1
			Case Is > ._radius
				 _Thickness = ._radius
		End Select '_Thickness
		
		For _i As UByte = _Thickness To 1 Step -1
			 Circle (._centerPoint._x, _centerPoint._y), ._radius-_i+1, _Color
		Next _i
	End With 'This
End Sub ''CIRCLE2D.Show(_Color, _Thickness)
Sub CIRCLE2D.Show(ByVal _BorderColor As Long, _
         			ByVal _InnerColor As Long, _ 
         			ByVal _Thickness As Long)
	''This._name not displayed
	
	With This
		Select Case _Thickness
			Case Is < 1
				 _Thickness = 1
			Case Is > ._radius
				 _Thickness = ._radius
		End Select '_Thickness
		
		 Circle (._centerPoint._x, _centerPoint._y), ._radius, _BorderColor
		 Circle (._centerPoint._x, _centerPoint._y), ._radius-_Thickness, _BorderColor
		For _i As UByte = (_Thickness-1) To 1 Step -1
			 Circle (._centerPoint._x, _centerPoint._y), ._radius-_i, _InnerColor
		Next _i
	End With 'This
End Sub ''CIRCLE2D.Show(_BorderColor, _InnerColor, _Thickness)
' 																		 .----.
'  																		 | 07 |
'  																		 .----.
Declare Sub Update()
' 																		 .----.
'  																		 | 08 |
'  																		 .----.
Type SPRITE
	Declare Static Sub BitmapCreateFromDATA(ByVal This As SPRITE)
	
   As Double _x       'Topleft XCoordinates
   As Double _y       'Topleft XCoordinates
   As Double _w       'Width
   As Double _h       'Height

   As Double _dx      'For movement over X_axis
   As Double _dy		 'For movement over Y_axis

   As Long   _show    'If shown = 1
   As Long   _color
        
   Static As Long _frameNumber
   As FB.Image Ptr _img(1 To _frameNumber)
End Type 'SPRITE
Dim As Long SPRITE._frameNumber = 1
Sub SPRITE.BitmapCreateFromDATA(ByVal This As SPRITE)
	'===========================
	' THIS CREATES SPRITE BITMAP
	'===========================
	With This

		Dim As String c
  		Dim As UByte  cc
  		For k As Long = 1 To ._frameNumber
     	 Read c
	  		For j As Long = 0 to 31
      		For i As Long = 0 to 31
         		 cc = c[i]                   
            	Select Case As Const cc  
            		Case Asc("#")
            			For h As Long = k To ._frameNumber
               	   	 PSet ._img(h),(i,j),RGB(0,0,0)
            			Next h
            		Case Asc(".")
            			For h As Long = k To ._frameNumber
                  		 PSet ._img(h),(i,j),rgb(237,28,36)
            			Next h
            		Case Asc("+")
            			For h As Long = k To ._frameNumber
                  		 PSet ._img(h),(i,j),rgb(255,255,255)
            			Next h
            		Case Asc(" ")
            			For h As Long = k To ._frameNumber
                 		 	 PSet ._img(h),(i,j),rgb(255,0,255)
                  	Next h
            	End Select 'cc
      		Next i
    		Next j
    	Next k

	End With 'This
	'=============================
End Sub 'SPRITE.BitmapCreateFromDATA()
' 																		 .----.
'  																		 | 09 |
'  																		 .----.
Dim Shared hitter As SPRITE
Dim Shared target As CIRCLE2D

'* Initialize hitter *
Randomize Timer
Dim As Double someRandomAngle = 360 * Rnd
With hitter                      ''hitter is a SPRITE
   	 ._x = (_RADIUS - 4) * Cos(someRandomAngle*_DTOR) + _SCRW\2
       ._y = (_RADIUS - 4) * Sin(someRandomAngle*_DTOR) + _SCRH\2
       ._w = 4
       ._h = 4
       ._color = RGBA(255, 0, 255, 0)
       ._show = 1
       ._dx = 0.9 - 0.5 * Rnd    'Not >1 for current hittest to work
       ._dy = 0.9 - 0.5 * Rnd 
       ._frameNumber = 2
   For _i As ULong = 1 To ._frameNumber
    	 ._img(_i) = ImageCreate(._w, ._h, RGBA(255, 0, 255, 0))   
   Next _i
   .BitmapCreateFromDATA(hitter)
End With 'hitter

'* Initialize target *
With target                               ''hitter is a CIRCLE2D      
		 ._name = "TESTCIRCLE"
		 ._centerPoint._x = _SCRW\2
		 ._centerPoint._y = _SCRH\2
		 ._radius = _RADIUS
End With 'target
' 																		 .-----.
'  																		 | M@N |
'  																		 .-----.
''***************************************************************
	 Update()
   '[MAIN LOOP..
	Do

    		If hitter._x + hitter._dx < _SCRW - 10 And _
    	   	 hitter._x + hitter._dx > 10 Then
    	   	 hitter._x = hitter._x + hitter._dx
    		Else
    			 hitter._dx = -hitter._dx
    			 hitter._x = hitter._x + hitter._dx
    		EndIf
    	   
      	If hitter._y + hitter._dy < _SCRH - 10 And _
    	   	 hitter._y + hitter._dy > 10 Then
    	   	 hitter._y = hitter._y + hitter._dy
      	Else
      		 hitter._dy = -hitter._dy
    			 hitter._y = hitter._y + hitter._dy
      	EndIf  
      
        	Update()
      	Sleep 10, 1     ' 0.01 seconds

	Loop until multikey(&H01)
   '..MAIN LOOP]
		
 	For i As Long = 1 To hitter._frameNumber
 	 		 ImageDestroy hitter._img(i)
 	Next i

''***************************************************************
' 																		 .-----.
'  																		 | END |
'  																		 .-----.
Sleep
End 0
' 																		 .-----.
'  																		 | SUB |
'  																		 .-----.
Sub Update()
   Dim as Long     px,py,xx,yy      'position of sprite
   Dim as double   dx,dy

   Dim as double   angle            'direction of travel
   Dim as double   angle2           'direction of hit

   Dim as Long     hitflag          'hitflag = 1 means collision
   Dim as Long     takenflag        'probably means caught by object?

' 																                 .-----.
'  																		 | A00 |
'  																		 .-----.
   'Move the hitter
    hitter._x = hitter._x + hitter._dx
    hitter._y = hitter._y + hitter._dy

    'Record the hitter's approaching angle
   Dim As Double approachAngle
    approachAngle = ATan2(hitter._dy, hitter._dx)*57.2958
' 																		 .-----.
'  																		 | A01 |
'  																		 .-----.
   'Must draw background for hittest before the hitter is drawn
   ScreenLock()
    Color , _COLOR._BKG
    Cls	        
   'Drawn the background image
    target.Show(_COLOR._DarkGreen)
	ScreenUnLock
' 																		 .-----.
'  																		 | A02 |
'  																		 .-----.
	'Perform hit Test
    hitflag = 0
 
   For y As Long = 0 To hitter._h-1
      For x As Long = 0 To hitter._w-1
         If Point(x, y, hitter._img(1)) <> _COLOR._BKG Then
               If Point (x+hitter._x, y+hitter._y) <> _COLOR._BKG Then  
                   hitflag = 1 

                  'Rewind----------
                   hitter._x = hitter._x - hitter._dx
                   hitter._y = hitter._y - hitter._dy
                   xx = x + hitter._x
                   yy = y + hitter._y                  

               End If                
         End If
      Next x
   Next y
' 																		 .-----.
'  																		 | A03 |
'  																		 .-----.
'Reflection---------------
   Dim As POINT2D hitPoint
  	Dim As LINE2D tangent
  	Dim As LINE2D normal
  	Dim As Byte hitterRegion
   Dim As Double normalOrientation
   Dim As Double incidenceAngle
   Dim As Double angleAfterRebounce
 
   If hitflag = 1 Then 
   	 hitPoint._x = xx
	 	 hitPoint._y = yy	
       tangent = target.ReturnTangent( hitPoint )
       normal = tangent.ReturnNormal()

      'Compute hitter region relative to tangent
       hitterRegion = Sgn(tangent.EvaluateAtPoint( hitPoint ))
       If hitterRegion = 0 Then 
       	 'Fix this, since it could really be a problem
       	 hitterRegion = +1         ''This is not a fix
       EndIf

      'Compute normal orientation angle
       normalOrientation = ATan2(hitter._dy, hitter._dx) *57.2958
      If hitterRegion = -1 Then
       	 normalOrientation += 180
      EndIf

		'Compute angle between normal and approching hitter
		 incidenceAngle = approachAngle - normalOrientation
		 If Abs(incidenceAngle) > 90 Then incidenceAngle -= 90

      'Find angle after rebounce
       angleAfterRebounce = approachAngle - 2 * incidenceAngle 

      'Set dx, dy accordingly 
       hitter._dx = 0.5 * Cos(angleAfterRebounce)
       hitter._dy = 0.5 * Sin(angleAfterRebounce)
   EndIf
	 
'-------------------------
' 																		 .-----.
'  																		 | A04 |
'  																		 .-----.
   If hitflag = 1 Then 'compute angle2
       takenflag = 0
       px = hitter._x + hitter._w \2
       py = hitter._y + hitter._h \2
       dx = xx - px
       dy = yy - py
       angle2 = ATan2(dy,dx)*57.2958
       If angle2<0 then angle2 = angle2 + 360
    
      'check four segments
      If angle2>247 And angle2<292 Then
            'hitter._dy = -hitter._dy
            takenflag = 1
      End If
      If angle2>337 Or angle2<22 Then
            'hitter._dx = -hitter._dx
            takenflag = 1
      End If
      If angle2>67 and angle2<112 Then
            'hitter._dy = -hitter._dy
            takenflag = 1
      End If
      If angle2>157 and angle2<202 Then
            hitter._dx = -hitter._dx
            takenflag = 1
      End If
           
      '(must be in a corner segment)
      If takenflag = 0 Then
          hitter._dx = -hitter._dx
          hitter._dy = -hitter._dy
      End If
   End If
' 																		 .-----.
'  																		 | A05 |
'  																		 .-----.
	ScreenLock
    Put (hitter._x, hitter._y), hitter._img(1),trans


    Draw string (16,16),"PRESS ESC KEY TO EXIT DEMO"
    Draw string (16,1), hitter._x & "  " & hitter._y
	ScreenUnLock
End Sub 'Update()
' 																		 .-----.
'  																		 | DAT |
'  																		 .-----.
'hitter DRAWING DATA
 					 Data "####"
 					 Data "####"
 					 Data "####"
 					 Data "####"

 					 Data "####"
 					 Data "#..#"
 					 Data "#..#"
 					 Data "####"
'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

Post by **fxm** » Jun 28, 2015 19:49

Now I dare not say anything!

Tourist Trap · Post by **Tourist Trap** » Jun 28, 2015 21:03

fxm wrote:Now I dare not say anything!

It's the contrary, I would like to get aknowledged about bad practices or coding errors. This is only a part (the working one) of the whole work . I'm trying here to use extensively inheritance.

Post by **fxm** » Jun 28, 2015 21:21

- Main problem:
Compile with option '-exx' and you will see:
Aborting due to runtime error 6 (out of bounds array access) at line 344 ...
Because when the array _img(1 To _frameNumber) is defined, _frameNumber=1.
After _frameNumber=2 but this array is not resized!

- Small problem:
In Sub update(), the screen is updated with two separate blocks [ScreenLock...ScrennUnlock], inducing some flickering!

- Question:
Why the Type LINE2D Extends Object, and all methods virtual?
At present time, this is useless!

Post by **fxm** » Jun 28, 2015 21:56

dkl,

Is it also legal to define a dynamic array in a TYPE as following (without use ANY):

Code: Select all

Dim Shared As Long N = 1

Type UDT
  Dim As Integer array(N)
End Type

Dim As UDT u
Print Ubound(u.array)
N = 2
Redim u.array(N)
Print Ubound(u.array)

Or even as following:

Code: Select all

Type UDT
  Static As Long N
  Dim As Integer array(N)
End Type
Dim As Long UDT.N = 1

Dim As UDT u
Print Ubound(u.array)
With u
  .N = 2
  Redim .array(.N)
End With
Print Ubound(u.array)

Tourist Trap · Post by **Tourist Trap** » Jun 28, 2015 23:23

Nice to see you back with best practices ;-)

fxm wrote:- Main problem:
Compile with option '-exx' and you will see:
Aborting due to runtime error 6 (out of bounds array access) at line 344 ...
Because when the array _img(1 To _frameNumber) is defined, _frameNumber=1.
After _frameNumber=2 but this array is not resized!

Strange that it has been compiling and running for me. Leave aside some crashes but just at program termination. -In fact I dont need the animated frames, I just tried not to dismantle too much of the original code.

fxm wrote: - Small problem:
In Sub update(), the screen is updated with two separate blocks [ScreenLock...ScrennUnlock], inducing some flickering!

Ok; but that doesn't count too much. I'm still tuning the data structures, and it's more about setting up correct math for the moment. Not doing this just for final display. Of course I take note of that anyway.

fxm wrote: - Question:
Why the Type LINE2D Extends Object, and all methods virtual?
At present time, this is useless!

Because my strategy would be to set up general geometry equiped with tangent, normal, in order to be overload by inheritance depending of the special geometry. For instance LINE2D could be derived in CURVE2D, itself could specialize in CIRCLE2D or CUBIC2D and so on. Each of those having their own special tangent calculations and so different bouncing behaviour.

fxm wrote:dkl,
Is it also legal to define a dynamic array in a TYPE as following (without use ANY):
Code
Or even as following:
Code

Nice. Thanks man.

dodicat · Post by **dodicat** » Jun 29, 2015 2:39

Tourist Trap -- Bouncing off the inside of circle doesn't require much geometry.
The collision is detected by colour, the re-bound by impulse and impact (speed)

Or perhaps you wanted to derive everything via inheritance, which would be a good exercise I suppose.

Code: Select all


'========= SPEED REGULATOR =====================
Function Regulate(byval MyFps As Integer,Byref fps As Integer) As Integer
 Static As Double timervalue,lastsleeptime,t3,frames
 frames+=1
 If (timer-t3)>=1 Then t3=timer:fps=frames:frames=0
 Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
 If sleeptime<1 Then sleeptime=1
 lastsleeptime=sleeptime
 timervalue=Timer
 Return sleeptime
End Function

screen 19,32
dim as any ptr im=imagecreate(800,600,rgb(0,200,255))
circle im,(400,300),250,rgb(255,255,255),,,,f
circle im,(400,300),240,rgb(255,255,254),,,,f
type ball
    as single x,y
    as single dx,dy
    as integer r
end type
dim as ball b=type<ball>(400,100,2.5,.5,10)
dim as integer fps
dim as string key
do
    key=inkey
    b.x+=b.dx
    b.y+=b.dy
    if point(b.x,b.y,im)=rgb(255,255,255) then 
        var impulsex=B.x-400,impulsey=B.y-300
        var l=sqr(impulsex*impulsex+impulsey*impulsey)
        impulsex=impulsex/l:impulsey=impulsey/l
        var dv=b.dx*impulsex+b.dy*impulsey
        B.dx+=-2*dv*impulsex
        B.dy+=-2*dv*impulsey
    end if
    screenlock
    put(0,0),im,pset
    draw string (20,20),"FPS = " &fps
    draw string(20,50),"Press a key to change direction"
    circle(b.x,b.y),b.r,rgb(0,200,0),,,,f
    screenunlock
    sleep regulate(150,fps),1
    if key <>"" then swap b.dx,b.dy
loop until key=chr(27) 
imagedestroy im

Tourist Trap · Post by **Tourist Trap** » Jun 29, 2015 3:12

dodicat wrote:Tourist Trap -- Bouncing off the inside of circle doesn't require much geometry.
The collision is detected by colour, the re-bound by impulse and impact (speed)

Or perhaps you wanted to derive everything via inheritance, which would be a good exercise I suppose.
Code

That's it. I would like to make it very general in order to get rebounces that fit best depending on geometry of object. Good OO exercise as you've said.

[EDIT] Your code is quite efficient, and renders very nicely .

Related to BasicCoder2 search for a reducing data method, I'm posting here this other version, that is not bouncing but colliding and sampling the horse of Roland Chastain.

Code: Select all

'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
''
''Addition over 'BasicCoder2&al per-color pixel collision code'
''
'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 																		 .----.
'  																		 | 00 |
'  																		 .----.
#Include "fbgfx.bi"
Using FB
' 																		 .----.
'  																		 | 01 |
'  																		 .----.
Enum _COLOR
	 _SP1 = RGB(0,0,0)
	 _SP2 = RGB(237,28,36)
	 _SP3 = RGB(255,255,255)
	 _SP4 = RGB(255,0,255)
	 _BKG = RGB(190,235,200)
	 _Black = RGB(0, 0, 0)
	 _White = RGB(255, 255, 255)
	 _DarkGreen = RGB(50,200,0)   
	 _LemonGreen = RGB(150, 200, 50)
	 _DelightGreen = RGB(200,225,200)   
End Enum '_COLOR
' 																		 .----.
'  																		 | 02 |
'  																		 .----.
Const As Double _PI   = 4 * Atn(1)
Const As Double _RTOD = 180 / _PI     ' Rad * RtoD = Deg
Const As Double _DTOR = _PI / 180     ' Deg * DtoR = Rad
Const As Long   _SCRW = 700
Const As Long   _SCRH = 500
Const As Double _RADIUS = ( _SCRW + _SCRH - Abs( _SCRW - _SCRH) )/4 - 10
	                 ''Radius formula related to screen minimum dimension

ScreenRes _SCRW, _SCRH, 32
Color , _COLOR._BKG : Cls

	Dim Shared horseBuffer As Any Ptr
	Dim Shared reducedHorseBuffer As Any Ptr

	 horseBuffer = ImageCreate( 700, 500 )
	 reducedHorseBuffer = ImageCreate( 700, 500 )

	'Read Horse DATAS
	 Restore Chastain
    Dim as integer x, y

    For _i as integer = 0 to 2844
       Read x,y
       PSet horseBuffer, (x, y), _COLOR._SP2 
    Next _i
    
    Restore Hitter
' 																		 .----.
'  																		 | 03 |
'  																		 .----.
Namespace PRG
	Declare Function BasicLength(ByVal A As Double, _
   	                          ByVal B As Double) _
      	                       As Double
	Function BasicLength(ByVal A As Double, _
                     ByVal B As Double) _
                     As Double
	 Return Sqr(A*A + B*B)  
	End Function ' DOUBLE := BasicLength(DOUBLE A, DOUBLE B)
End Namespace 'PRG
' 																		 .----.
'  																		 | 04 |
'  																		 .----.
Type POINT2D
	Declare Function BasicLength() As Double
	Declare Sub Show(ByVal Radius As UByte = 2, _ 
	                 ByVal _Color As ULong = _COLOR._Black)

	 As String _name = "POINT2D"

	 As Double _x
	 As Double _y
End Type 'POINT2D
Function POINT2D.BasicLength() As Double
	 Return PRG.BasicLength(This._x, This._y)
End Function 'DOUBLE := POINT2D.BasicLength()
Sub POINT2D.Show(ByVal Radius As UByte = 2, _ 
	              ByVal _Color As ULong = _COLOR._Black)
	 Draw String (This._x, This._y), This._name, _Color
	 Circle (This._x, This._y), Radius, _Color
End Sub 'POINT2D.Show(UByte Radius=2, ULong _Color=RGB(0,0,0))
' 																		 .----.
'  																		 | 05 |
'  																		 .----.
Type LINE2D Extends Object
'' _xcoefficient*X + _xcoefficient * Y + _constant == 0
'' Useful reference : 
'' http://mathinsight.org/tangent_normal_lines_refresher

	Declare Virtual Function SetFromTangent(ByVal WayPoint As POINT2D, _
	                                        ByVal TangentXCoefficient As Double, _ 
	                                        ByVal TangentYCoefficient As Double, _
	                                        ByVal TangentConstant As Double) _
	                                        As LINE2D
	Declare Virtual Function SetFromNormal(ByVal WayPoint As POINT2D, _
	                                       ByVal NormalXCoefficient As Double, _ 
	                                       ByVal NormalYCoefficient As Double, _
	                                       ByVal NormalConstant As Double) _
	                                       As LINE2D
	Declare Virtual Function ReturnTangent() As LINE2D
	Declare Virtual Function ReturnNormal() As LINE2D
	Declare Virtual Function EvaluateAtPoint(ByVal _Point2D As POINT2D) As Double
	Declare Virtual Sub Show(ByVal Length As ULong = 10)

	 As String _name = "LINE2D"

	 As Double _xCoefficient
	 As Double _yCoefficient
	 As Double _constant
	
	 As POINT2D _contactPoint
End Type 'LINE2D <-- OBJECT
Function LINE2D.SetFromTangent(ByVal WayPoint As POINT2D, _
                        		 ByVal TangentXCoefficient As Double, _ 
                        		 ByVal TangentYCoefficient As Double, _
                        		 ByVal TangentConstant As Double) _
                        		 As LINE2D
	Dim As LINE2D line2DReturn
	With line2DReturn
 		 ._contactPoint = WayPoint
		 ._xCoefficient = TangentXCoefficient
		 ._yCoefficient = TangentYCoefficient
		 ._constant = TangentConstant
	End With 'line2DReturn
	Return line2DReturn
End Function 'LINE2D := LINE2D.SetFromTangent(POINT2D, LINE2D)
Function LINE2D.SetFromNormal(ByVal WayPoint As POINT2D, _
	                    			ByVal NormalXCoefficient As Double, _ 
	                    			ByVal NormalYCoefficient As Double, _
	                    			ByVal NormalConstant As Double) _
	                    			As LINE2D
	Dim As LINE2D line2DReturn
	With line2DReturn
 		 ._contactPoint = WayPoint
		 ._xCoefficient = - NormalYCoefficient
		 ._yCoefficient = NormalXCoefficient
		 ._constant = NormalYCoefficient * WayPoint._x - NormalXCoefficient * WayPoint._y
	End With 'line2DReturn
	Return line2DReturn
End Function 'LINE2D := LINE2D.SetFromNormal(POINT2D, LINE2D)
Function LINE2D.ReturnTangent() As LINE2D
		 Dim As LINE2D tangent2DReturn
		 tangent2DReturn = This
		 Return tangent2DReturn
End Function 'LINE2D.ReturnTangent()
Function LINE2D.ReturnNormal() As LINE2D
		Dim As LINE2D normal2DReturn
		With normal2DReturn
 		 	 ._contactPoint = This._contactPoint
		 	 ._xCoefficient = -This._yCoefficient
		 	 ._yCoefficient = This._xCoefficient
		End With 'line2DReturn
		With This
			 normal2DReturn._constant = _ 
			 -(._xCoefficient*._contactPoint._x + ._yCoefficient*._contactPoint._y)
		End With 'This
		 Return normal2DReturn
End Function 'LINE2D.ReturnNormal()
Function LINE2D.EvaluateAtPoint(ByVal _Point2D As POINT2D) As Double
	 With This
	 	._constant = _ 
	 	-(._xCoefficient*._contactPoint._x + ._yCoefficient*._contactPoint._y)
	 End With 'This

	 Return _ 
	 This._xCoefficient * _Point2D._x + _
	 This._yCoefficient * _Point2D._y + _
	 This._constant
End Function 'Double := LINE2D.ReturnNormal(POINT2D)
Sub LINE2D.Show(ByVal Length As ULong = 10)
	Dim As Double directorLength
	With This
 		 directorLength = PRG.BasicLength(._xCoefficient,._yCoefficient)
	 	For _t As ULong = 1 To Length
	 		 PSet (._contactPoint._x -  _t * ._yCoefficient/directorLength, _ 
	 	    	    ._contactPoint._y +  _t * ._xCoefficient/directorLength ), _ 
	 	      	 _COLOR._Black
	 		 PSet (._contactPoint._x + _t * ._yCoefficient/directorLength, _ 
	 	    	    ._contactPoint._y - _t * ._xCoefficient/directorLength ), _ 
	 	      	 _COLOR._Black
	 	Next _t
 	    Draw String (._contactPoint._x + 5, ._contactPoint._y + 5), This._name
	End With 'This
End Sub ''LINE2D.Show(Long Length=10)
' 																		 .----.
'  																		 | 06 |
'  																		 .----.
Type CIRCLE2D

	Declare Function ReturnTangent(ByVal _AtContactPoint As POINT2D) _
                                                        As LINE2D
   Declare Sub Show(ByVal _Color As Long)
   Declare Sub Show(ByVal _Color As Long, ByVal _Thickness As Long)
   Declare Sub Show(ByVal _BorderColor As Long, _
                    ByVal _InnerColor As Long, _ 
                    ByVal _Thickness As Long)

	 As String _name = "CIRCLE2D"

	 As POINT2D _centerPoint
	 As Double _radius
End Type 'CIRCLE2D <-- CURVE2D
Function CIRCLE2D.ReturnTangent(ByVal _AtContactPoint As POINT2D) As LINE2D
	''Normal equation
	Dim As LINE2D normal
	Dim As LINE2D tangent

	With normal
		 ._xCoefficient = _AtContactPoint._y - This._centerPoint._y
		 ._yCoefficient = This._centerPoint._x - _AtContactPoint._x
		 ._constant = _
		 -(._xCoefficient * This._centerPoint._x + ._yCoefficient * This._centerPoint._y)
		 ._contactPoint = _AtContactPoint
	End With 'normal

	tangent = tangent.SetFromNormal(_AtContactPoint, _ 
	                                normal._xcoefficient, _
	                                normal._ycoefficient, _ 
	                                normal._constant)

	Return tangent
End Function 'LINE2D := CIRCLE2D.ReturnTangent(POINT2D _AtContactPoint)
Sub CIRCLE2D.Show(ByVal _Color As Long)

	Dim  As POINT2D namePosition
	 namePosition._x= This._centerPoint._x + This._radius * Cos(0.7)
 	 namePosition._y= This._centerPoint._y + This._radius * Sin(0.7)
	 Draw String (namePosition._x, namePosition._y), This._name, _Color

	With This
		 Circle (._centerPoint._x, _centerPoint._y), ._radius, _Color
	End With 'This
End Sub 'CIRCLE2D.Show(_Color)
Sub CIRCLE2D.Show(ByVal _Color As Long, ByVal _Thickness As Long)
	''This._name not displayed
	
	With This
		Select Case _Thickness
			Case Is < 1
				 _Thickness = 1
			Case Is > ._radius
				 _Thickness = ._radius
		End Select '_Thickness
		
		For _i As UByte = _Thickness To 1 Step -1
			 Circle (._centerPoint._x, _centerPoint._y), ._radius-_i+1, _Color
		Next _i
	End With 'This
End Sub ''CIRCLE2D.Show(_Color, _Thickness)
Sub CIRCLE2D.Show(ByVal _BorderColor As Long, _
         			ByVal _InnerColor As Long, _ 
         			ByVal _Thickness As Long)
	''This._name not displayed
	
	With This
		Select Case _Thickness
			Case Is < 1
				 _Thickness = 1
			Case Is > ._radius
				 _Thickness = ._radius
		End Select '_Thickness
		
		 Circle (._centerPoint._x, _centerPoint._y), ._radius, _BorderColor
		 Circle (._centerPoint._x, _centerPoint._y), ._radius-_Thickness, _BorderColor
		For _i As UByte = (_Thickness-1) To 1 Step -1
			 Circle (._centerPoint._x, _centerPoint._y), ._radius-_i, _InnerColor
		Next _i
	End With 'This
End Sub ''CIRCLE2D.Show(_BorderColor, _InnerColor, _Thickness)
' 																		 .----.
'  																		 | 07 |
'  																		 .----.
Declare Sub Update()
' 																		 .----.
'  																		 | 08 |
'  																		 .----.
Type SPRITE
	Declare Static Sub BitmapCreateFromDATA(ByVal This As SPRITE)
	
   As Double _x       'Topleft XCoordinates
   As Double _y       'Topleft XCoordinates
   As Double _w       'Width
   As Double _h       'Height

   As Double _dx      'For movement over X_axis
   As Double _dy		 'For movement over Y_axis

   As Long   _show    'If shown = 1
   As Long   _color
        
   Static As Long _frameNumber
   As FB.Image Ptr _img(1 To _frameNumber)
End Type 'SPRITE
Dim As Long SPRITE._frameNumber = 1
Sub SPRITE.BitmapCreateFromDATA(ByVal This As SPRITE)
	'===========================
	' THIS CREATES SPRITE BITMAP
	'===========================
	With This

		Dim As String c
  		Dim As UByte  cc
  		For k As Long = 1 To ._frameNumber
     	 Read c
	  		For j As Long = 0 to 3
      		For i As Long = 0 to 3
         		 cc = c[i]                   
            	Select Case As Const cc  
            		Case Asc("#")
            			For h As Long = k To ._frameNumber
               	   	 PSet ._img(h),(i,j),RGB(0,0,0)
            			Next h
            		Case Asc(".")
            			For h As Long = k To ._frameNumber
                  		 PSet ._img(h),(i,j),rgb(237,28,36)
            			Next h
            		Case Asc("+")
            			For h As Long = k To ._frameNumber
                  		 PSet ._img(h),(i,j),rgb(255,255,255)
            			Next h
            		Case Asc(" ")
            			For h As Long = k To ._frameNumber
                 		 	 PSet ._img(h),(i,j),rgb(255,0,255)
                  	Next h
            	End Select 'cc
      		Next i
    		Next j
    	Next k

	End With 'This
	'=============================
End Sub 'SPRITE.BitmapCreateFromDATA()
' 																		 .----.
'  																		 | 09 |
'  																		 .----.
Randomize Timer
Dim Shared launcher As CIRCLE2D
Dim Shared hitter As SPRITE
Dim Shared sightAngle As Double

'* Initialize launcher *
With launcher                               ''hitter is a CIRCLE2D      
		 ._name = "TESTCIRCLE"
		 ._centerPoint._x = _SCRW\2
		 ._centerPoint._y = _SCRH\2
		 ._radius = _RADIUS
End With 'launcher

'* Initialize hitter *
sightAngle = 225
With hitter                      ''hitter is a SPRITE
   	 ._x = (_RADIUS - 20) * Cos(sightAngle*_DTOR) + _SCRW\2
       ._y = (_RADIUS - 20) * Sin(sightAngle*_DTOR) + _SCRH\2
       ._w = 4
       ._h = 4
       ._color = RGBA(255, 0, 255, 0)
       ._show = 1
       ._dx = (launcher._centerPoint._x - ._x)/(2*_RADIUS)    'Not >1 for current hittest to work
       ._dy = (launcher._centerPoint._y - ._y)/(2*_RADIUS) 
       ._frameNumber = 2
   For _i As ULong = 1 To ._frameNumber
   	ReDim Preserve ._img(1 To ._frameNumber)
    	 ._img(_i) = ImageCreate(._w, ._h, RGBA(255, 0, 255, 0))   
   Next _i
   .BitmapCreateFromDATA(hitter)

	For j As Long = 0 to 3
     		For i As Long = 0 to 3
     	   	 PSet ._img(2),(i,j), _COLOR._BKG
     		Next i
	Next j

End With 'hitter

' 																		 .-----.
'  																		 | M@N |
'  																		 .-----.
''***************************************************************
	 Update()
   '[MAIN LOOP..
	Do

    		If hitter._x + hitter._dx < _SCRW - 10 And _
    	   	 hitter._x + hitter._dx > 10 Then
    	   	 hitter._x = hitter._x + hitter._dx
    		Else
    			 hitter._dx = -hitter._dx
    			 hitter._x = hitter._x + hitter._dx
    		EndIf
    	   
      	If hitter._y + hitter._dy < _SCRH - 10 And _
    	   	 hitter._y + hitter._dy > 10 Then
    	   	 hitter._y = hitter._y + hitter._dy
      	Else
      		 hitter._dy = -hitter._dy
    			 hitter._y = hitter._y + hitter._dy
      	EndIf  
      
        	Update()
      	Sleep 10, 1     ' 0.01 seconds

	Loop Until sightAngle = (225+360) Or MultiKey(&H01)
   '..MAIN LOOP]
		
 	For i As Long = 1 To hitter._frameNumber
 	 		 ImageDestroy hitter._img(i)
 	Next i
 	
 	'Draw the result sample image
    Color , _COLOR._Black : Cls
    Draw string (16,16),"SAMPLED CHASTAIN's HORSE RESULT"

    Put (120, 50), reducedHorseBuffer, Trans
    launcher.Show(_COLOR._DarkGreen, _COLOR._DelightGreen, 12)
    Sleep

 	 ImageDestroy( horseBuffer )
 	 ImageDestroy( reducedHorseBuffer )

''***************************************************************
' 																		 .-----.
'  																		 | END |
'  																		 .-----.
Sleep
End 0
' 																		 .-----.
'  																		 | SUB |
'  																		 .-----.
Sub Update()
   Dim as Long     px,py,xx,yy      'position of sprite
   Dim as double   dx,dy

   Dim as double   angle            'direction of travel
   Dim as double   angle2           'direction of hit

   Dim as Long     hitflag          'hitflag = 1 means collision
   Dim as Long     takenflag        'probably means caught by object?

' 																		 .-----.
'  																		 | A00 |
'  																		 .-----.
	ScreenLock
	'Erase the hitter
	'Put (hitter._x - hitter._dx, hitter._y - hitter._dy), hitter._img(2), Trans

   'Move the hitter
    hitter._x = hitter._x + hitter._dx
    hitter._y = hitter._y + hitter._dy

    'Record the hitter's approaching angle
   Dim As Double approachAngle
    approachAngle = ATan2(hitter._dy, hitter._dx)*57.2958
' 																		 .-----.
'  																		 | A01 |
'  																		 .-----.
	'ScreenLock
   'Must draw background for hittest before the hitter is drawn
   'Draw the background image
    Color , _COLOR._BKG : Cls
    Put (120, 50), horseBuffer, TRANS 
    launcher.Show(_COLOR._DarkGreen, _COLOR._Black, 8)
' 																		 .-----.
'  																		 | A02 |
'  																		 .-----.
	'Perform hit Test
    hitflag = 0
 
   For y As Long = 0 To hitter._h-1
      For x As Long = 0 To hitter._w-1
         If Point(x, y, hitter._img(1)) <> _COLOR._BKG Then
               If Point (x+hitter._x, y+hitter._y) <> _COLOR._BKG Then  
                   hitflag = 1 

                  'Rewind----------
                   hitter._x = hitter._x - hitter._dx
                   hitter._y = hitter._y - hitter._dy
                   xx = x + hitter._x
                   yy = y + hitter._y                  

               End If                
         End If
      Next x
   Next y
' 																		 .-----.
'  																		 | A03 |
'  																		 .-----.
	'Reflection---------------
   Dim As POINT2D hitPoint
  	Dim As LINE2D tangent
  	Dim As LINE2D normal
  	Dim As Byte hitterRegion
   Dim As Double normalOrientation
   Dim As Double incidenceAngle
   Dim As Double angleAfterRebounce
 
   If hitflag = 1 Then 
   	 hitPoint._x = xx
	 	 hitPoint._y = yy	
       tangent = launcher.ReturnTangent( hitPoint )
       normal = tangent.ReturnNormal()

      'Compute hitter region relative to tangent
       hitterRegion = Sgn(tangent.EvaluateAtPoint( hitPoint ))
       If hitterRegion = 0 Then 
       	 'Fix this, since it could really be a problem
       	 hitterRegion = +1         ''This is not a fix
       EndIf

      'Compute normal orientation angle
       normalOrientation = ATan2(hitter._dy, hitter._dx) *57.2958
      If hitterRegion = -1 Then
       	 normalOrientation += 180
      EndIf

		'Compute angle between normal and approching hitter
		 incidenceAngle = approachAngle - normalOrientation
		 If Abs(incidenceAngle) > 90 Then incidenceAngle -= 90

      'Find angle after rebounce
       angleAfterRebounce = approachAngle - 2 * incidenceAngle 

      'Set dx, dy accordingly 
       hitter._dx = 0.5 * Cos(angleAfterRebounce)
       hitter._dy = 0.5 * Sin(angleAfterRebounce)
   EndIf
	'-------------------------
' 																		 .-----.
'  																		 | A04 |
'  																		 .-----.
   If hitflag = 1 Then 'compute angle2
  		 PSet reducedHorseBuffer, (hitter._x - 120, hitter._y - 50), _COLOR._SP2

   	 'Record hitpoint and reset
   	 sightAngle += 10
   	 
   	With hitter                      
   	 ._x = (_RADIUS - 20) * Cos(sightAngle*_DTOR) + _SCRW\2
       ._y = (_RADIUS - 20) * Sin(sightAngle*_DTOR) + _SCRH\2
       ._dx = -(launcher._centerPoint._x - ._x)/(2*_RADIUS)
       ._dy = -(launcher._centerPoint._y - ._y)/(2*_RADIUS) 
   	End With 'hitter
 
           
      '(must be in a corner segment)
      If takenflag = 0 Then
          hitter._dx = -hitter._dx
          hitter._dy = -hitter._dy
      End If
   End If
' 																		 .-----.
'  																		 | A05 |
'  																		 .-----.
    Put (hitter._x, hitter._y), hitter._img(1),trans


    Draw string (16,16),"PRESS ESC KEY TO EXIT DEMO"
    Draw string (16,1), hitter._x & "  " & hitter._y
	ScreenUnLock
End Sub 'Update()
' 																		 .-----.
'  																		 | DAT |
'  																		 .-----.
'hitter DRAWING DATA
Hitter:
 					 Data "####"
 					 Data "####"
 					 Data "####"
 					 Data "####"

 					 Data "####"
 					 Data "#..#"
 					 Data "#..#"
 					 Data "####"

'Chastain's horse DRAWING DATA
Chastain:

	 Data  122,80,123,80,124,80,125,80,126,80,126,81,127,81,128,81,129,81,129,82,130,82
    DATA  130,83,131,83,132,83,133,83,134,83,135,83,136,83,137,83,138,83,139,83,140,83
    DATA  141,83,142,83,143,83,144,83,145,83,146,83,147,83,148,83,149,83,150,83,151,83
    DATA  152,83,153,83,154,83,155,83,156,83,157,83,158,83,159,83,160,83,161,83,162,83
    DATA  163,83,164,83,165,83,165,84,166,84,167,84,167,85,168,85,169,85,169,86,170,86
    DATA  171,86,172,86,172,87,173,87,174,87,175,87,175,88,176,88,177,88,177,89,178,89
    DATA  179,89,179,90,180,90,181,90,181,91,182,91,183,91,183,92,184,92,184,93,185,93
    DATA  186,93,186,94,187,94,188,94,188,95,189,95,189,96,190,96,191,96,191,97,192,97
    DATA  192,98,193,98,193,99,194,99,195,99,195,100,196,100,196,101,197,101,197,102,198,102
    DATA  199,102,199,103,200,103,200,104,201,104,201,105,202,105,202,106,203,106,203,107,204,107
    DATA  204,108,205,108,205,109,206,109,206,110,207,110,207,111,208,111,208,112,208,113,209,113
    DATA  209,114,210,114,210,115,210,116,211,116,211,117,212,117,212,118,213,118,213,119,213,120
    DATA  214,120,214,121,214,122,215,122,215,123,215,124,216,124,216,125,217,125,217,126,217,127
    DATA  218,127,218,128,218,129,218,130,219,130,219,131,219,132,219,133,220,133,220,134,220,135
    DATA  220,136,220,137,221,137,221,138,221,139,222,139,222,140,223,140,223,141,224,141,224,142
    DATA  225,142,225,143,226,143,226,144,227,144,228,144,228,145,229,145,230,145,231,145,231,146
    DATA  232,146,233,146,234,146,234,147,235,147,236,147,237,147,238,147,239,147,240,147,241,147
    DATA  242,147,243,147,244,147,245,147,246,147,247,147,248,147,249,147,250,147,251,147,252,147
    DATA  253,147,253,146,254,146,255,146,256,146,257,146,258,146,259,146,259,145,260,145,261,145
    DATA  262,145,263,145,264,145,264,144,265,144,266,144,267,144,268,144,269,144,269,143,270,143
    DATA  271,143,272,143,273,143,273,142,274,142,275,142,276,142,277,142,277,141,278,141,279,141
    DATA  280,141,281,141,281,140,282,140,283,140,284,140,285,140,285,139,286,139,287,139,288,139
    DATA  289,139,289,138,290,138,291,138,292,138,293,138,294,138,294,137,295,137,296,137,297,137
    DATA  298,137,299,137,300,137,300,136,301,136,302,136,303,136,304,136,305,136,306,136,307,136
    DATA  308,136,309,136,310,136,311,136,312,136,313,136,314,136,315,136,316,136,317,136,318,136
    DATA  318,137,319,137,320,137,321,137,322,137,323,137,324,137,324,138,325,138,326,138,327,138
    DATA  328,138,329,138,330,138,330,139,331,139,332,139,333,139,334,139,335,139,335,140,336,140
    DATA  337,140,338,140,339,140,340,140,341,140,341,141,342,141,343,141,344,141,345,141,346,141
    DATA  347,141,348,141,349,141,350,141,351,141,351,140,352,140,353,140,354,140,355,140,355,139
    DATA  356,139,357,139,357,138,358,138,359,138,359,137,360,137,360,136,361,136,362,136,362,135
    DATA  363,135,364,135,364,134,365,134,365,133,366,133,367,133,367,132,368,132,368,131,369,131
    DATA  369,130,370,130,371,130,371,129,372,129,372,128,373,128,374,128,374,127,375,127,375,126
    DATA  376,126,376,125,377,125,378,125,378,124,379,124,379,123,380,123,381,123,381,122,382,122
    DATA  383,122,383,121,384,121,385,121,386,121,386,120,387,120,388,120,389,120,390,120,390,119
    DATA  391,119,392,119,393,119,394,119,395,119,396,119,397,119,398,119,399,119,400,119,401,119
    DATA  402,119,402,120,403,120,404,120,405,120,406,120,406,121,407,121,408,121,409,121,409,122
    DATA  410,122,411,122,411,123,412,123,413,123,413,124,414,124,415,124,415,125,416,125,417,125
    DATA  417,126,418,126,418,127,419,127,419,128,420,128,420,129,421,129,422,129,422,130,423,130
    DATA  423,131,424,131,424,132,425,132,425,133,426,133,426,134,427,134,427,135,427,136,427,137
    DATA  428,137,428,138,428,139,428,140,429,140,429,141,429,142,429,143,429,144,429,145,429,146
    DATA  430,146,430,147,430,148,430,149,430,150,430,151,430,152,430,153,431,153,431,154,431,155
    DATA  431,156,431,157,431,158,431,159,431,160,432,160,432,161,432,162,432,163,432,164,432,165
    DATA  432,166,432,167,432,168,433,168,433,169,433,170,433,171,433,172,433,173,433,174,433,175
    DATA  433,176,433,177,433,178,433,179,433,180,433,181,433,182,433,183,433,184,433,185,433,186
    DATA  433,187,433,188,432,188,432,189,432,190,432,191,431,191,431,192,431,193,430,193,430,194
    DATA  430,195,429,195,429,196,429,197,428,197,428,198,428,199,427,199,427,200,427,201,426,201
    DATA  426,202,426,203,425,203,425,204,425,205,424,205,424,206,424,207,423,207,423,208,423,209
    DATA  422,209,422,210,422,211,421,211,421,212,420,212,420,213,420,214,419,214,419,215,419,216
    DATA  418,216,418,217,418,218,417,218,417,219,417,220,416,220,416,221,415,221,415,222,415,223
    DATA  414,223,414,224,414,225,413,225,413,226,412,226,412,227,412,228,411,228,411,229,411,230
    DATA  410,230,410,231,409,231,409,232,409,233,408,233,408,234,408,235,407,235,407,236,406,236
    DATA  406,237,406,238,405,238,405,239,404,239,404,240,404,241,403,241,403,242,402,242,402,243
    DATA  402,244,401,244,401,245,400,245,400,246,400,247,399,247,399,248,398,248,398,249,398,250
    DATA  397,250,397,251,396,251,396,252,396,253,395,253,395,254,394,254,394,255,394,256,393,256
    DATA  393,257,393,258,392,258,392,259,392,260,391,260,391,261,391,262,390,262,390,263,390,264
    DATA  389,264,389,265,389,266,388,266,388,267,387,267,387,268,387,269,387,270,387,271,387,272
    DATA  387,273,387,274,387,275,387,276,387,277,387,278,387,279,387,280,387,281,387,282,387,283
    DATA  387,284,387,285,387,286,387,287,387,288,388,288,388,289,388,290,388,291,388,292,388,293
    DATA  388,294,388,295,388,296,387,296,387,297,386,297,386,296,385,296,384,296,384,295,383,295
    DATA  382,295,382,294,381,294,381,293,380,293,380,292,379,292,379,291,379,290,378,290,378,289
    DATA  377,289,377,288,377,287,376,287,376,286,376,285,376,284,375,284,375,283,375,282,375,281
    DATA  374,281,374,280,374,279,374,278,374,277,374,276,373,276,373,275,373,274,373,273,373,272
    DATA  373,271,373,270,373,269,373,268,373,267,373,266,373,265,373,264,373,263,373,262,373,261
    DATA  373,260,373,259,373,258,373,257,373,256,373,255,373,254,373,253,373,252,373,251,374,251
    DATA  374,250,374,249,374,248,374,247,374,246,374,245,374,244,375,244,375,243,375,242,375,241
    DATA  375,240,375,239,376,239,376,238,376,237,376,236,377,236,377,235,377,234,377,233,378,233
    DATA  378,232,378,231,379,231,379,230,379,229,380,229,380,228,380,227,381,227,381,226,381,225
    DATA  381,224,382,224,382,223,382,222,383,222,383,221,383,220,384,220,384,219,385,219,385,218
    DATA  385,217,386,217,386,216,386,215,387,215,387,214,387,213,387,212,388,212,388,211,388,210
    DATA  389,210,389,209,389,208,390,208,390,207,390,206,391,206,391,205,391,204,392,204,392,203
    DATA  392,202,392,201,393,201,393,200,393,199,393,198,394,198,394,197,394,196,394,195,394,194
    DATA  394,193,394,192,394,191,394,190,395,190,395,189,395,188,395,187,395,186,395,185,395,184
    DATA  394,184,394,183,394,182,394,181,394,180,394,179,394,178,394,177,394,176,393,176,393,175
    DATA  393,174,393,173,393,172,392,172,392,171,392,170,392,169,391,169,391,168,391,167,390,167
    DATA  390,166,390,165,389,165,389,164,388,164,388,163,388,162,387,162,387,161,386,161,386,160
    DATA  385,160,385,159,384,159,383,159,383,158,382,158,381,158,381,157,380,157,379,157,378,157
    DATA  378,156,377,156,376,156,375,156,375,155,374,155,373,155,372,155,371,155,370,155,369,155
    DATA  369,154,368,154,367,154,366,154,365,154,364,154,363,154,362,154,361,154,360,154,359,154
    DATA  358,154,357,154,356,154,355,154,354,154,353,154,353,155,353,156,353,157,354,157,354,158
    DATA  354,159,355,159,355,160,355,161,356,161,356,162,356,163,356,164,357,164,357,165,357,166
    DATA  358,166,358,167,358,168,359,168,359,169,359,170,359,171,360,171,360,172,360,173,361,173
    DATA  361,174,361,175,361,176,362,176,362,177,362,178,362,179,363,179,363,180,363,181,363,182
    DATA  364,182,364,183,364,184,364,185,364,186,364,187,365,187,365,188,365,189,365,190,365,191
    DATA  365,192,365,193,365,194,365,195,365,196,365,197,365,198,365,199,365,200,365,201,365,202
    DATA  365,203,365,204,364,204,364,205,364,206,364,207,364,208,363,208,363,209,363,210,362,210
    DATA  362,211,362,212,361,212,361,213,361,214,361,215,360,215,360,216,359,216,359,217,359,218
    DATA  358,218,358,219,357,219,357,220,356,220,356,221,355,221,355,222,355,223,354,223,354,224
    DATA  353,224,353,225,352,225,352,226,351,226,351,227,350,227,350,228,349,228,349,229,348,229
    DATA  348,230,347,230,346,230,346,231,345,231,345,232,344,232,344,233,343,233,343,234,342,234
    DATA  342,235,341,235,341,236,340,236,339,236,339,237,338,237,338,238,337,238,337,239,336,239
    DATA  336,240,335,240,335,241,334,241,334,242,333,242,333,243,332,243,332,244,331,244,331,245
    DATA  330,245,330,246,329,246,329,247,329,248,329,249,329,250,329,251,330,251,330,252,330,253
    DATA  331,253,331,254,331,255,331,256,332,256,332,257,333,257,333,258,333,259,334,259,334,260
    DATA  335,260,335,261,336,261,336,262,336,263,337,263,337,264,338,264,338,265,339,265,339,266
    DATA  339,267,340,267,340,268,341,268,341,269,341,270,342,270,342,271,342,272,343,272,343,273
    DATA  344,273,344,274,344,275,344,276,345,276,345,277,345,278,345,279,345,280,345,281,345,282
    DATA  345,283,345,284,344,284,344,285,344,286,343,286,343,287,343,288,342,288,342,289,341,289
    DATA  341,290,341,291,340,291,340,292,339,292,339,293,338,293,338,294,337,294,337,295,336,295
    DATA  336,296,335,296,335,297,334,297,334,298,333,298,333,299,332,299,332,300,331,300,331,301
    DATA  330,301,330,302,329,302,329,303,328,303,328,304,327,304,326,304,326,305,325,305,325,306
    DATA  324,306,324,307,323,307,323,308,322,308,322,309,321,309,321,310,320,310,320,311,319,311
    DATA  319,312,318,312,318,313,318,314,317,314,317,315,316,315,316,316,315,316,315,317,315,318
    DATA  314,318,314,319,313,319,313,320,313,321,312,321,312,322,312,323,311,323,311,324,310,324
    DATA  310,325,310,326,309,326,309,327,309,328,308,328,308,329,307,329,307,330,306,330,306,331
    DATA  306,332,305,332,305,333,304,333,304,334,303,334,303,335,302,335,302,336,301,336,300,336
    DATA  300,337,299,337,298,337,297,337,297,338,296,338,295,338,295,339,294,339,293,339,293,340
    DATA  292,340,292,341,291,341,291,342,291,343,290,343,290,344,290,345,290,346,289,346,289,347
    DATA  289,348,288,348,288,349,287,349,287,350,286,350,285,350,284,350,283,350,282,350,281,350
    DATA  280,350,279,350,278,350,277,350,276,350,275,350,275,349,274,349,273,349,272,349,271,349
    DATA  271,348,270,348,269,348,269,347,268,347,267,347,267,346,266,346,265,346,265,345,265,344
    DATA  265,343,266,343,266,342,266,341,267,341,267,340,267,339,268,339,268,338,269,338,269,337
    DATA  270,337,270,336,271,336,271,335,272,335,272,334,273,334,274,334,274,333,275,333,276,333
    DATA  276,332,277,332,277,331,278,331,279,331,279,330,280,330,281,330,282,330,282,329,283,329
    DATA  283,328,284,328,285,328,285,327,286,327,287,327,287,326,288,326,288,325,289,325,290,325
    DATA  290,324,291,324,291,323,292,323,292,322,293,322,293,321,294,321,294,320,295,320,295,319
    DATA  296,319,296,318,296,317,297,317,297,316,298,316,298,315,299,315,299,314,300,314,300,313
    DATA  300,312,301,312,301,311,302,311,302,310,303,310,303,309,304,309,304,308,305,308,305,307
    DATA  305,306,306,306,306,305,307,305,307,304,308,304,308,303,309,303,309,302,309,301,310,301
    DATA  310,300,311,300,311,299,312,299,312,298,313,298,313,297,314,297,314,296,314,295,315,295
    DATA  315,294,316,294,316,293,317,293,317,292,317,291,318,291,318,290,319,290,319,289,319,288
    DATA  319,287,320,287,320,286,320,285,320,284,320,283,320,282,320,281,319,281,319,280,319,279
    DATA  319,278,318,278,318,277,318,276,317,276,317,275,317,274,316,274,316,273,316,272,315,272
    DATA  315,271,314,271,313,271,313,272,312,272,312,273,312,274,312,275,312,276,311,276,311,277
    DATA  311,278,310,278,310,279,310,280,310,281,309,281,309,282,308,282,308,283,308,284,307,284
    DATA  307,285,306,285,306,286,305,286,305,287,304,287,304,288,304,289,303,289,303,290,302,290
    DATA  301,290,301,291,300,291,300,292,299,292,299,293,298,293,298,294,297,294,297,295,296,295
    DATA  296,296,295,296,295,297,294,297,294,298,293,298,293,299,292,299,292,300,291,300,291,301
    DATA  290,301,290,302,289,302,289,303,289,304,288,304,288,305,287,305,287,306,286,306,286,307
    DATA  286,308,285,308,285,309,284,309,284,310,284,311,283,311,283,312,282,312,282,313,282,314
    DATA  281,314,281,315,281,316,280,316,280,317,279,317,279,318,279,319,278,319,278,320,278,321
    DATA  277,321,277,322,276,322,276,323,276,324,275,324,275,325,275,326,274,326,274,327,273,327
    DATA  273,328,273,329,272,329,272,330,271,330,271,331,271,332,270,332,270,333,269,333,269,334
    DATA  268,334,268,335,267,335,267,336,267,337,266,337,266,338,265,338,265,339,264,339,264,340
    DATA  263,340,263,341,262,341,261,341,261,342,260,342,260,343,259,343,259,344,258,344,257,344
    DATA  257,345,256,345,256,346,255,346,254,346,254,347,253,347,252,347,252,348,252,349,252,350
    DATA  251,350,251,351,251,352,250,352,249,352,248,352,247,352,246,352,245,352,244,352,243,352
    DATA  242,352,241,352,240,352,239,352,238,352,237,352,236,352,235,352,234,352,233,352,232,352
    DATA  231,352,230,352,229,352,228,352,227,352,226,352,225,352,225,351,226,351,226,350,226,349
    DATA  227,349,227,348,228,348,228,347,229,347,229,346,230,346,230,345,231,345,231,344,232,344
    DATA  232,343,233,343,233,342,234,342,234,341,235,341,235,340,236,340,237,340,237,339,238,339
    DATA  238,338,239,338,239,337,240,337,240,336,241,336,241,335,242,335,243,335,243,334,244,334
    DATA  244,333,245,333,245,332,246,332,246,331,247,331,248,331,248,330,249,330,249,329,250,329
    DATA  251,329,251,328,252,328,252,327,253,327,254,327,254,326,255,326,255,325,256,325,257,325
    DATA  257,324,258,324,258,323,259,323,259,322,260,322,260,321,261,321,261,320,262,320,262,319
    DATA  263,319,263,318,263,317,264,317,264,316,265,316,265,315,266,315,266,314,267,314,267,313
    DATA  267,312,268,312,268,311,269,311,269,310,270,310,270,309,271,309,271,308,271,307,272,307
    DATA  272,306,273,306,273,305,274,305,274,304,274,303,275,303,275,302,276,302,276,301,277,301
    DATA  277,300,277,299,278,299,278,298,279,298,279,297,279,296,280,296,280,295,280,294,281,294
    DATA  281,293,281,292,282,292,282,291,282,290,282,289,283,289,283,288,283,287,284,287,284,286
    DATA  284,285,284,284,284,283,284,282,284,281,284,280,284,279,284,278,284,277,284,276,284,275
    DATA  283,275,283,274,282,274,282,273,282,272,281,272,281,271,281,270,280,270,280,269,279,269
    DATA  279,268,279,267,278,267,278,266,277,266,277,265,277,264,276,264,276,263,275,263,275,262
    DATA  275,261,274,261,274,260,273,260,273,259,273,258,272,258,272,257,271,257,271,256,271,255
    DATA  270,255,270,254,269,254,269,253,269,252,268,252,267,252,267,251,266,251,266,250,265,250
    DATA  265,249,264,249,264,248,263,248,262,248,262,247,261,247,260,247,260,246,259,246,259,245
    DATA  258,245,257,245,256,245,255,245,254,245,253,245,252,245,251,245,250,245,250,246,249,246
    DATA  248,246,247,246,247,247,246,247,245,247,244,247,244,248,243,248,242,248,241,248,241,249
    DATA  240,249,239,249,238,249,237,249,237,250,236,250,235,250,234,250,233,250,232,250,231,250
    DATA  230,250,229,250,228,250,228,251,227,251,226,251,225,251,224,251,223,251,222,251,221,251
    DATA  220,251,219,251,218,251,217,251,216,251,215,251,214,251,213,251,212,251,211,251,210,251
    DATA  209,251,208,251,207,251,206,251,205,251,204,251,203,251,202,251,201,251,200,251,199,251
    DATA  199,252,198,252,198,253,197,253,197,254,197,255,196,255,196,256,195,256,195,257,194,257
    DATA  194,258,194,259,193,259,193,260,192,260,192,261,191,261,191,262,191,263,190,263,190,264
    DATA  189,264,189,265,189,266,188,266,188,267,187,267,187,268,187,269,186,269,186,270,185,270
    DATA  185,271,185,272,184,272,184,273,183,273,183,274,183,275,182,275,182,276,181,276,181,277
    DATA  181,278,180,278,180,279,180,280,179,280,179,281,178,281,178,282,178,283,177,283,177,284
    DATA  177,285,176,285,176,286,176,287,175,287,175,288,174,288,174,289,174,290,173,290,173,291
    DATA  173,292,172,292,172,293,172,294,171,294,171,295,171,296,170,296,170,297,170,298,169,298
    DATA  169,299,169,300,168,300,168,301,168,302,167,302,167,303,167,304,166,304,166,305,166,306
    DATA  166,307,165,307,165,308,165,309,164,309,164,310,164,311,164,312,163,312,163,313,163,314
    DATA  162,314,162,315,162,316,162,317,161,317,161,318,161,319,161,320,160,320,160,321,160,322
    DATA  160,323,159,323,159,324,159,325,159,326,158,326,158,327,158,328,158,329,157,329,157,330
    DATA  157,331,157,332,157,333,156,333,156,334,156,335,156,336,156,337,155,337,155,338,155,339
    DATA  155,340,155,341,155,342,154,342,154,343,154,344,154,345,154,346,153,346,153,347,153,348
    DATA  153,349,152,349,152,350,152,351,151,351,151,352,150,352,149,352,148,352,147,352,146,352
    DATA  145,352,144,352,143,352,142,352,141,352,140,352,139,352,138,352,137,352,136,352,135,352
    DATA  134,352,133,352,132,352,131,352,130,352,129,352,128,352,127,352,126,352,125,352,124,352
    DATA  123,352,122,352,121,352,120,352,119,352,118,352,117,352,116,352,116,351,117,351,118,351
    DATA  118,350,119,350,119,349,120,349,121,349,121,348,122,348,123,348,123,347,124,347,124,346
    DATA  125,346,126,346,126,345,127,345,128,345,128,344,129,344,130,344,130,343,131,343,132,343
    DATA  132,342,133,342,133,341,134,341,135,341,135,340,136,340,136,339,137,339,137,338,138,338
    DATA  138,337,138,336,139,336,139,335,140,335,140,334,140,333,141,333,141,332,141,331,142,331
    DATA  142,330,142,329,142,328,143,328,143,327,143,326,144,326,144,325,144,324,144,323,145,323
    DATA  145,322,145,321,145,320,145,319,146,319,146,318,146,317,146,316,147,316,147,315,147,314
    DATA  147,313,147,312,148,312,148,311,148,310,148,309,148,308,149,308,149,307,149,306,149,305
    DATA  149,304,149,303,150,303,150,302,150,301,150,300,150,299,151,299,151,298,151,297,151,296
    DATA  151,295,151,294,152,294,152,293,152,292,152,291,152,290,153,290,153,289,153,288,153,287
    DATA  154,287,154,286,155,286,155,285,155,284,156,284,156,283,156,282,157,282,157,281,157,280
    DATA  158,280,158,279,158,278,159,278,159,277,159,276,159,275,160,275,160,274,160,273,161,273
    DATA  161,272,161,271,161,270,162,270,162,269,162,268,163,268,163,267,163,266,163,265,164,265
    DATA  164,264,164,263,165,263,165,262,165,261,165,260,166,260,166,259,166,258,167,258,167,257
    DATA  167,256,167,255,168,255,168,254,168,253,169,253,169,252,169,251,170,251,170,250,170,249
    DATA  171,249,171,248,171,247,172,247,172,246,171,246,170,246,170,245,169,245,169,246,168,246
    DATA  167,246,166,246,166,247,165,247,164,247,164,248,163,248,162,248,161,248,161,249,160,249
    DATA  159,249,158,249,158,250,157,250,156,250,155,250,154,250,153,250,152,250,151,250,150,250
    DATA  150,251,149,251,148,251,147,251,146,251,145,251,144,251,143,251,142,251,141,251,140,251
    DATA  139,251,138,251,137,251,136,251,135,251,134,251,133,251,132,251,131,251,130,251,129,251
    DATA  128,251,127,251,126,251,125,251,124,251,123,251,122,251,121,251,120,251,119,251,118,251
    DATA  117,251,116,251,115,251,114,251,113,251,112,251,111,251,110,251,109,251,108,251,107,251
    DATA  106,251,105,251,104,251,103,251,103,252,102,252,102,253,101,253,101,254,100,254,100,255
    DATA  100,256,99,256,99,257,99,258,98,258,98,259,98,260,98,261,97,261,97,262,98,262
    DATA  98,263,98,264,98,265,98,266,99,266,99,267,99,268,100,268,100,269,100,270,101,270
    DATA  101,271,101,272,102,272,102,273,103,273,103,274,103,275,104,275,104,276,105,276,105,277
    DATA  106,277,106,278,107,278,107,279,108,279,108,280,109,280,109,281,110,281,110,282,111,282
    DATA  112,282,112,283,113,283,113,284,114,284,115,284,115,285,116,285,116,286,117,286,117,287
    DATA  118,287,119,287,119,288,120,288,120,289,121,289,122,289,122,290,123,290,123,291,124,291
    DATA  124,292,125,292,125,293,126,293,127,293,127,294,128,294,128,295,129,295,130,295,131,295
    DATA  132,295,132,296,133,296,134,296,135,296,135,297,136,297,137,297,138,297,139,297,139,298
    DATA  140,298,141,298,141,299,142,299,142,300,142,301,143,301,143,302,143,303,144,303,144,304
    DATA  144,305,144,306,144,307,144,308,144,309,144,310,144,311,144,312,143,312,143,313,143,314
    DATA  143,315,142,315,142,316,141,316,141,317,140,317,140,318,139,318,139,319,138,319,137,319
    DATA  136,319,135,319,134,319,133,319,133,318,132,318,131,318,131,317,130,317,130,316,129,316
    DATA  129,315,128,315,128,314,127,314,126,314,126,313,125,313,125,312,124,312,124,311,123,311
    DATA  123,310,122,310,121,310,121,309,120,309,120,308,119,308,119,307,118,307,117,307,117,306
    DATA  116,306,116,305,115,305,114,305,114,304,113,304,112,304,112,303,111,303,110,303,110,302
    DATA  109,302,109,301,108,301,107,301,107,300,106,300,106,299,105,299,105,298,105,297,104,297
    DATA  104,296,103,296,103,295,102,295,102,294,102,293,101,293,101,292,100,292,100,291,99,291
    DATA  99,290,98,290,98,289,98,288,97,288,97,287,96,287,96,286,95,286,95,285,95,284
    DATA  94,284,94,283,93,283,93,282,92,282,92,281,92,280,91,280,91,279,90,279,90,278
    DATA  89,278,89,277,89,276,88,276,88,275,87,275,87,274,86,274,86,273,86,272,85,272
    DATA  85,271,84,271,84,270,83,270,83,269,83,268,82,268,82,267,81,267,81,266,81,265
    DATA  80,265,80,264,79,264,79,263,79,262,78,262,78,261,78,260,78,259,78,258,78,257
    DATA  78,256,78,255,78,254,78,253,78,252,79,252,79,251,79,250,79,249,79,248,80,248
    DATA  80,247,80,246,81,246,81,245,81,244,82,244,82,243,83,243,83,242,84,242,84,241
    DATA  85,241,85,240,86,240,86,239,87,239,88,239,88,238,89,238,90,238,90,237,91,237
    DATA  92,237,92,236,93,236,94,236,95,236,95,235,96,235,97,235,98,235,98,234,99,234
    DATA  100,234,101,234,102,234,102,233,103,233,104,233,105,233,105,232,106,232,107,232,108,232
    DATA  108,231,109,231,110,231,111,231,111,230,112,230,113,230,114,230,114,229,115,229,116,229
    DATA  117,229,118,229,118,228,119,228,120,228,121,228,121,227,122,227,123,227,124,227,124,226
    DATA  125,226,126,226,126,225,127,225,127,224,127,223,126,223,126,222,126,221,126,220,126,219
    DATA  125,219,125,218,125,217,125,216,125,215,125,214,124,214,124,213,124,212,124,211,124,210
    DATA  124,209,124,208,124,207,124,206,124,205,124,204,124,203,124,202,125,202,125,201,125,200
    DATA  125,199,126,199,126,198,126,197,127,197,127,196,127,195,127,194,128,194,128,193,129,193
    DATA  129,192,129,191,130,191,130,190,131,190,131,189,131,188,132,188,132,187,133,187,133,186
    DATA  133,185,134,185,134,184,135,184,135,183,135,182,136,182,136,181,136,180,137,180,137,179
    DATA  138,179,138,178,138,177,139,177,139,176,139,175,140,175,140,174,140,173,141,173,141,172
    DATA  141,171,141,170,142,170,142,169,142,168,142,167,142,166,143,166,143,165,143,164,143,163
    DATA  143,162,143,161,143,160,143,159,143,158,143,157,143,156,143,155,143,154,142,154,142,153
    DATA  142,152,142,151,142,150,142,149,141,149,141,148,141,147,141,146,140,146,140,145,140,144
    DATA  139,144,139,143,139,142,138,142,138,141,138,140,137,140,137,139,136,139,136,138,135,138
    DATA  134,138,134,139,133,139,132,139,132,140,131,140,130,140,130,141,129,141,128,141,128,142
    DATA  127,142,126,142,126,143,125,143,125,144,124,144,123,144,123,145,122,145,122,146,121,146
    DATA  121,147,120,147,119,147,119,148,118,148,118,149,118,150,117,150,117,151,117,152,116,152
    DATA  116,153,116,154,116,155,116,156,116,157,115,157,115,158,115,159,115,160,115,161,115,162
    DATA  115,163,115,164,115,165,114,165,114,166,113,166,113,167,112,167,112,168,111,168,110,168
    DATA  109,168,109,169,108,169,107,169,106,169,105,169,104,169,103,169,102,169,101,169,100,169
    DATA  99,169,99,168,98,168,97,168,96,168,95,168,95,167,94,167,93,167,93,166,92,166
    DATA  91,166,91,165,90,165,90,164,89,164,88,164,88,163,88,162,87,162,87,161,87,160
    DATA  87,159,87,158,86,158,86,157,86,156,86,155,86,154,86,153,86,152,86,151,86,150
    DATA  86,149,86,148,86,147,86,146,86,145,86,144,86,143,86,142,86,141,86,140,86,139
    DATA  86,138,86,137,86,136,86,135,87,135,87,134,88,134,88,133,88,132,89,132,89,131
    DATA  90,131,90,130,90,129,90,128,91,128,91,127,91,126,91,125,92,125,92,124,92,123
    DATA  92,122,92,121,92,120,93,120,93,119,93,118,93,117,93,116,93,115,93,114,93,113
    DATA  93,112,93,111,93,110,93,109,94,109,94,108,94,107,94,106,94,105,94,104,94,103
    DATA  94,102,95,102,95,101,95,100,95,99,95,98,96,98,96,97,96,96,97,96,97,95
    DATA  98,95,98,94,99,94,99,93,100,93,100,92,101,92,101,91,102,91,102,90,103,90
    DATA  103,89,104,89,105,89,105,88,106,88,106,87,107,87,108,87,108,86,109,86,110,86
    DATA  110,85,111,85,111,84,112,84,113,84,113,83,114,83,115,83,116,83,116,82,117,82
    DATA  118,82,118,81,119,81,120,81,121,81,122,81,122,80

'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'"-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

BasicCoder2 · Post by **BasicCoder2** » Jun 29, 2015 4:06

@Tourist Trap,

The bottom line here is your code is simply too complex for me to follow. With some exceptions I only write simple code using the old set of BASIC commands.

Pixel to pixel collisions work fine for simple 2D games but aren't any replacement for the polygon worlds.

The example at the start of this particular thread was just messing about.
For a 2D game this is how I would do it now with a collision layer and sprite "hot spots".
http://www.freebasic.net/forum/viewtopi ... 15&t=22734

Post by **fxm** » Jun 29, 2015 7:10

Yes Tourist Trap, but why put the 'Redim array()' in the loop [For...Next]:

Code: Select all

With hitter                      ''hitter is a SPRITE
     ._x = (_RADIUS - 20) * Cos(sightAngle*_DTOR) + _SCRW\2
       ._y = (_RADIUS - 20) * Sin(sightAngle*_DTOR) + _SCRH\2
       ._w = 4
       ._h = 4
       ._color = RGBA(255, 0, 255, 0)
       ._show = 1
       ._dx = (launcher._centerPoint._x - ._x)/(2*_RADIUS)    'Not >1 for current hittest to work
       ._dy = (launcher._centerPoint._y - ._y)/(2*_RADIUS)
       ._frameNumber = 2
       ReDim Preserve ._img(1 To ._frameNumber)
   For _i As ULong = 1 To ._frameNumber
       ''ReDim Preserve ._img(1 To ._frameNumber)
       ._img(_i) = ImageCreate(._w, ._h, RGBA(255, 0, 255, 0))  
   Next _i
   .BitmapCreateFromDATA(hitter)

    For j As Long = 0 to 3
            For i As Long = 0 to 3
             PSet ._img(2),(i,j), _COLOR._BKG
            Next i
    Next j

End With 'hitter

Post by **fxm** » Jun 29, 2015 7:37

Tourist Trap wrote:
fxm wrote:- Main problem:
Compile with option '-exx' and you will see:
Aborting due to runtime error 6 (out of bounds array access) at line 344 ...
Because when the array _img(1 To _frameNumber) is defined, _frameNumber=1.
After _frameNumber=2 but this array is not resized!
Strange that it has been compiling and running for me. Leave aside some crashes but just at program termination. -In fact I dont need the animated frames, I just tried not to dismantle too much of the original code.

This kind of error (dynamic array out of bounds inducing allocated memory overflow) can be detected only during execution, either by seeing the consequences if occur (bad behavior or crash) or by checking the respect of good bounds by compiling at least one time with the option '-exx', which adds some execution code to check it.

Remark::
The allocated memory overflow (especially a few bytes) may well go unnoticed until an change of OS or compiler (gas / gcc) reveals this error, because of the fact that memory is not allocated in the same way!

[edit]
Corrected typo '-exx' instead of '-eex'.

Tourist Trap · Post by **Tourist Trap** » Jun 29, 2015 10:27

BasicCoder2 wrote: With some exceptions I only write simple code using the old set of BASIC commands.

I see. This still proves very efficent.

BasicCoder2 wrote:

Pixel to pixel collisions work fine for simple 2D games but aren't any replacement for the polygon worlds.

Finally rebounces could maybe be deduced from collision only without global geometry knowledge. However thanks for your initial code, it helped me to learn more about sprites.

fxm wrote:why put the 'Redim array()' in the loop [For...Next]

I've been making this touristically.
In fact I've tried to use the image(2) as an eraser (color = background) but for some reason it woudnt erase properly the sprite at each loop making it dancing like a butterfly due to collisions on its own tracks..

fxm wrote: This kind of error (dynamic array out of bounds inducing allocated memory overflow) can be detected only during execution, either by seeing the consequences if occur (bad behavior or crash) or by checking the respect of good bounds by compiling at least one time with the option '-eex', which adds some execution code to check it.

Thank you. I've configured my build command to include -eex option.

Post by **fxm** » Jun 29, 2015 10:55

Tourist Trap wrote:
fxm wrote: This kind of error (dynamic array out of bounds inducing allocated memory overflow) can be detected only during execution, either by seeing the consequences if occur (bad behavior or crash) or by checking the respect of good bounds by compiling at least one time with the option '-exx', which adds some execution code to check it.
Thank you. I've configured my build command to include -eex option.

The counterpart to compile with the option '-exx' is that the size of the executable code can be increased and also the execution time slowed down as soon as you work with arrays or pointers.
That is why this compiler option may be reserved only for the program development and not for the final version.

[edit]
Corrected typo '-exx' instead of '-eex'.

collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap

Re: collision detection by color overlap