SpriteCollisionDetection

include page="HTML_collaps_page_function" toc =JB Advanced Collision Checking Tutorial= > //by user:AndyAmaya //

(Download this entire tutorial in .doc form, complete with all .bas files and required images at the [|JB Files Archives]).

The objective of this tutorial is to introduce different types of collision checking techniques available, to discuss their possible applications, and to provide working examples. The examples are fully commented and this tutorial explains the logic employed in the more involved routines. Functions and SUBs are used almost exclusively to allow you to copy and paste the collision detecting code into your own programs for further exploration.

The intended audience of this tutorial is a programmer who has a working knowledge of JB and is familiar with the JB sprite collision system. It is hoped that new programmers will also derive benefit from the working examples provided.

Here is a list of the collision detection functions provided in this tutorial:
 * Basic Collision Detection
 * Point In Rectangle
 * Point In Circle
 * Point In Ellipse
 * Point In Triangle
 * Rectangle To Rectangle Collision
 * Circle To Circle Collision
 * Circle To Line Collision
 * Advanced Collision Detection
 * Point In Polygon
 * Polygon To Polygon Collision

Many will be familiar with the basic detection functions. I have included them all to be as thorough as possible in the discussion of collision techniques available to you the programmer. I don’t intend to spend too much time explaining how these familiar functions work, but will comment on how they can be used.

Having said that, let’s “dive in” and familiarize our selves with these collision functions. 

Point In Rectangle Function
This is the simplest and most familiar of the collision detection functions. I’m sure most of you have used something similar to this code. I know that I’ve performed the check directly in code, but have found that I often had to repeat the same lines of code only with different values. When used as a function it becomes as useful as any other intrinsic function (e.g., , , etc…). I can iterate through as many different rectangles as I could possibly wish by storing the rectangle information in an array. Which is exactly what I’ve done in the working example for this function.

A very good use of this function immediately comes to mind. What if you have a large number of irregularly shaped areas on screen to check each time the mouse moves? You would quickly bring any collision detection system to a crawl if you checked all of the graphic entities for each mouse movement. The trick is to divide the screen into quadrants, which are in turn sub-divided into quadrants, and so forth until you can detect collisions without any noticeable slowdown in your program.

This collision function will be the most used of all the collision functions because it allows you to break down complex or numerous collisions into manageable pieces of code. It’s also one of the fastest to evaluate, because when it come to graphics, faster is always better.

Another obvious use would be to create your own (Graphical User Interface) buttons instead of using  buttons.

(Note: all of the “Point In … shape“ functions are great for interestingly shaped buttons however the “Point In Polygon” function can accommodate especially interesting button shapes.)

You can also use “Point In Rectangle” as the basis for a graphical inventory system, or a graphical weapons selection module in a point-n-click RPG.

code format="vbnet" Function pnr(px, py, x, y, w, h) '================================================================= '  Function "Point In Rectangle" '================================================================= ' This function checks to see if the point (px, py) is within the specified rectangle. ' ' If the point IS inside the rectangle a value of 1 is returned. ' ' If the point IS NOT inside the rectangle a value of 0 (zero) is returned. '================================================================= ' px = the X coord of the point in question ' py = the Y coord of the point in question ' x = upper left X coord of rectangle ' y = upper left Y coord of rectangle ' w = width of rectangle ' h = height of rectangle '=================================================================   pnr = ((px>=x) And (px<=(x+w-1)) And (py>=y) And (py<=(y+h-1))) End Function code

As you can see it’s only one line of code that does the job and has been optimized for maximum speed and efficiency.

See Point In Rectangle.Bas for an example on how to implement this function. 

Point In Circle Function
toc This function detects when a point is inside the radius of a given circle.

code format="vbnet" Function pnc(px, py, cx, cy, cr) '================================================================= '  Function "Point In Circle" '================================================================= ' This function checks to see if the point (px, py) is inside the specified circle. ' ' If the point IS inside the circle a value of 1 is returned. ' ' If the point IS NOT inside the circle a value of 0 (zero) is returned. '================================================================= ' px = the X coord of the point in question ' py = the Y coord of the point in question ' cx = center of circle X coordinate ' cy = center of circle Y coordinate ' cr = circle radius ' '=================================================================   'This format is fastest and can be 'inlined' for maximum speed pnc = ( ((px-cx)*(px-cx) + (py-cy)*(py-cy)) <= cr*cr  )

'=================================================================   'This format is more readable ... but slightly slower 'dx2 = (px-cx)*(px-cx) 'dy2 = (py-cy)*(py-cy) 'r2 = cr * cr

'pnc = ( dx2 + dy2 < r2) End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Point In Circle Function.Bas to get an idea of how to use this function. 

Point In Ellipse Function
toc This function detects when a point is inside of an ellipse.

code format="vbnet" Function pne(px, py, ex, ey, ew, eh) '================================================================= '  Function "Point In Ellipse" '================================================================= ' This function checks to see if the point (px, py) is inside the specified ellipse. ' ' If the point IS inside the ellipse a value of 1 is returned. ' ' If the point IS NOT inside the ellipse a value of 0 (zero) is returned. '================================================================= ' px = the X coordinate of the point in question ' py = the Y coordinate of the point in question ' ex = ellipse center X coordinate ' ey = ellipse center Y coordinate ' ew = ellipse width ' eh = ellipse height ' '=================================================================   'This format is fastest and can be 'inlined' for maximum speed pne = ((px-ex)*(px-ex)/((ew/2)*(ew/2))+(py-ey)*(py-ey)/((eh/2)*(eh/2))<1)

'=================================================================   'This format is more readable ... but slightly slower 'dx = (px - ex) * (px - ex) 'dy = (py - ey) * (py - ey) 'ew2 = (ew/2)*(ew/2) 'eh2 = (eh/2)*(eh/2)

'pne = (dx/ew2 + dy/eh2 <= 1) End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Point In Ellipse Function.Bas to get an idea of how to use this function. 

Point In Triangle Function
This detects when a point is inside of a triangle.

code format="vbnet" Function pnt(px,py, x1,y1, x2,y2, x3,y3) '================================================================='  '  Function "Point In Triangle" '================================================================= ' This function checks to see if the point (px,py) is within the specified triangle. ' ' If the point IS inside the triangle a value of 1 is returned. ' ' If the point IS NOT inside the triangle a value of 0 (zero) is returned. '================================================================= ' px = the X coord of the point in question ' py = the Y coord of the point in question ' x1, y1 = first triangle vertex ' x2, y2 = second triangle vertex ' x3, y3 = third triangle vertex '=================================================================   b0 =  (x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1) b1 = ((x2 - px) * (y3 - py) - (x3 - px) * (y2 - py)) / b0   If b1 <= 0 Then pnt = 0 : Exit Function b2 = ((x3 - px) * (y1 - py) - (x1 - px) * (y3 - py)) / b0   If b2 <= 0 Then pnt = 0 : Exit Function b3 = ((x1 - px) * (y2 - py) - (x2 - px) * (y1 - py)) / b0   If b3 <= 0 Then pnt = 0 : Exit Function pnt = 1 End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Point In Triangle Function.Bas to get an idea of how to use this function. 

Rectangle To Rectangle Function
toc This function checks to see if two rectangles have collided. This is the same collision detection that the JB sprite system uses to detect when sprites have collided. You can use this “Rectangle To Rectangle” collision detection using pictures, boxes, or anything else that is rectangular and doesn’t need transparency.

Oh, and it’s also good for “drag and drop” interfaces.

code format="vbnet" Function r2r(ax, ay, aw, ah, bx, by, bw, bh) '================================================================= '  Rectangle To Rectangle Collision Function '================================================================= ' This function checks to see if two rectangles have collided. ' ' If the rectangles HAVE COLLIDED a non-zero value is returned. ' ' If the rectangles HAVE NOT COLLIDED a value of 0 (zero) is returned. ''================================================================= ' ax = upper left X coordinate of rectangle "a" ' ay = upper left Y coordinate of rectangle "a" ' aw = width of rectangle "a" ' ah = height of rectangle "a"

' bx = upper left X coordinate of rectangle "b" ' by = upper left Y coordinate of rectangle "b" ' bw = width of rectangle "b" ' bh = height of rectangle "b" ' 'NOTE: negative coordinate values will return non-valid results. '=================================================================   'This format is fastest and can be 'inlined' for maximum speed r2r =(((((bx+bw-1)-ax) Xor (bx-(ax+aw-1))) And _ ((by-(ay+ah-1)) Xor ((by+bh-1)-ay))) And 2147483648) '=================================================================   'This format is more readable... but slightly slower

'ax2 = ax + aw - 1 'ay2 = ay + ah - 1 'bx2 = bx + bw - 1 'by2 = by + by - 1

'a = (bx2 - ax) Xor (bx - ax2) 'b = (by - ay2) Xor (by2 - ay) 'c = 2147483648 		'c = &H80000000 'r2r = (a And b) And c End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Rectangle To Rectangle Function.Bas to get an idea of how to use this function. 

Circle To Circle Function
This function determines when two circles have collided.

code format="vbnet" Function c2c(ax, ay, ar, bx, by, br) '================================================================= '  Circle To Circle Collision Function '================================================================= ' This function checks to see if the two circles have collided. ' ' If the circles HAVE COLLIDED a value of 1 is returned. ' ' If the circles HAVE NOT COLLIDED a value of 0 (zero) is returned. '================================================================= ' ax = center X coordinate of circle "a" ' ay = center Y coordinate of circle "a" ' ar = radius of circle "a" ' bx = center X coordinate of circle "b" ' by = center Y coordinate of circle "b" ' br = radius of circle "b" '=================================================================   c2c = (((ar + br) * (ar + br)) > ((ax - bx) * (ax - bx) + (ay - by) * (ay - by))) End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Circle to Circle Function.Bas to get an idea of how to use this function. 

Circle To Line Function
This function determines when a circle and a line segment collide. A few possible uses come immediately to mind, such as a bumper pool game, miniature golf game, or a pinball game.

code format="vbnet" Function c2L(x1, y1, x2, y2, cx, cy, cr) '================================================================= ' Circle To Line Function '================================================================= ' This function checks if a circle has collided with a line ' ' c2L returns a 1 if the circle has collided with the line ' ' c2L returns a 0 (zero) if no collision has occurred '================================================================= ' x1, y1, x2, y2 are the two coordinates defining the line to check ' ' cx, cy are the coordinates of the center of the circle ' cr is the radius of the circle '=================================================================

d = (x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1) If d <> 0 Then d = ((cx - x1) * (x2 - x1) + (cy - y1) * (y2 - y1)) / d   'Clip To the line segments legal bounds If d < 0.0 Then d = 0 If d > 1.0 Then d = 1 dx = cx - ( (x2 - x1) * d + x1) dy = cy - ( (y2 - y1) * d + y1) c2L = (dx * dx + dy * dy <= cr * cr) End Function code

The detection code has been optimized for maximum speed and efficiency.

Run the code Circle To Line Function.Bas to get an idea of how to use this function.

The seven basic collision detection functions are very simple but do not underestimate their usefulness, under the proper circumstances they are the most efficient routines available.

It’s always going to be a trade off between ease of use (complexity) and resources (CPU or memory or both), yet the next two collision routines while not quite as simple are still fairly fast. 

Point In Polygon Function
toc This function detects when a point is on the inside of a user-defined polygon. Since the number of sides of the polygon can be huge, you have a great deal of freedom in creating polygons of just about any shape and size.

Up until now, the most we’ve had to deal with is four points as in “Point In Rectangle”. This next function can process a minimum of three points and a practical maximum of 500 points! It’s obvious that we’ll need to come up with a logical procedure for dealing with the entire range of possibilities.

This means that we’ll need to store and access every single pair of coordinates that define the polygon, so naturally we’ll have to resort to using an array to store all those coordinates. Another implication is that we’ll need to either store those coordinates in data statements or read them in from a disk file to fill all the elements of the array. Don’t worry it’s all been taken care of, but we’ll need to discuss how it’s all laid out so you can use this function in your own programs.

First things first, we must define what a polygon is and is not. Here’s our definition of a polygon:

A polygon is a collection of any three or more non-collinear points.

Which means you can have points that are collinear as long as at least three of the points that define the polygon are not collinear.

This is definitely a case where a picture is worth at least a thousand words. As illustrated in the figure 1 below, you can create an infinite variety of shapes that meet the requirements of the polygon definition stated above.



The one thing that you’ll want to keep in mind is that the more points required to define the polygon, the more time it will take your computer to display and/or check the polygon. If you only need to display or check one polygon with a large number of vertices (i.e. the point where two sides converge), you shouldn’t notice a significant slow down. However, if you have several polygons with a high number of vertices or hundreds of polygons with a low number of vertices displayed at the same time, you will notice a significant slow down when checking for collisions.

Now that we have the definition for a polygon, we’ll need to consider how to utilize an array to store the X-Y coordinate pairs defining a polygon.

Let’s start by defining the information required to describe the polygon.
 * 1) The number of vertices used to define the polygon. This will allow us to use For…Next loops to iterate through the vertices defining the polygon.
 * 2) The amount of offset in the X and Y directions for the upper-left bounding box corner of the polygon, so that we can locate the polygon anywhere on the screen the same as we do with sprites.
 * 3) The bounding box’s upper-left corner and the width and height of the bounding box which will allow us to quickly check for collision events even when sprites are not used.
 * 4) The list of X-Y coordinate pairs locating the vertices of the polygon.

In all of the example code I use an array named “poly”. In describing the details of the polygon storage we’ll use the same array name.

To help understand the logic used to populate the poly array, I refer you to figure 2, which shows all of the required information to define a polygon. In this case the polygon is a triangle to keep things simple.




 * 1) The number of vertices defining the polygon = 3
 * 2) The X & Y offsets default to 0,0 (you will locate the polygon in your program as necessary)
 * 3) The bounding box width is 11 – 0 + 1 = 12     (pixels 0 – 11 inclusive)
 * 4) The bounding box height is 10 – 0 + 1 = 11    (pixels 0 – 10 inclusive)
 * 5) The list of coordinate pairs are:  0,0    11,10    0,10   (3 pairs of coordinates = 3 vertices)

Note: all polygon bounding box upper-left corners are located at 0,0 when they are initially defined so that we can later place them anywhere on screen just as we do with sprites in JB. Please keep this in mind when laying out a polygon in your own program.

If you choose not to do so, you will have to hard code the location of your polygon yourself.

The first array dimension will hold the “index” number of the polygon. This will allow you to access any polygon by index number.

Since JB only allows two-dimensional arrays, we will lay out the polygon information as follows:

Note - the total array space required to store a polygon is determined by the following formula:
 * [[image:WikiFiller40.PNG]]||Index number = 1||[[image:WikiFiller40.PNG]]||‘since it’s the first polygon defined||
 * [[image:WikiFiller40.PNG]]||poly(1, 0) = 3 ||[[image:WikiFiller40.PNG]]||‘number of vertices||
 * [[image:WikiFiller40.PNG]]||poly(1, 1) = 0	||[[image:WikiFiller40.PNG]]||‘X offset    The actual X offset will be determined in your program||
 * [[image:WikiFiller40.PNG]]||poly(1, 2) = 0	||[[image:WikiFiller40.PNG]]||‘Y offset    The actual Y offset will be determined in your program||
 * [[image:WikiFiller40.PNG]]||poly(1, 3) = 12||[[image:WikiFiller40.PNG]]||‘The bounding box is 12 pixels wide||
 * [[image:WikiFiller40.PNG]]||poly(1, 4) = 11||[[image:WikiFiller40.PNG]]||‘The bounding box is 11 pixels tall||
 * [[image:WikiFiller40.PNG]]||poly(1, 5) = 6	||[[image:WikiFiller40.PNG]]||‘The X coordinate for vertex 1||
 * [[image:WikiFiller40.PNG]]||poly(1, 6) = 0	||[[image:WikiFiller40.PNG]]||‘The Y coordinate for vertex 1||
 * [[image:WikiFiller40.PNG]]||poly(1, 7) = 11||[[image:WikiFiller40.PNG]]||‘The X coordinate for vertex 2||
 * [[image:WikiFiller40.PNG]]||poly(1, 8) = 10||[[image:WikiFiller40.PNG]]||‘The Y coordinate for vertex 2||
 * [[image:WikiFiller40.PNG]]||poly(1, 9) = 0	||[[image:WikiFiller40.PNG]]||‘The X coordinate for vertex 3||
 * [[image:WikiFiller40.PNG]]||poly(1, 10) = 10||[[image:WikiFiller40.PNG]]||‘The Y coordinate for vertex 3||
 * [[image:WikiFiller40.PNG]]||poly(1, 10) = 10||[[image:WikiFiller40.PNG]]||‘The Y coordinate for vertex 3||

Number of vertices * 2 + 4 = highest array element required in second dimension

So we would need to the poly array as …‘ poly(1,10)’     (1 polygon, 3 vertices * 2 + 4 = 10) for the example polygon shown in figure 2.

With 20 polygons, and the largest of the 20 polygons having 28 vertices you would need to the poly array as …’ poly(20, 60)    (20 polygons, 28 vertices * 2 + 4 = 60).

Here’s the code snippet that loads the polygon data from the example above into the poly array.

code format="vbnet" Dim poly(1,10) numPolys = 1 '...   Restore [polygonData] For i = 1 To numPolys Read numVerts, locX, locY, wide, high poly(i,0) = numVerts poly(i,1) = locX poly(i,2) = locY poly(i,3) = wide poly(i,4) = high

For j = 5 To numVerts*2 + 3 Step 2 Read x, y           poly(i, j)   = x            poly(i,j+1) = y        Next j    Next I '... [polygonData] Data 3		‘number of vertices Data 0, 0	‘locX, locY	‘use just like you would SpriteXY Data 12	‘bounding box width Data 11	‘bounding box height Data 6,0, 11,10,  0,10 	‘the 3 vertex coordinate pairs code

That’s all there is to placing the vertices in the poly array. Obviously you wouldn’t want to have to enter all of the polygon vertices by hand as that would become extremely tedious and prone to error. So I’ve written a very simple “Polygon Editor” (see “Polygon Editor.bas”).

That sums up the way we’re going to store the polygon information in the poly array. At long last we’re ready to implement the “Point In Polygon” function.

code format="vbnet" Function pnp(idx, x, y) '=============================================================== ' Function “Point In Polygon” '=============================================================== ' This function checks to see if a point is inside the polygon indicated by ‘idx’. ' ' If the point IS inside the polygon a value of 1 is returned. ' ' If the point IS NOT inside the polygon a value of 0 (zero) is returned. '=============================================================== ' idx – is the index of the polygon coordinates to check ' x, y are the coordinates being checked (in or out of polygon) '===============================================================   'lastX is the last X coordinate defining current polygon lastX = poly(idx, 0) * 2 + 3	'lastY = poly(idx, 0) * 2 + 4 'assign X-offset to 'oX   oX = poly(idx,1) 'assign X-offset to 'oY   oY = poly(idx,2) 'loop through all of the points defining current polygon For i = 5 To lastX Step 2 If i = lastX Then j = 5 Else j = (i+2) v1 = (poly(idx, i + 1) + oY) <= y       v2 = y < (poly(idx, j + 1) + oY) v3 = (poly(idx, j + 1) + oY) <= y       v4 = y < (poly(idx, i + 1) + oY) v5 = (( (poly(idx,j  ) + oX)) - (poly(idx, i)+oX)) * (y - (poly(idx, i + 1) + oY)) v6 = ((poly(idx,j + 1) + oY)) - (poly(idx, i + 1)+oY) If v6 = 0.0 then v6 = 0.0001 v7 = poly(idx, i) + oX       If (((v1 And v2)) Or (v3 And v4)) And (x < v5 / v6 + v7)) Then pnp = 1 - pnp    Next i End Function code

For a working example of the Point In Polygon function run Point In Polygon.Bas.

I’m going to digress slightly by showing you two supporting routines that we may or may not use, but nice to have in our toolbox just the same.

One of those routines is a SUB to draw the polygon on screen. This could be used as a stand-alone graphic routine or as tool to visually debug a program that uses polygons in collision detection.

code format="vbnet" Sub drawPoly h$, index '=============================================================== ' Function “Draw A Polygon” '=============================================================== ' This function draws the polygon indicated by ‘index’ ' '=============================================================== ' h$ is the string representing the graphics handle used in your program ' ' index – indicates which polygon will be drawn on screen '===============================================================	lastX = poly(index,0) * 2 + 3	‘lastY would be poly(index, 0) * 2 + 4 oX = poly(index, 1)		‘offset X value allows place anywhere on screen oY = poly(index, 2)		‘offset Y value allows place anywhere on screen #h$ “Place “;poly(index, 5)+oX;” “;poly(index, 6)+oY For i = 7 To lastX Step 2 #h$ “Goto “;poly(index, i)+oX;” “;poly(index, i + 1)+oY Next I	#h$ “Goto “;poly(index,5)+oX;” “;poly(index, 6)+oY End Sub code

Another useful routine would be a SUB for moving a polygon to a new location on screen in much the same way the JB command locates sprites.

code format="vbnet" Sub movePoly index, x, y '=============================================================== ' Function “Move A Polygon” '=============================================================== ' This function changes the location of where a polygon will be drawn or used on screen. ' '=============================================================== ' index – indicates which of the polygons move ' x, y are the new coordinates where the polygon will be moved '===============================================================	poly(index, 1) = x	poly(index, 2) = y End Sub code

Ok, with that out of the way, let’s get back on track. 

Polygon to Polygon
Now that it’s understood how the “Point In Polygon” function works using the poly array to store the vertex coordinates, we’re going to extend it’s usefulness by cycling through the coordinates of a small polygon and use the “Point In Polygon” (hereafter referred to as PNP) function to see if it is inside of another (larger) polygon. The result is that we’ll have a “Polygon To Polygon” (hereafter referred to as P2P) collision detection function.

The main drawback to the P2P function is that if we exceed a certain number of comparisons per frame of graphics display, we will encounter a slight to significant slow down. What that threshold is will depend on the speed of your CPU and graphics subsystem. It is suggested that you work with a conservative number of vertices and/or comparisons to ensure that a large portion of your intended audience is able to use this type of collision detection code with out noticeable or significant slow down. Another strategy is to use the “Rectangle To Rectangle” collision function to see if the bounding boxes of the two polygons have collided. It’s a very fast function reducing the area of the screen you’ll need to check. If there is a collision, you can then check for a collision using the more computationally intensive P2P function. Utilizing both strategies in tandem will give you the best performance.

code format="vbnet" Function p2p(index1, index2) '=============================================================== ' Function “Polygon To Polygon” collision '=============================================================== ' This function checks to see if polygon1 has collided with polygon2. ' Typical usage is to check a polygon with a small number of vertices against a ' polygon with the same or larger number of vertices. ' ' If the polygons have collided a value of 1 is returned. ' ' If the polygons have not collided a value of 0 (zero) is returned. ' '     ***** Note: This function is dependent upon Point In Polygon Function ***** '=============================================================== ' index1 – indicates the first polygon to use for collision checking ' index2 – indicates the second polygon to use for collision checking '=============================================================== numVerts = poly(index1, 0)	'number of vertices in polygon (index1) oX = poly(index1, 1)		'current X-coordinate offset of polygon (index1) oY = poly(index1, 2)		'current Y-coordinate offset of polygon (index1) For i = 5 To numVerts * 2 + 3 Step 2 p2p = pnp(poly(index1, i) + oX, poly(index1, i+1) + oY, index2) If p2p = 1 Then Exit For	'If a vertex is inside polygon (index2) then exit from For…Next loop Next i End Function code toc 

A Polygon Editor
You can use this editor to store a set of polygon points into a sequential file.

include page="HTML_div_PolygonEditorAmaya" include page="PolygonEditorAmaya" include page="HTML_div_close"

The whole reason this tutorial came into being is because of a question asked on the [|JustBASIC Forum]. Here’s a paraphrased version of the question: “How do I allow my character sprite to cross a bridge spanning a meandering river and still keep my character sprite from entering the river?” I refer to this question as “flaxen’s dilemma”. (see figure 3 below)



This is a perfect situation to utilize some of the collision techniques we’ve studied; “Rectangle To Rectangle” (R2R), “Point In Polygon” (PNP), and “Polygon To Polygon” (P2P). We just need to make a few preparations before we start coding the solution to “flaxen’s dilemma”.

First of all, using the Polygon Editor, we’ll trace the character sprite with a polygon that keeps the character sprite from entering the river, and trace both the left and the right sides of the river with polygon boundaries that the character sprite polygon will not cross.

After tracing the polygons and pressing the “Save Data” for each of the polygon’s, we need to DIM the poly array and allot enough memory to store all three polygons.

Then we’ll need to read the data statements to load the polygon vertices into the poly array.

Lastly, let’s copy and paste the functions necessary to complete the task.

Jump to the Flaxen's Dilemma code

Well, that wraps up this collision tutorial. Here are three tips that summarize the use of these collision functions in your own programs.


 * 1) Do all of your calculations outside of the graphics rendering loop whenever possible.
 * 2) Minimize the number of collisions you check during each frame of graphics.
 * 3) If there are many collisions to check during each frame of graphics, try to implement a divide and conquer strategy to keep the number of collision checks to a minimum.

Polygon Editor Instructions:
 * 1) Load the .bmp over which you’re going to overlay the polygon.
 * 2) Now zoom in to the appropriate level to make it easier to place the vertices accurately. Do this by double-clicking the desired zoom level.
 * 3) Name the polygon to something other than “noName”.
 * 4) Press the “Plot Points” button and left-click at the location you wish to place a polygon vertex.
 * 5) Continue in this fashion until there are no more vertices to place.
 * 6) Now right-click in the drawing area to “close” the polygon.
 * 7) Press the “Save Data” button. If you have done everything properly, a data file will have been written to the same directory that the “Polygon Editor” is in.
 * 8) Exit the “Polygon Editor”, and open the data file. Copy the data from number of vertices to the end of the list of polygon coordinates and paste into your program.



The .BAS Examples
toc Download the entire [|JB Advanced Sprite Collision Tutorial], complete with example .bas files and required demo images, or copy and paste the following examples. 

Point in Rectangle
code format="vbnet" '======================================= '    Title: Point In Rectangle Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '=======================================   NoMainWin '================================ Globals ================================== Global sw, sh, r2d '===========================================================================

'=========================== Arrays ======================================== Dim rect(100,3)   'make room for the storage of 100 rectangles numRects = 20     '100 max unless rect DIM'ed for more rectangles '===========================================================================

Gosub [setupGraphics] Gosub [makeRects]

'===========================================================================   #g "SetFocus; when mouseMove [checkRects]; when leftButtonDown [xit]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight= sh    UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Point In Rectangle Function" For Graphics_nf_nsb As #g #g "Down; Fill blue; TrapClose [xit]" '=========================================================================== Return

[makeRects] For i = 1 To numRects 'random widths and heights w = rand(20,40) h = rand(20,40) 'random upper left corner locations on screen x = rand(10,sw-w-6) y = rand(20,sh-h-31) 'store the info for each rectangle in the rect array rect(i,0) = x       rect(i,1) = y        rect(i,2) = w        rect(i,3) = h        'draw the rectangle and show index number of each rectangle #g "BackColor white; Color black" #g "Place ";x;" ";y;";BoxFilled ";x+w-1;" ";y+h-1 #g "Color black ;Place ";x+4;" ";y+14;";\";i Next #g "Flush" Return

[checkRects] mx = MouseX : my = MouseY 'check for message If boxFlag = 1 Then 'erase the last message #g "Color blue; BackColor blue" #g "Place 10 5;BoxFilled 164 23" boxFlag = 0 End If

'loop through all rectangles in rect array For i = 1 To numRects 'is the mouse in one of the rectangles? If pnr(mx, my, rect(i,0), rect(i,1), rect(i,2), rect(i,3)) = 1 Then #g "Color white;BackColor red" #g "Place 10 20;\ Mouse in rectangle ";i;" " 'remember that a message has been printed boxFlag = 1 'exit the For...Next loop Exit For End If   Next Wait

Function pnr(px, py, ax, ay, aw, ah) '==================================================================================== '  Function "Point In Rectangle" '==================================================================================== ' This function checks to see if the point (px,py) is within the specified rectangle. ' ' If the point is inside the rectangle a value of 1 is returned. ' ' If the point is not inside the rectangle a value of 0 (zero) is returned. '==================================================================================== ' px = the X coord of the point in question ' py = the Y coord of the point in question ' ax = upper left X coord of rectangle "a" ' ay = upper left Y coord of rectangle "a" ' aw = width of rectangle "a" ' ah = height of rectangle "a" '====================================================================================   pnr = ((px>=ax) And (px<=(ax+aw-1)) And (py>=ay) And (py<=(ay+ah-1))) End Function

'====================================================== ' rand returns a random integer between loNum and hiNum '====================================================== Function rand(loNum,hiNum) rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function

Function pointInRect(iPointX,iPointY,iXPos1,iYPos1,iXPos2,iYPos2)

'   Return ((((iPointX-iXPos1) Xor (iPointX-iXPos2))  And _ '            ((iPointY-iYPos1) Xor (iPointY-iYPos2))) And 2147483648) End Function

Function pNr(px, py, rx, ry, rw, rh) rx2 = rx+rw-1 ry2 = ry+rh-1 a = (px-rx) Xor (px-(rx+rw-1)) b = (py-ry) Xor (py-(ry+rh-1))

pNr = (a And b And 2147483648) End Function

'Function pnt(x0,y0,x1,y1,x2,y2,x3,y3) ' '   b0# =  (x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1) '   b1# = ((x2 - x0) * (y3 - y0) - (x3 - x0) * (y2 - y0)) / b0 '    If b1 <= 0 Then Return False ' '   b2# = ((x3 - x0) * (y1 - y0) - (x1 - x0) * (y3 - y0)) / b0 '    If b2 <= 0 Then Return False ' '   b3# = ((x1 - x0) * (y2 - y0) - (x2 - x0) * (y1 - y0)) / b0 '    If b3 <= 0 Then Return False ' '   Return True ' 'End Function

'Function pnt(px,py, x1,y1, x2,y2, x3,y3) ' '   b0 =  (x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1) '   b1 = ((x2 - px) * (y3 - py) - (x3 - px) * (y2 - py)) / b0 '    b2 = ((x3 - px) * (y1 - py) - (x1 - px) * (y3 - py)) / b0 '    b3 = ((x1 - px) * (y2 - py) - (x2 - px) * (y1 - py)) / b0 ' '   pnt = (b1>0 And b2>0 And b3>0 ) ' 'End Function

Function pnt(px,py, x1,y1, x2,y2, x3,y3)

b0 = (x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1) b1 = ((x2 - px) * (y3 - py) - (x3 - px) * (y2 - py)) / b0   If b1 <= 0 Then pnt2 = 0 : exit function

b2 = ((x3 - px) * (y1 - py) - (x1 - px) * (y3 - py)) / b0   If b2 <= 0 Then pnt2 = 0 : exit function

b3 = ((x1 - px) * (y2 - py) - (x2 - px) * (y1 - py)) / b0   If b3 <= 0 Then pnt2 = 0 : exit function

pnt2 = 1 End Function code toc 

Point in Circle
code format="vbnet" '======================================= '    Title: Point In Circle Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '=======================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== Dim circ(100,2)   'make room for the storage of 100 circles numCircs = 20     '100 max unless circ DIM'ed for more circles '===========================================================================

Gosub [setupGraphics] Gosub [makeCircs]

'===========================================================================   #g "SetFocus; when mouseMove [checkCircs]; when leftButtonDown [xit]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight = sh    UpperLeftX = (DisplayWidth-sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Point In Circle Function" For Graphics_nf_nsb As #g #g "Down; Fill blue; TrapClose [xit]" '=========================================================================== Return

[makeCircs] For i = 1 To numCircs 'random radii r = rand(12,20) 'random circle center coords x = rand(r,sw-r-6) y = rand(r+r,sh-r-31) 'store the info for each circle in the circ array circ(i,0) = x       circ(i,1) = y        circ(i,2) = r        'draw the circle and show index number of each circle #g "BackColor white; Color black" #g "Place ";x;" ";y;";CircleFilled ";r #g "Color black ;Place ";x-7;" ";y+5;";\";i Next #g "Flush" Return

[checkCircs] mx = MouseX : my = MouseY 'check for message If boxFlag = 1 Then 'erase the last message #g "Color blue; BackColor blue" #g "Place 10 5;BoxFilled 140 23" boxFlag = 0 End If

'loop through all circles in circ array For i = 1 To numCircs 'is the mouse in one of the circles? If pnc(mx, my, circ(i,0), circ(i,1), circ(i,2)) = 1 Then #g "Color white;BackColor red" #g "Place 10 20;\ Mouse in circle ";i;"  " 'remember that a message has been printed boxFlag = 1 'exit the For...Next loop Exit For End If   Next Wait

Function pnc(px, py, ax, ay, ar) '==================================================================================== '  Function "Point In Circle" '==================================================================================== ' This function checks to see if the point (px,py) is inside the specified circle. ' ' If the point is inside the circle a value of 1 is returned. ' ' If the point is not inside the circle a value of 0 (zero) is returned. '==================================================================================== ' px = the X coord of the point in question ' py = the Y coord of the point in question ' ax = X coord of center of circle "a" ' ay = Y coord of center of circle "a" ' ar = radius of circle "a" ' '====================================================================================   pnc = (((px-ax)*(px-ax) + (py-ay)*(py-ay)) <= ar*ar) End Function

'====================================================== ' rand returns a random integer between loNum and hiNum '====================================================== Function rand(loNum,hiNum) rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code 

Point in Ellipse
code format="vbnet" '======================================= '    Title: Point In Ellipse Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '=======================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== numOvals = 20      'number of ovals Dim oval(100,3)    'allocate array space for ovals '===========================================================================

Gosub [setupGraphics] Gosub [makeOvals]

'===========================================================================   #g "SetFocus; when mouseMove [checkOvals]; when leftButtonDown [xit]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight = sh    UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Point In Ellipse Function" For Graphics_nf_nsb As #g #g "Down; Fill blue; TrapClose [xit]" '=========================================================================== Return

[makeOvals] For i = 1 To numOvals 'random width and height of the ellipse w = rand(25,50) h = rand(25,40) 'random ellipse center coords x = rand( w,sw-w-6) y = rand(40,sh-h-31) 'store the info for each ellipse in the oval array oval(i,0) = x       oval(i,1) = y        oval(i,2) = w        oval(i,3) = h        'draw the ellipse and show index number of each ellipse #g "BackColor white; Color black" #g "Place ";x;" ";y;";EllipseFilled ";w;" ";h #g "Color black ;Place ";x-7;" ";y+5;";\";i Next #g "Flush" Return

[checkOvals] mx = MouseX : my = MouseY 'check for message If boxFlag = 1 Then 'erase the last message #g "Color blue; BackColor blue" #g "Place 10 5;BoxFilled 150 23" boxFlag = 0 End If

'loop through all ellipses in oval array For i = 1 To numOvals 'is the mouse in one of the ellipses? If pne(mx, my, oval(i,0), oval(i,1), oval(i,2), oval(i,3)) = 1 Then #g "Color white;BackColor red" #g "Place 10 20;\ Mouse in ellipse ";i;"  " 'remember that a message has been printed boxFlag = 1 'exit the For...Next loop Exit For End If   Next Wait

Function pne(px, py, ex, ey, ew, eh) '==================================================================================== '  Function "Point In Ellipse" '==================================================================================== ' This function checks to see if the point is inside the specified ellipse. ' ' If the point is inside the ellipse a value of 1 is returned. ' ' If the point is not inside the ellipse a value of 0 (zero) is returned. '==================================================================================== ' px = the X coord of the point in question ' py = the Y coord of the point in question ' ex = X coord for center of ellipse ' ey = Y coord for center of ellipse ' ew = width of ellipse ' eh = height of ellipse ' '====================================================================================   'This format is fastest and can be 'inlined' for maximum speed pne = ((px-ex)*(px-ex)/((ew/2)*(ew/2))+(py-ey)*(py-ey)/((eh/2)*(eh/2))<1)

'====================================================================================   'This format is more readable ... but slightly slower 'dx = (px - ex) * (px - ex) 'dy = (py - ey) * (py - ey) 'ew2 = (ew/2)*(ew/2) 'eh2 = (eh/2)*(eh/2)

'pne = (dx/ew2 + dy/eh2 < 1) End Function

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code toc 

Point in Triangle
code format="vbnet" '======================================= '    Title: Point In Triangle Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '=======================================   NoMainWin '================================ Globals ================================== Global sw, sh, r2d r2d = Acs(-1)/180.0 '===========================================================================

'=========================== Arrays ======================================== numTris = 20 Dim tri(numTris,5)   'allocate array space for triangles '===========================================================================

Gosub [setupGraphics] Gosub [makeTris]

'===========================================================================   #g "SetFocus; when mouseMove [checkTris]; when leftButtonDown [xit]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight= sh    UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Point In Rectangle Function" For Graphics_nf_nsb As #g #g "Down; Fill blue; TrapClose [xit]" '=========================================================================== Return

[makeTris] For i = 1 To numTris 'random radius of 30-40 (no triangle will be bigger than 80 pixels) tr = rand(30,40) 'random center of triangle x = rand(10,sw-tr-6) : y = rand(40,sh-tr-31) a1 = rand(240, 299) 'rand(210,329) a2 = rand(360, 419) 'rand(330,449) a3 = rand(120, 179) 'rand( 90,209) x1 = Cos(a1*r2d)*tr + x : y1 = Sin(a1*r2d)*tr + y       x2 = Cos(a2*r2d)*tr + x : y2 = Sin(a2*r2d)*tr + y        x3 = Cos(a3*r2d)*tr + x : y3 = Sin(a3*r2d)*tr + y        'store the info for each triangle in the tri array tri(i,0) = x1 : tri(i,1) = y1       tri(i,2) = x2 : tri(i,3) = y2        tri(i,4) = x3 : tri(i,5) = y3        'draw the triangle #g "BackColor blue; Color white;Size 2" #g "Set ";x1;" ";y1;";Goto ";x2;" ";y2 #g "Goto ";x3;" ";y3;";Goto ";x1;" ";y1 'show the index number of the triangle #g "Size 1; Color white ;Place ";x-4;" ";y;";\";i Next #g "Flush" Return

[checkTris] mx = MouseX : my = MouseY 'check for message If msgFlag = 1 Then 'erase the last message #g "Color blue; BackColor blue" #g "Place 10 5;BoxFilled 264 23" msgFlag = 0 End If

chk$ = "" 'loop through all triangles in tri array For i = 1 To numTris 'is the mouse in one or more of the triangles? If pnt(mx, my, tri(i,0),tri(i,1),tri(i,2),tri(i,3),tri(i,4),tri(i,5) ) = 1 Then 'yup, add triangle "i" to the list of triangles... chk$ = chk$ + Str$(i) + " " 'show user the list of triangle(s) involved in collision #g "Color white;BackColor red" #g "Place 10 20;\ Mouse in triangle(s): ";chk$;" " 'remember that a message has been printed msgFlag = 1 End If   Next Wait

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function

Function pnt(px,py, x1,y1, x2,y2, x3,y3) '==================================================================================== '  Function "Point In Triangle" '==================================================================================== ' This function checks to see if the point (px,py) is within the specified triangle. ' ' If the point is inside the triangle a value of 1 is returned. ' ' If the point is not inside the triangle a value of 0 (zero) is returned. '==================================================================================== ' px = the X coord of the point in question ' py = the Y coord of the point in question ' x1, y1 = first triangle vertex ' x2, y2 = second triangle vertex ' x3, y3 = third triangle vertex '====================================================================================   b0 =  (x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1) b1 = ((x2 - px) * (y3 - py) - (x3 - px) * (y2 - py)) / b0   If b1 <= 0 Then pnt = 0 : Exit Function b2 = ((x3 - px) * (y1 - py) - (x1 - px) * (y3 - py)) / b0   If b2 <= 0 Then pnt = 0 : Exit Function b3 = ((x1 - px) * (y2 - py) - (x2 - px) * (y1 - py)) / b0   If b3 <= 0 Then pnt = 0 : Exit Function pnt = 1 End Function code toc 

Rectangle to Rectangle
code format="vbnet" '===================================================== '    Title: Rectangle To Rectangle Collision Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '===============================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== numRects = 500 Dim rect(numRects,3)   'allocate array space for rectangles '============================================================================

Gosub [setupGraphics] ' Right-click for a new set of random rectangle to rectangle collisions ' Left-click to exit #g "BackColor black;Color black; Size 4" #g "Place 55 230;BoxFilled 543 260; Size 1" #g "BackColor red; Color white;Place 60 250" #g "\ Right-click for random rectangle to rectangle collisions.   Left-Click to exit " #g "BackColor blue"

'============================================================================= ' apply mouse event handlers '=============================================================================   #g "SetFocus; when leftButtonDown [xit]; when rightButtonDown [checkRects]" Wait

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight = sh    UpperLeftX = (DisplayWidth-sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Rectangle To Rectangle Collision Function" For Graphics_nf_nsb As #g #g "Down; Fill blue; BackColor blue; TrapClose [xit]" h$ = "#g" '=========================================================================== Return

[checkRects] #g "Cls; Fill blue"

#g "Color yellow; Size 2" rect(0,2) = rand(10,25) 'width rect(0,3) = rand(10,25) 'height rect(0,0) = rand(5, sw-rect(0,2)-1) 'x   rect(0,1) = rand(5,420-rect(0,3)-1) 'y

#g "Place ";rect(0,0);" ";rect(0,1) #g "Box ";rect(0,0)+rect(0,2)-1;" ";rect(0,1)+rect(0,3)-1;"; Size 1"

#g "Color white"

For i = 1 To numRects rect(i,2) = rand(10,25) 'width rect(i,3) = rand(10,25) 'height rect(i,0) = rand(5, sw-rect(i,2)-1) 'x       rect(i,1) = rand(5,420-rect(i,3)-1) 'y        #g "Place ";rect(i,0);" ";rect(i,1) #g "Box " ;rect(i,0)+rect(i,2)-1;" ";rect(i,1)+rect(i,3)-1 Next

#g "Color red" collision$ = "" For i = 1 To numRects If r2r(rect(0,0),rect(0,1),rect(0,2),rect(0,3),_              rect(i,0),rect(i,1),rect(i,2),rect(i,3)) <> 0 Then collision$ = collision$ + Str$(i)+", " #g "Place ";rect(i,0);" ";rect(i,1) #g "Box " ;rect(i,0)+rect(i,2)-1;" ";rect(i,1)+rect(i,3)-1 End If   Next

#g "Color white" If collision$ <> "" Then collision$ = Left$(collision$, Len(collision$)-2) #g "Place 5 430;\Yellow rectangle has collided with rectangles: ";collision$ Else #g "Place 5 430;\*** No Collision! ***" End If Wait

Function r2r(ax, ay, aw, ah, bx, by, bw, bh) '==================================================================================== '  Rectangle To Rectangle Collision Function '==================================================================================== ' This function checks to see if two rectangles collide (overlap). ' ' If the rectangles COLLIDED a non-zero value is returned. ' ' If the rectangles HAVE NOT COLLIDED a value of zero is returned. ' ' Notice that only the upper-left corner X-Y coordinates and ' the width and height are needed to define each rectangle. '==================================================================================== ' ax = upper left X coord of rectangle "a" ' ay = upper left Y coord of rectangle "a" ' aw = width of rectangle "a" ' ah = height of rectangle "a"

' bx = upper left X coord of rectangle "b" ' by = upper left Y coord of rectangle "b" ' bw = width of rectangle "b" ' bh = height of rectangle "b" ' 'NOTE: negative coordinate values will return non-valid results. '====================================================================================   'This format is fastest and can be 'inlined' for maximum speed r2r =(((((bx+bw-1) - ax) Xor (bx - (ax+aw-1))) And _ ((by - (ay+ah-1)) Xor ((by+bh-1) - ay))) And 2147483648) '====================================================================================   'This format is more readable... but slightly slower

'ax2 = ax + aw - 1 'ay2 = ay + ah - 1 'bx2 = bx + bw - 1 'by2 = by + by - 1

'a = (bx2 - ax) Xor (bx - ax2) 'b = (by - ay2) Xor (by2 - ay) 'c = 2147483648 '&H80000000 'r2r = (a And b) And c End Function

'Function r2r(ax,ay,aw,ah,bx,by,bw,bh) '==================================================================================== '  Rectangle To Rectangle Collision Function '==================================================================================== ' This function checks to see if two rectangles collide (overlap). ' ' If the rectangles COLLIDED a non-zero value is returned. ' ' If the rectangles HAVE NOT COLLIDED a value of zero is returned. ' ' Notice that only the upper-left corner X-Y coordinates and ' the width and height are needed to define each rectangle. '==================================================================================== ' ax = upper left X coord of rectangle "a" ' ay = upper left Y coord of rectangle "a" ' aw = width of rectangle "a" ' ah = height of rectangle "a"

' bx = upper left X coord of rectangle "b" ' by = upper left Y coord of rectangle "b" ' bw = width of rectangle "b" ' bh = height of rectangle "b" r2r = ((ax <= bx+bw-1) And (bx <= ax+aw-1) And _          (ay <= by+bh-1) And (by <= ay+ah-1)) '   r2r = ((ax+aw-1 >= bx) And (ax <= bx+bw-1) And _ '           (ay+ah-1 >= by) And (ay <= by+bh-1)) 'End Function

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code toc 

Circle to Circle
code format="vbnet" '=============================================== '    Title: Circle To Circle Collision Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '===============================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== numCircs = 100 Dim circ(numCircs,2)   'allocate array space for circles '===========================================================================

Gosub [setupGraphics]

'============================================================================= ' apply mouse event handlers '=============================================================================   ' Right-click for another set of randomly placed circles ' Left-click to exit #g "BackColor black;Color black; Size 4" #g "Place 85 230;BoxFilled 523 260; Size 1" #g "BackColor red; Color white;Place 90 250" #g "\ Right-click for random circle to circle collisions.   Left-Click to exit " #g "BackColor blue"

'===========================================================================   #g "SetFocus; when rightButtonDown [checkCircs]; when leftButtonDown [xit]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight = sh    UpperLeftX = (DisplayWidth-sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Circle To Circle Collision Function" For Graphics_nf_nsb As #g #g "Down; BackColor blue; Fill blue; TrapClose [xit]" '=========================================================================== Return

[checkCircs] #g "Cls; Fill blue" rad = 30 #g "Color yellow; Size 2" circ(0,0) = rand(rad,sw-rad) circ(0,1) = rand(rad, 400-rad) circ(0,2) = rad #g "Place ";circ(0,0);" ";circ(0,1) #g "Circle ";circ(0,2);"; Color white; Size 1"

For i = 1 To numCircs circ(i,2) = rand(10,25)    'circle radius circ(i,0) = rand(circ(i,2), sw-circ(i,2)-1) 'center X-coord circ(i,1) = rand(circ(i,2),400-circ(i,2)-1) 'center Y-coord #g "Place ";circ(i,0);" ";circ(i,1) #g "Circle ";circ(i,2) Next

collision$ = "" #g "Color red" For i = 1 To numCircs If c2c(circ(0,0),circ(0,1),circ(0,2),_              circ(i,0),circ(i,1),circ(i,2)) = 1 Then collision$ = collision$ + Str$(i)+", " #g "Place ";circ(i,0);" ";circ(i,1) #g "Circle ";circ(i,2) End If   Next

#g "Color blue;Place 0 400;BoxFilled 170 420; Color white" If collision$= "" Then #g "Place 1 416;\*** No Collisions! ***" Else collision$ = Left$(collision$,Len(collision$)-2) #g "Place 1 416;\Yellow circle has collided with circles: ";collision$ End If

Wait

Function c2c(ax, ay, ar, bx, by, br) '==================================================================================== '  Function "Circle To Circle Collision" '==================================================================================== ' This function checks to see if the two circles have collided (overlap). ' '==================================================================================== ' ax = X coord of center of circle "a" ' ay = Y coord of center of circle "a" ' ar = radius of circle "a" ' bx = X coord of center of circle "b" ' by = Y coord of center of circle "b" ' br = radius of circle "b" ' '====================================================================================   c2c = ( ((ar+br)*(ar+br)) > ((ax-bx)*(ax-bx)+(ay-by)*(ay-by))  ) End Function

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code toc 

Circle to Line
code format="vbnet" '=============================================== '    Title: Circle To Line Collision Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '===============================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== numCircs = 199 Dim circ(numCircs,2)   'allot array space for circle definitions '===========================================================================   Gosub [setupGraphics]

'============================================================================= ' apply mouse event handlers '=============================================================================   ' Right-click for another set of randomly placed circles ' Left-click to exit #g "BackColor black;Color black; Size 4" #g "Place 130 230;BoxFilled 508 260; Size 1" #g "BackColor red; Color white;Place 140 250" #g "\ Right-click for random circles & line.   Left-Click to exit " #g "BackColor white" '===========================================================================   #g "SetFocus; when rightButtonDown [newCircLine]; when leftButtonDown [xit]" '   #g "when mouseMove [showLoc]" Wait '===========================================================================

[xit] Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight= sh    UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Circle To Line Collision Function" For Graphics_nf_nsb As #g #g "Down; TrapClose [xit]" '=========================================================================== Return

[newCircLine] #g "Cls; Color cyan; Size 3" #g "Place 10 10;Box 625 400; Size 1"

x1 = rand(10, 625) y1 = rand(10, 400) x2 = rand(10, 625) y2 = rand(10, 400)

#g "Color black; Line ";x1;" ";y1;" ";x2;" ";y2 #g "Color blue" collision$ = "" For i = 0 To numCircs circ(i,0) = 8 'circle radius circ(i,1) = rand(10 +circ(i,0),625 -circ(i,0)) 'center X coord circ(i,2) = rand(10 +circ(i,0),400 -circ(i,0)) 'center Y coord If c2L(x1, y1, x2, y2, circ(i,1), circ(i,2), circ(i,0)) Then collision$= collision$+Str$(i) + ", " #g "Set ";circ(i,1);" ";circ(i,2);"; Color red" #g "Circle ";circ(i,0);";Color blue" Else #g "Set ";circ(i,1);" ";circ(i,2);";Circle ";circ(i,0) End If   Next If collision$<> "" Then collision$ = Left$(collision$,Len(collision$)-2) If collision$ = "" Then collision$ = "No collision!" #g "Color blue; Place 5 416;\ Line Collided with circle(s): " #g "\ ";collision$ Wait

Function c2L(x1, y1, x2, y2, cx, cy, cr) '===================================================================== ' Circle To Line Function ' ' This function checks if a circle has collided with a line '===================================================================== ' x1, y1, x2, y2 are the two coordinates defining the line to check ' ' cx, cy are the coordinates of the center of the circle ' cr is the radius of the circle '===================================================================== ' c2L returns a 1 if the circle has collided with the line ' ' c2L returns a 0 (zero) if no collsion has occurred '=====================================================================   d = (x2-x1)*(x2-x1) + (y2-y1)*(y2-y1) If d <> 0 Then d = ((cx-x1)*(x2-x1) + (cy-y1)*(y2-y1))/ d   'Clip To the line segments legal bounds If d < 0.0 Then d = 0 If d > 1.0 Then d = 1 dx = cx - ( (x2-x1)*d + x1) dy = cy - ( (y2-y1)*d + y1) c2L = ( dx*dx + dy*dy <= cr * cr ) End Function

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code toc 

Point in Triangle Game
This Point in Triangle game is a whackamole type game. The object is to click on the designated triangle as quickly as possible. You'll need to download the following bitmaps to play the game. code format="vbnet" '=============================================== '    Title: Circle To Line Collision Function 'Programmer: Andy Amaya '     Date: 2009.07.01 '  Version: 1.000 '===============================================   NoMainWin '================================ Globals ================================== Global sw, sh '===========================================================================

'=========================== Arrays ======================================== numCircs = 199 Dim circ(numCircs,2)   'allot array space for circle definitions '===========================================================================   Gosub [setupGraphics]

'============================================================================= ' apply mouse event handlers '=============================================================================   ' Right-click for another set of randomly placed circles ' Left-click to exit #g "BackColor black;Color black; Size 4" #g "Place 130 230;BoxFilled 508 260; Size 1" #g "BackColor red; Color white;Place 140 250" #g "\ Right-click for random circles & line.   Left-Click to exit " #g "BackColor white" '===========================================================================   #g "SetFocus; when rightButtonDown [newCircLine]; when leftButtonDown [xit]" '   #g "when mouseMove [showLoc]" Wait '===========================================================================

[xit] Timer 0 Close #g End

[setupGraphics] '========================== Select Screen Size ============================= screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select '===========================================================================

'============================ Windows Stuff ================================ WindowWidth = sw   WindowHeight= sh    UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open "Circle To Line Collision Function" For Graphics_nf_nsb As #g #g "Down; TrapClose [xit]" '=========================================================================== Return

[newCircLine] #g "Cls; Color cyan; Size 3" #g "Place 10 10;Box 625 400; Size 1"

x1 = rand(10, 625) y1 = rand(10, 400) x2 = rand(10, 625) y2 = rand(10, 400)

#g "Color black; Line ";x1;" ";y1;" ";x2;" ";y2 #g "Color blue" collision$ = "" For i = 0 To numCircs circ(i,0) = 8 'circle radius circ(i,1) = rand(10 +circ(i,0),625 -circ(i,0)) 'center X coord circ(i,2) = rand(10 +circ(i,0),400 -circ(i,0)) 'center Y coord If c2L(x1, y1, x2, y2, circ(i,1), circ(i,2), circ(i,0)) Then collision$= collision$+Str$(i) + ", " #g "Set ";circ(i,1);" ";circ(i,2);"; Color red" #g "Circle ";circ(i,0);";Color blue" Else #g "Set ";circ(i,1);" ";circ(i,2);";Circle ";circ(i,0) End If   Next If collision$<> "" Then collision$ = Left$(collision$,Len(collision$)-2) If collision$ = "" Then collision$ = "No collision!" #g "Color blue; Place 5 416;\ Line Collided with circle(s): " #g "\ ";collision$ Wait

Function c2L(x1, y1, x2, y2, cx, cy, cr) '===================================================================== ' Circle To Line Function ' ' This function checks if a circle has collided with a line '===================================================================== ' x1, y1, x2, y2 are the two coordinates defining the line to check ' ' cx, cy are the coordinates of the center of the circle ' cr is the radius of the circle '===================================================================== ' c2L returns a 1 if the circle has collided with the line ' ' c2L returns a 0 (zero) if no collsion has occurred '=====================================================================   d = (x2-x1)*(x2-x1) + (y2-y1)*(y2-y1) If d <> 0 Then d = ((cx-x1)*(x2-x1) + (cy-y1)*(y2-y1))/ d   'Clip To the line segments legal bounds If d < 0.0 Then d = 0 If d > 1.0 Then d = 1 dx = cx - ( (x2-x1)*d + x1) dy = cy - ( (y2-y1)*d + y1) c2L = ( dx*dx + dy*dy <= cr * cr ) End Function

Function rand(loNum,hiNum) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiNum-loNum+1)+loNum) End Function code  

toc 

Flaxen's Dilemma
You'll need the following images to run the Flaxen's Dilemma code. code format="vbnet" NoMainWin Global sw, sh, mx, my, index, toggle Gosub [initialize]

'this is the event loop, everything else is handled by SUB's and Functions #g "SetFocus; when leftButtonDown [dun]; when mouseMove moveMouse" #g "when rightButtonDown switch; when characterInput keys" Wait '[end of event loop]

[dun] UnloadBMP "bknd" UnloadBMP "spChar" Close #g End

[initialize] 'Make room for 3 polygons of up to 10 points per polygon '=========================================================================   ' numVertices * 2 + 4 is the formula used to determine ' how much array space will be required for a polygon '=========================================================================   Dim poly(3,24) '3 polygons, with (10 * 2 + 4) vertex coordinates

'choose a screen size here screen = 1 Select Case screen Case 1 : sw = 640 : sh =  480 Case 2 : sw = 800 : sh =  600 Case 3 : sw = 1024 : sh = 768 Case 4 : sw = 1280 : sh = 1024 Case 5 : sw = 1600 : sh = 1200 End Select

'open a window centered on your monitor WindowWidth = sw '+8 WindowHeight = sh '+31 UpperLeftX = (DisplayWidth -sw)/2 UpperLeftY = (DisplayHeight-sh)/2 Open"flaxen's dilema" For Graphics_nf_nsb As #g

'Place pen "DOWN" to draw and trap the "exit" button at top right #g "Down; TrapClose [dun]"

'assign the handle of the graphics screen to 'h$' h$ = "#g"

'seed random generator for a fresh set of random numbers '1000millisecs/sec*60secs/min*60min/hr*24hrs/day Randomize Time$("ms")/86400000

'Number of polygons to read in from data statements numPolys = 3

'read polygon coordinates from data statements into 'poly' array Gosub [readPolys]

'Load the sprite background .bmp and 'char' .bmp LoadBMP "spChar", "FlaxenCharSpr.bmp" LoadBMP "bknd","FlaxenBackground.bmp"

'set the sprite background #g "Background bknd"

'add the character sprite and place at specified location #g "AddSprite char spChar" '   #g "SpriteXY char 232 254" #g "SpriteXY char 350 170"

'initialize char polygon X-Y coords the same as the 'char' sprite poly(1,1) = 350 : poly(1,2) = 170

'Show the sprites... #g "DrawSprites" Return

[readPolys] Restore [polygonData] For i = 1 To numPolys 'read in the first 5 data items Read numVerts, locX, locY, wide, high 'assign data to the poly array elements poly(i,0) = numVerts poly(i,1) = locX poly(i,2) = locY poly(i,3) = wide poly(i,4) = high

'loop through the vertex coordinates and 'assign to the poly array elements For j = 5 To numVerts * 2 + 3 Step 2 Read x, y           poly(i,j)   = x            poly(i,j+1) = y        Next j    Next i Return

[polygonData] '-->>>>> sprite char poly <<<<- '                                                         polygon index = 1 Data 5      'number of vertices defining the 'char' poly '========================================================== Data 0, 0   'draw polygon at these X-Y coordinates '========================================================== Data 36, 36 'width & height of the polygon's bounding box '========================================================== 'The 5 coordinate pairs are: Data 17,2,30,10,27,33,8,34,5,11 'The 5 coordinate pairs

'--->>>>> left river poly <<<<< '                                                         polygon index = 2 Data 4       'number of vertices defining polygon Data 55, 0   'draw polygon at these X-Y coordinates '========================================================== Data 277, 180 'width & height of polygon's bounding box '========================================================== Data 0,0, 247,179, 276,155, 64,0 'The 4 coordinate pairs

'--->>>>> right river poly <<<<<--- '                                                         polygon index = 3 Data 4       'number of vertices defining polygon Data 383,213 'draw polygon at these X-Y coordinates '========================================================== Data 256, 210 'width & height of polygon's bounding box '========================================================== Data 33,0, 255,160, 249,209, 0,26 'The 4 coordinate pairs

Sub keys h$, char$ '=========================================================================== ' This SUB is the key 'pressed' event handler '=========================================================================== ' h$ is the handle to your graphics screen '===========================================================================   'initialize to no collisions collide= 0 'set the polygon selector index to zero (none selected) index = 0 'store keypressed in 'key$' key$ = Inkey$

'=======================================================================   ' this code flips the 'show checked polygon' toggle on or off '=======================================================================   If toggle = 1 Then toggle = 0 '=======================================================================   'store the coordinates of sprite 'char' in variables charx, chary '=======================================================================   #h$ "SpriteXY? char charx chary" charw = poly(1,3)  'sprite width charh = poly(1,4)  'sprite height

'=======================================================================   'grab the info for the polygon of the river's left side '=======================================================================   riverLx = poly(2,1) riverLy = poly(2,2) riverLw = poly(2,3) riverLh = poly(2,4)

'=======================================================================   'do the bounding boxes of the char and river's left side collide? '=======================================================================   If r2r(charx,chary,charw,charh, riverLx, riverLy, riverLw, riverLh) <> 0 Then 'yup set the index to '2' index = 2  '(left side of river polygon) End If

'=======================================================================   'grab the info for the polygon of the river's right side '=======================================================================   riverRx = poly(3,1) riverRy = poly(3,2) riverRw = poly(3,3) riverRh = poly(3,4)

'=======================================================================   'do the bounding boxes of the char and river right side collide? '=======================================================================   If r2r(charx,chary,charw,charh, riverRx, riverRy, riverRw, riverRh) <> 0 Then 'yup, set the index to '3' index = 3  '(right side of river polygon) End If

'=======================================================================   'If arrow key pressed, then start checking for possible collisions '=======================================================================   If Len(key$) > 1 Then 'strip the left-most character(s) from key$ key = Asc(Right$(key$,1)) 'Procede according to which arrow key was pressed Select Case key 'Up           Case _VK_UP 'ty is the new location to be tested ty = chary - 1 'will sprite go off top of screen? If ty < 0 Then 'yup, set current Y position to top of screen chary = 0 'pretend there is a collision so 'chary' doesn't change collide = 1 Else If index > 1 Then 'move the polygon to the test location poly(1,2) = ty                       'will char polygon collide with 'currently selected polygon? collide= p2p(1, index) End If               End If                'if no collision then update chary to allow move up                'if collision then 'chary' will not change If collide= 0 Then chary = ty           'Down Case _VK_DOWN 'ty is the new location to be tested ty = chary + 1 'will sprite go below bottom of screen? If ty > 448 - charh Then 'yup, set current Y position to bottom of screen chary = 448 - charh 'pretend there is a collision so 'chary' doesn't change collide = 1 Else If index > 1 Then 'move the polygon to the test location poly(1,2) = ty                       'will char polygon collide with 'polygon indicated by 'index'? collide= p2p(1, index) End If               End If                'if no collision, update chary to allow move down 'if collision then 'chary' will not change If collide = 0 Then chary = ty           'Left Case _VK_LEFT 'tx is the new location to be tested tx = charx - 1 'will sprite go beyond left side of screen? If tx < 0 Then 'yup, set current X position to left side of screen charx = 0 'pretend there is a collision so 'charx' doesn't change collide = 1 Else If index > 1 Then 'move the polygon to the test location poly(1,1) = tx                       'will char polygon collide with 'polygon indicated by 'index'? collide= p2p(1, index) End If               End If                'if no collision, update charx to allow move left 'if collision then 'chary' will not change If collide= 0 Then charx = tx           'Right Case _VK_RIGHT 'tx is the new location to be tested tx = charx + 1 'will sprite go beyond right side of screen? If tx > 631 - charw Then 'yup, set current X position to right side of screen charx = 631 - charw 'pretend there is a collision so 'charx' doesn't change collide = 1 Else If index > 1 Then 'move the polygon to the test location poly(1,1) = tx                       'will char polygon collide with 'polygon indicated by 'index'? collide= p2p(1, index) End If               End If                'if no collision, update charx to allow move right 'if collision then 'chary' will not change If collide = 0 Then charx = tx       End Select

'===================================================================       'update the location of the char sprite polygon on the screen '===================================================================       Call movePoly 1, charx, chary

'===================================================================       'update the location of the char sprite '===================================================================       #h$ "SpriteXY char ";charx;" ";chary

'===================================================================       'draw the updated sprite graphics managed by JB        '=================================================================== #h$ "DrawSprites" End If End Sub

Sub moveMouse h$, x, y '====================================================== ' 'moveMouse' is a mouse movement event handler. ' Every time the mouse is moved the mouse coordinates ' are updated in the upper right corner of the screen ' (this routine is no longer necessary but is helpful when debugging) '======================================================   mx = MouseX:    my = MouseY 'Show mouse coordinates #h$ "Place ";sw-70;" 20;\            " #h$ "\            " #h$ "Place ";sw-70;" 20;\ ";mx;" ";my #h$ "\ idx: ";index End Sub

Function r2r(ax, ay, aw, ah, bx, by, bw, bh) '==================================================================================== '  Rectangle To Rectangle Collision Function '==================================================================================== ' This function checks to see if two rectangles collide (overlap). ' ' If the rectangles COLLIDED a non-zero value is returned. ' ' If the rectangles HAVE NOT COLLIDED a value of zero is returned. ' ' Notice that only the upper-left corner X-Y coordinates and ' the width and height are needed to define each rectangle. '==================================================================================== ' ax = upper left X coord of rectangle "a" ' ay = upper left Y coord of rectangle "a" ' aw = width of rectangle "a" ' ah = height of rectangle "a"

' bx = upper left X coord of rectangle "b" ' by = upper left Y coord of rectangle "b" ' bw = width of rectangle "b" ' bh = height of rectangle "b" ' 'NOTE: negative coordinate values will return non-valid results. '====================================================================================   'This format is fastest and can be 'inlined' for maximum speed r2r =(((((bx+bw-1) - ax) Xor (bx - (ax+aw-1))) And _ ((by - (ay+ah-1)) Xor ((by+bh-1) - ay))) And 2147483648) '====================================================================================   'This format is more readable... but slightly slower

'ax2 = ax + aw - 1 'ay2 = ay + ah - 1 'bx2 = bx + bw - 1 'by2 = by + by - 1

'a = (bx2 - ax) Xor (bx - ax2) 'b = (by - ay2) Xor (by2 - ay) 'c = 2147483648 '&H80000000 'r2r = (a And b) And c End Function

Function pnp(idx, x, y) '=============================================================== ' "Point In Polygon" Function '=============================================================== ' This function returns a 1 if the point is inside of the ' polygon, otherwise it returns a 0 (zero). ' ' idx - indicates which set of polygon coordinates to check ' x, y are the coordinates of the point being checked (in or out of polygon) '===============================================================   'lastX is the last X-coordinate of the polygon lastX = poly(idx, 0) * 2 + 3   'lastY would be poly(idx,0) * 2 + 4 'X-offset of polygon indicated by 'idx' oX = poly(idx,1) 'Y-offset of polygon indicated by 'idx' oY = poly(idx,2) 'loop through all of the points defining current polygon For i = 5 To lastX Step 2 If i=lastX Then j=5 Else j=(i+2) v1 = (poly(idx,i+1) + oY)<=y v2 = y < (poly(idx,j+1)+oY) v3 = (poly(idx, j+1)+oY)<=y v4 = y < (poly(idx,i+1)+oY) v5 = (((poly(idx,j)+oX))-(poly(idx,i)+oX))*(y-(poly(idx,i+1)+oY)) v6 = ((poly(idx,j+1)+oY))-(poly(idx,i + 1)+oY) If v6 = 0.0 then v6 = 0.00001 'prevent divide by zero error v7 = poly(idx, i) + oX       If (((v1 And v2))Or(v3 And v4))And(x<v5/v6+v7)) Then pnp=1-pnp    Next i End Function

Function p2p(index1, index2) '====================================================== ' Polygon To Polygon Collision Function '====================================================== ' This function returns a 1 if the polygons have ' collided, otherwise it returns a 0 (zero). ' ' index1 - is typically the smaller of the two polygons being checked for collision ' ' index2 - is typically the larger of the two polygons being checked for collision '======================================================   oX = poly(index1,1) oY = poly(index1,2) ' loop thru all of the vertices of polygon indicated by index1 ' to see if a vertex is inside of polygon indicated by index2 lastX = poly(index1,0) * 2 + 3 For i = 5 To lastX step 2 currentX = poly(index1,i) + oX       currentY = poly(index1,i + 1) + oY        p2p = pnp(index2, currentX,currentY) If p2p = 1 Then Exit For 'yup, collision has occurred Next i End Function

Sub drawPoly h$, index '=============================================================== ' h$ is the handle to your graphics screen ' ' index indicates which polygon is drawn '===============================================================   'poly(index, 0) holds the number of vertices defining the polygon lastX = poly(index,0) * 2 + 3    'lastY would be poly(index, 0) * 2 + 4 oX = poly(index,1)   'assign the offset X value to oX    oY = poly(index,2)    'assign the offset Y value to oY

'place the drawing cursor at the first polygon vertex coordinates #h$ "Place ";poly(index, 5) + oX;" ";poly(index, 6)+oY

'loop through the remaining vertex coordinates For i = 7 To lastX Step 2 'draw a line from the last cursor position 'to the currently indicated vertex #h$ "Goto ";poly(index, i)+oX;" ";poly(index, i + 1)+oY Next i

'draw a line from the current cursor position 'to the first vertex to close the polygon #h$ "Goto ";poly(index,5)+oX;" ";poly(index, 6)+oY End Sub

Sub movePoly index, x, y '=============================================================== ' SUB "Move A Polygon" '=============================================================== ' This SUB changes the location of where a polygon is drawn or used on screen. ' '=============================================================== ' index - indicates which of the polygons move ' x, y are the new coordinates where the polygon will be moved '===============================================================   poly(index, 1) = x    poly(index, 2) = y End Sub

Sub switch h$, x, y '====================================================== ' h$ is the handle to your graphics screen ' ' 'switch' - the right mouse button click event handler ' Every time the right-mouse button is clicked, flip ' the 'toggle' variable

' If 'toggle' = 1 Then draw all of the polygons and ' bounding boxes.

' If 'toggle' = 0 erase the polygons and bounding boxes ' ' The char polygon is drawn in cyan   (polygon 1) ' The river polygons are drawn in red (polygons 2 and 3)

' The bounding boxes of all polygons are drawn ' using yellow dashed lines '======================================================   toggle = 1 - toggle If toggle = 1 Then '=============================================       ' change char polygon color for maximum contrast here '=============================================       #h$ "Size 2; Color cyan" '=============================================       'Draw the outlines of the char polygon boundary '=============================================       Call drawPoly h$,1

'=============================================       ' change river polygon color for maximum contrast here '=============================================       #h$ "Color red"

'=============================================       'Draw the outlines of the river polygon boundaries '=============================================       Call drawPoly h$,2 Call drawPoly h$,3

'=============================================       ' change color of dashed boxes for maximum contrast here '=============================================       #h$ "Size 1; Color yellow"

'=============================================       'show the char bounding box with a yellow dashed line '=============================================       Call dashBox h$, poly(1,1), poly(1,2), poly(1,3), poly(1,4), 5

'=============================================       'show the left side of the river bounding box with a yellow dashed line '=============================================       Call dashBox h$, poly(2,1), poly(2,2), poly(2,3), poly(2,4), 31

'=============================================       'show the right side of the river bounding box with a yellow dashed line '=============================================       Call dashBox h$, poly(3,1), poly(3,2), poly(3,3), poly(3,4), 31

#h$ "Color Green; BackColor 128 128 128" Else '=============================================       'erase the polygon bounding boxes and polygons 'by redrawing the screen with out polygons '=============================================       #h$ "DrawSprites" End If   '==================================================================== 'dither inside of polygon being checked by pnp function '====================================================================   '    'Call showPoints h$, index  '********* verrrry slooow ! *********   '    '==================================================================== End Sub

Sub showPoints h$, idx '====================================================== ' h$ is the handle to your graphics screen ' ' idx indicates which polygon to floodfill with a ' dithered pattern (cheap transparency effect ;) '======================================================   oX = poly(idx,1)    'oX, oY are the coords to the oY = poly(idx,2)   'upper-left corner of bounding box fx = poly(idx,3) + oX - 1 'fx, fy are the lower-right fy = poly(idx,4) + oY - 1 'coords of bounding box #h$ "Color black" For j = oY To fy Step 2 For i = oX To fx Step 2 If pnp(idx, i, j) = 1 Then #h$ "Set ";i;" ";j End If       Next Next End Sub

Sub pLine h$, x1, y1, x2, y2, dash '====================================================== ' Parametric Line Procedure '====================================================== ' h$ is the handle to your graphic screen ' ' x1, y1, x2, y2 - the two end points of the line ' ' dash is number of dashes used to draw the line ' (hint: use an odd number to draw solid dashes at the two end points) '====================================================== 'Given points P1 = (x1,y1) and P2 = (x2,y2), the parametric form for the line is: '   x = x1 + t(x2-x1) '   y = y1 + t(y2-y1) '   0 <= t <= 1 'Note that t is the same in both equations. t is called the parameter. 'When t = 0 we get P1 and when t = 1 we get P2. As t varies between 0 and 1, 'we get all the other points on the line segment between P1 and P2. 'Because the slope of a vertical line is infinite, the slope-intercept 'form of a line can be troublesome to work with. Since the parametric form 'does not involve slope, vertical lines are no longer a special case. dx = x2-x1 dy = y2-y1 inc = 1.0/dash #h$ "Set ";x1;" ";y1 For float = inc To 1.0 Step inc x = float * dx + x1       y = float * dy + y1        t = 1 - t        If t Then #h$ "Goto ";x;" ";y Else #h$ "Place ";x;" ";y End If   Next float End Sub

Sub dashBox h$, x1, y1, w, h, dash '====================================================== ' dashBox - draws a box using dashed lines '====================================================== ' h$ is the handle of your graphic screen ' ' x1,y1 is the upper-left corner of the box ' ' w is the width of the box in pixels ' h is the height of the box in pixels ' ' dash is the number of line segments used to draw the line '======================================================   x2 = x1+w-1 y2 = y1+h-1 Call pLine h$, x1, y1, x2, y1, dash Call pLine h$, x2, y1, x2, y2, dash Call pLine h$, x2, y2, x1, y2, dash Call pLine h$, x1, y2, x1, y1, dash End Sub

Sub delay milliseconds '====================================================== ' delay - a simple delay loop which waits for the ' desired number of milliseconds to elapse '======================================================   st = Time$("ms") + milliseconds While st > Time$("ms") : Scan : Wend End Sub

Function rand(loInt,hiInt) '====================================================== ' rand returns a random integer between loNum and hiNum '======================================================   rand = Int(Rnd(0)*(hiInt-loInt+1)+loInt) End Function code