Taking the trig computations out of the loop is a good start.dafhi wrote:took a while
still won't be that fast b/c of point and pset.
Maybe pointers to the source and destination bitmap to read and write the pixel values?
Taking the trig computations out of the loop is a good start.dafhi wrote:took a while
still won't be that fast b/c of point and pset.
Yes I have worked on simple agent AI before but like those efforts I will probably not end up not finishing any Tank AI simulation beyond a demo.paul doe wrote:Do you have an idea as to how you're going to tackle this one?BasicCoder2 wrote:The next step should I bother to expand the demo is to make some AI so each team of tanks can seek out the other team and fight it out.
In the past I just found giving an agent a direction and a speed more intuitive than giving them vector numbers for direction and speed.Say, you'll be better off in the end using vectors and vector arithmetic.
update 3BasicCoder2 wrote:Taking the trig computations out of the loop is a good start.
Maybe pointers to the source and destination bitmap to read and write the pixel values?
Code: Select all
'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180 ' degrees * DtoR = radians
const SCRW = 640
const SCRH = 480
screenres SCRW,SCRH,32
'bitmaps used
dim shared as any ptr TB,TT
TB = imagecreate(35,35)
' bload "tankBody.bmp",TB
TT = imagecreate(35,35)
' bload "tankTurret.bmp",TT
dim shared as any ptr backGround
backGround = imagecreate(1024,480)
' bload "backGround2.bmp",backGround
dim shared as integer imgW,imgH
imgW = 35
imgH = 35
dim as ulong colors( 6)
colors(0)=RGB(255,0,255)
colors(1)=RGB(0,0,0)
colors(2)=RGB(166,202,240)
colors(3)=RGB(0,160,192)
colors(4)=RGB(192,192,192)
colors(5)=RGB(128,128,128)
dim as integer n
for j as integer = 0 to 34
for i as integer = 0 to 34
read n
pset TT,(i,j),colors(n)
next i
next j
for j as integer = 0 to 34
for i as integer = 0 to 34
read n
pset TB,(i,j),colors(n)
next i
next j
Sub rotateimage(im As Any Ptr,angle As single,shiftx As long=0,shifty As long=0,sc As Single=4,miss as ulong=rgb(255,0,255))
static As Integer pitch,pitchs,xres,yres,runflag
static As Any Ptr row
static As integer ddx,ddy,resultx,resulty
Imageinfo im,ddx,ddy,,pitch,row
if runflag=0 then Screeninfo xres,yres,,,pitchS:runflag=1
Dim As Any Ptr rowS=Screenptr
Dim As long centreX=ddx\2,centreY=ddy\2
Dim As Single sx=Sin(angle)
Dim As Single cx=Cos(angle)
Dim As long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
Var fx=sc*.7071067811865476,sc2=1/sc
shiftx+=centreX*sc-centrex
shiftY+=centrey*sc-centrey
For y As long=centrey-fx*mx+1 To centrey+ fx*mx
dim as single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
shfty=y+shifty
For x As long=centrex-mx*fx To centrex+mx*fx
if x+shiftx >=0 then 'on the screen
if x+shiftx <xres then
if shfty >=0 then
if shfty<yres then
resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
if resultx >=0 then 'on the image
if resultx<ddx then
if resulty>=0 then
if resulty<ddy then
dim as ulong u=*cast(ulong ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
if u<>miss then *cast(ulong ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
End If:end if:end if:end if
End If:end if:end if:end if
Next x
Next y
End Sub
sub rotateImage2(img as any ptr, angle as single, x as integer, y as integer)
dim as double tx,ty,nx,ny,vx,vy
angle = angle*DtoR
dim as ulong c
for yp as single = 0 to imgH-1 step .5
for xp as single = 0 to imgW-1 step .5
c = point(xp,yp,img):'get color
if c<>rgb(255,0,255) then
'select centre of image as centre of rotation
vx = xp-(imgW\2)
vy = yp-(imgH\2)
'equations to compute new x,y coordinates for rotation of ww degrees
tx = cos(angle) * vx - sin(angle) * vy
ty = cos(angle) * vy + sin(angle) * vx
nx = tx+(imgW\2)
ny = ty+(imgH\2)
pset (nx+x,ny+y),c
end if
next xp
next yp
end sub
put (100,100),TB,trans
print "press a key"
dim as single angle1,angle2
sleep
do
screenlock
cls
rotateImage(TB,angle1,320,240)
rotateImage(TT,angle2,320,240)
screenunlock
angle2 = angle2 + 1/10
sleep 20
loop until multikey(&H01)
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,1,1,1,2,2,2,1,3,3,3,3,3,3,3,3,3,3,1,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA 0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA 0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
I used this code in 2012, also to rotate a tank image:dafhi wrote:BasicCoder2's rotate blit optimized and using ptrs
[update 2] - source read needed to not go past src_w (and h) - 0.5, so i made the limit src_ - .501[previous post] - took a whileCode: Select all
sub rotateImage(img as any ptr, angle as single, x as single, y as single) '' trying to be more accommodating to bit depths static as integer des_w, des_h, pitch_des, bpp, rate, num_pages dim as any ptr p_des = screenptr static as string driver_name ScreenInfo des_w,des_h, bpp, num_pages, pitch_des, rate, driver_name static as integer src_w, src_h, bypp, pitch_src static as any ptr p_src ImageInfo img, src_w, src_h, bypp, pitch_src, p_src dim as integer pitch_des_by = pitch_des \ bypp '' dim as single tx,ty,vx '' changed from double dim as single cosa = cos(angle*DtoR), wh = imgW/2 dim as single sina = sin(angle*DtoR), hh = imgH/2 y += hh x += wh var _step = .9 var cosa_vx = cosa * _step var sina_vx = sina * _step '' 2018 Sep 15 var x_des_limit = des_w - .5 var y_des_limit = des_h - .5 for yp as single = .499 to imgH - .501 step _step ''2018 Sep 16 .. (.499 to avoid banker's round) var cosa_vy = cosa * (yp-hh) + y var sina_vy = sina * (yp-hh) - x var x_des = cosa_vx * (.5 - wh) - sina_vy var y_des = sina_vx * (.5 - wh) + cosa_vy select case as const bypp case 4 dim as integer y_pitch_src = int(yp) * pitch_src dim as ulong ptr psrc = p_src + y_pitch_src dim as ulong ptr pdes = p_des for xp as single = .499 to imgW - .501 step _step '' 2018 Sep 16 if x_des >=0 andalso x_des < x_des_limit then if y_des >=0 andalso y_des < y_des_limit then 'dim as ulong c = point(xp,yp,img):'get color if psrc[xp]<>rgb(255,0,255) then 'pset (x_des,y_des),psrc[xp] pdes[ int(y_des + .5) * pitch_des_by + x_des ] = psrc[xp] end if endif endif x_des += cosa_vx y_des += sina_vx next xp End Select next yp end sub
still won't be that fast b/c of point and psetCode: Select all
sub rotateImage(img as any ptr, angle as single, x as single, y as single) dim as single tx,ty,vx '' changed from double dim as single cosa = cos(angle*DtoR), wh = imgW/2 dim as single sina = sin(angle*DtoR), hh = imgH/2 y += hh x += wh var _step = .9 var cosa_vx = cosa * _step var sina_vx = sina * _step for yp as single = .5 to imgH-.5 step _step dim as single cosa_vy = cosa * (yp-hh) + y dim as single sina_vy = sina * (yp-hh) - x var x_dest = cosa_vx * (.5 - wh) - sina_vy var y_dest = sina_vx * (.5 - wh) + cosa_vy for xp as single = .5 to imgW-.5 step _step dim as ulong c = point(xp,yp,img):'get color if c<>rgb(255,0,255) then pset (x_dest,y_dest),c end if x_dest += cosa_vx y_dest += sina_vx next xp next yp end sub
Code: Select all
sub sprite_rotate(srcImg as any ptr, dstImg as any ptr, rotation as single, defaultColour as integer)
'replace point & pset with direct memory access
dim as integer srcWidth, srcHeight, srcPitch, dstPitch
dim as single xctr, yctr
dim as integer xdst, ydst
dim as integer xsrc, ysrc
dim as ulong colour 'was integer
dim as single ySin, yCos
dim as single sinRot = sin(rotation)
dim as single cosRot = cos(rotation)
dim as ulong ptr scrPixels, dstPixels 'was integer
imageInfo srcImg, srcWidth, srcHeight, , srcPitch, scrPixels
imageInfo dstImg, , , , dstPitch, dstPixels
dstPitch shr= 2
srcPitch shr= 2
xctr = srcWidth / 2
yctr = srcHeight / 2
screenlock
for ydst = 0 to srcHeight-1
ySin = (yctr - ydst) * sinRot + xctr + 0.5
yCos = (ydst - yctr) * cosRot + yctr + 0.5
for xdst = 0 to srcWidth-1
xsrc = int((xdst - xctr) * cosRot + ySin)
ysrc = int((xdst - xctr) * sinRot + yCos)
if (xsrc >= 0) and (xsrc < srcWidth) and (ysrc >= 0) and (ysrc < srcHeight) then
'colour = point(xsrc, ysrc, srcImg)
colour = scrPixels[ysrc * srcPitch + xsrc]
else
colour = defaultColour
end if
'pset dstImg, (xdst, ydst), colour
dstPixels[ydst * dstPitch + xdst] = colour
next
next
screenunlock
end sub
Doesn't matter. Learning is what really counts =DBasicCoder2 wrote:Yes I have worked on simple agent AI before but like those efforts I will probably not end up not finishing any Tank AI simulation beyond a demo.
Indeed. But you should really switch to a Flow Field implementation. They have many advantages over traditional Dijkstra's or A* (even though they use Dijkstra's algorithm to calculate the distance for the paths):BasicCoder2 wrote:Path finding, which is essentially a GPS system, may well be part of a game. For example if low on fuel or ammunition use GPS to find fuel or ammunition depot. I did look at "heat maps" but settled for the Dijkstra's algorithm in past AI implementations.
Hard to see the advantages for me, but to each its own =DBasicCoder2 wrote:In the past I just found giving an agent a direction and a speed more intuitive than giving them vector numbers for direction and speed.
Code: Select all
' uses a modified version of Patrick Lester's example as modified by coderJeff.
' http://www.execulink.com/~coder/freebasic/astar.html
#include once "fbgfx.bi"
const NULL = 0
type v2D
as integer x
as integer y
end type
type APATH
as v2D p(1000) 'need to make this variable
as integer pCount 'length of path
end type
const MAPW = 40
const MAPH = 30
const CELL_COUNT = MAPW * MAPH
#define CELLINDEX(x,y) ((MAPW*(y))+(x))
const STATE_NONE = 0
const STATE_OPEN = 1
const STATE_CLOSED = 2
type Cell
x as integer
y as integer
IsSolid as integer
parent as Cell Ptr
state as integer 'open or closed
f as integer
g as integer
h as integer
end type
dim shared Map( 0 to CELL_COUNT - 1 ) as CELL
dim shared StartIndex as integer
dim shared pStartCell as Cell ptr
dim shared EndIndex as integer
dim shared pEndCell as Cell ptr
sub CellClearAll()
for y as integer = 0 to MAPH - 1
for x as integer = 0 to MAPW - 1
with Map( CELLINDEX(x,y) )
.x = x
.y = y
.IsSolid = FALSE
end with
next
next
end sub
sub CellSetSolid( byval x as integer, byval y as integer, byval flag as integer )
dim n as integer = CELLINDEX(x,y)
Map( n ). IsSolid = flag
end sub
sub CellSetStart( byval x as integer, byval y as integer )
StartIndex = CELLINDEX(x,y)
pStartCell = @Map( StartIndex )
end sub
sub CellSetEnd( byval x as integer, byval y as integer )
EndIndex = CELLINDEX(x,y)
pEndCell = @Map( EndIndex )
end sub
sub CellToggleSolid( byval x as integer, byval y as integer )
with Map( CELLINDEX(x,y) )
if( .IsSolid ) then
.IsSolid = FALSE
else
.IsSolid = TRUE
end if
end with
end sub
'' ------------------------------------------------------------------
'' A* Computations
'' ------------------------------------------------------------------
''
function ASTAR_GetLowestF( ) as CELL ptr
dim c as CELL ptr = NULL
for i as integer = 0 to CELL_COUNT - 1
if( Map( i ).State = STATE_OPEN ) then
if( c = NULL ) then
c = @Map(i)
else
if( Map(i).f < c->f ) then
c = @Map(i)
end if
end if
end if
next
function = c
end function
''
function ASTAR_CheckNeighbour( byval parent as CELL ptr, byval x as integer, byval y as integer, cost as integer ) as integer
function = FALSE
if( x < 0 or x >= MAPW ) then
exit function
end if
if( y < 0 or y >= MAPH ) then
exit function
end if
dim c as CELL ptr = @Map( CELLINDEX(x, y) )
if( c->IsSolid ) then
exit function
end if
if( c->state = STATE_OPEN ) then
if( parent->g + cost < c->g ) then
c->state = STATE_NONE
end if
elseif( c->state = STATE_CLOSED ) then
if( parent->g + cost < c->g ) then
c->state = STATE_NONE
end if
end if
if( c->state = STATE_NONE ) then
c->state = STATE_OPEN
c->g = parent->g + cost
'' This is the Manhattan Distance Heuristic
c->h = abs( c->x - pEndCell->x ) * 10 + abs( c->y - pEndCell->y ) * 10
c->f = c->g + c->h
c->parent = parent
end if
function = TRUE
end function
''
function ASTAR_CheckNeighbours( byval parent as CELL Ptr, byval x as integer, byval y as integer ) as integer
const DIR_N = 1
const DIR_S = 2
const DIR_W = 4
const DIR_E = 8
dim flag as integer
'' Check all orthogonal directions first N S E W
if( ASTAR_CheckNeighbour( parent, x - 1, y , 10 ) ) then
flag or= DIR_W
end if
if( ASTAR_CheckNeighbour( parent, x , y - 1, 10 ) ) then
flag or= DIR_N
end if
if( ASTAR_CheckNeighbour( parent, x , y + 1, 10 ) ) then
flag or= DIR_S
end if
if( ASTAR_CheckNeighbour( parent, x + 1, y , 10 ) ) then
flag or= DIR_E
end if
'' Only allow a diagonal movement if both orthogonal
'' directions are also allowed
if( ( flag and ( DIR_N or DIR_W )) = ( DIR_N or DIR_W ) ) then
ASTAR_CheckNeighbour( parent, x - 1, y - 1, 14 )
end if
if( ( flag and ( DIR_S or DIR_W )) = ( DIR_S or DIR_W ) ) then
ASTAR_CheckNeighbour( parent, x - 1, y + 1, 14 )
end if
if( ( flag and ( DIR_N or DIR_E )) = ( DIR_N or DIR_E ) ) then
ASTAR_CheckNeighbour( parent, x + 1, y - 1, 14 )
end if
if( ( flag and ( DIR_S or DIR_E )) = ( DIR_S or DIR_E ) ) then
ASTAR_CheckNeighbour( parent, x + 1, y + 1, 14 )
end if
function = 0
end function
''
sub ASTAR_Compute()
dim c as CELL ptr
for i as integer = 0 to CELL_COUNT - 1
Map(i).parent = NULL
Map(i).state = STATE_NONE
Map(i).f = 0
Map(i).g = 0
Map(i).h = 0
next
c = pStartCell
c->State = STATE_OPEN
do
c = ASTAR_GetLowestF()
if( c = NULL ) then
exit do
elseif( c = pEndCell ) then
exit do
end if
c->state = STATE_CLOSED
ASTAR_CheckNeighbours( c, c->x, c->y )
loop
end sub
function makePath(x2 as integer,y2 as integer,x1 as integer,y1 as integer) as APATH
dim as APATH path
dim as integer count
CellSetStart(x2,y2) 'target
CellSetEnd(x1,y1)
ASTAR_Compute()
dim c as CELL ptr = pEndCell
path.pCount = 0
while( c->parent )
path.p(count).x = c->x
path.p(count).y = c->y
count = count + 1
c = c->parent
wend
path.pCount = count
return path
end function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' MAIN PROGRAM
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
const WORLDW = 40 'must be same as MAPW and MAPH in ASTAR ROUTINE HEADER
const WORLDH = 30
type AGENT
as integer x 'current position
as integer y
as integer dx 'velocity between -1 and +1
as integer dy
as integer item 'item held by agent
as integer itemCount 'count items collected
'required for astar routine
as APATH path'path list
as integer counter 'position so far
as integer onThePath 'moving along path
as v2D target 'desired target
end type
dim shared as integer agentCount
agentCount = 4
dim shared as AGENT agents(0 to agentCount)
'===========================
const SCRW = 900
const SCRH = 480
const TILEW = 16
const TILEH = 16
screenres SCRW, SCRH, 32
color rgb(0,0,0),rgb(255,255,255):cls
'==============================================
'create image block
dim shared as any ptr image
image = imagecreate(16,96)
dim as ulong colors(9)
colors(0)=RGB(255,0,255)
colors(1)=RGB(255,0,0)
colors(2)=RGB(255,255,255)
colors(3)=RGB(0,0,255)
colors(4)=RGB(0,0,0)
colors(5)=RGB(0,255,0)
colors(6)=RGB(136,0,21)
colors(7)=RGB(127,127,127)
colors(8)=RGB(195,195,195)
dim as integer n
for j as integer = 0 to 95
for i as integer = 0 to 15
read n
pset image,(i,j),colors(n)
next i
next j
'==============================================
dim shared as integer sx,sy,ex,ey
'dim shared as any ptr worldBlock16
'worldBlock16 = imagecreate(16*16,16*16)
'bload "tileBlock16A.bmp",worldBlock16 'load bitmap tile block
dim shared as integer world(WORLDW,WORLDH)
sub drawWorld()
dim as integer x,y,n
screenlock
cls
for j as integer = 0 to WORLDH-1
for i as integer = 0 to WORLDW-1
if world(i,j)<>0 then
n = world(i,j) 'get tile id
y = n
x = 0
'line (i*TILEW,j*TILEh)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(200,100,0),bf 'floor tile color
put (i*TILEW,j*TILEH),image,(x*TILEW,y*TILEH)-(x*TILEW+TILEW-1,y*TILEH+TILEH-1),trans
line (i*TILEW,j*TILEH)-(i*TILEW+TILEW,j*TILEH+TILEH),rgb(0,0,200),b
end if
line (i*TILEW,j*TILEH)-(i*TILEW+TILEH,j*TILEW+TILEH),rgb(100,100,100),b
next i
next j
'draw agents
for i as integer = 0 to agentCount
if agents(i).item = 0 then
put (agents(i).x,agents(i).y),image,(0,32)-(16,48),trans
else
put (agents(i).x,agents(i).y),image,(0,16)-(15,31),trans
end if
'draw homes
put (agents(i).target.x*TILEW,agents(i).target.y*TILEH),image,(0,80)-(15,95),trans
draw string (agents(i).x-8,agents(i).y),str(i)
locate (i+1)*2,82
print "agent";i;
for j as integer = 0 to agents(i).itemCount-1
put (716+j*16,i*16),image,(0,64)-(15,79),trans 'draw mushroom count
next j
'if agents(i).onThePath then
' print "agent";i;" going home"
'end if
next i
screenunlock
end sub
sub fillWorld()
for y as integer = 3 to MAPH-5
for x as integer = 0 to MAPW-1
' floor(x,y)=int(rnd(1)*2)+1
if int(rnd(1)*8)=0 then
CellSetSolid(x,y, TRUE )
if int(rnd(1)*4)=0 then
world(x,y)=4 'mushroom
else
world(x,y)=3 'tree
end if
end if
next x
next y
end sub
sub followPath(ag as AGENT)
if ag.counter < ag.path.pCount then
ag.dx = ag.path.p(ag.counter).x - (ag.x\16) 'get direction to move
ag.dy = ag.path.p(ag.counter).y - (ag.y\16)
ag.counter = ag.counter + 1 'bump counter
else
ag.onThePath = 0
ag.item = 0 'drop item
ag.itemCount = ag.itemCount + 1 'count items dropped
ag.dx = 0
ag.dy = 0
end if
end sub
sub moveAgents(ag as AGENT)
dim as integer hit
dim as integer TILEX,TILEY
hit = 0
ag.x = ag.x + ag.dx
ag.y = ag.y + ag.dy
'out of bounds
if ag.x < 0 or ag.x > 640-16 or ag.y < 0 or ag.y > 480-16 then hit = 1
'test overlap of another tile
TILEX = int(ag.x/16)
TILEY = int(ag.y/16)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x+15)/16)
TILEY = int((ag.y)/16)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x)/16)
TILEY = int((ag.y+15)/16)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x+15)/16)
TILEY = int((ag.y+15)/16)
if world(TILEX,TILEY)<>0 then hit = 1
if hit = 1 then
ag.x = ag.x - ag.dx 'undo move
ag.y = ag.y - ag.dy
'new trial
ag.dx = int(rnd(1)*3)-1
ag.dy = int(rnd(1)*3)-1
while ag.dx = 0 and ag.dy = 0
ag.dx = int(rnd(1)*3)-1
ag.dy = int(rnd(1)*3)-1
wend
end if
end sub
sub update()
dim as integer hitTile
for i as integer = 0 to agentCount
hitTile = 0
if agents(i).x = int(agents(i).x\16)*16 and agents(i).y = int(agents(i).y\16)*16 then
hitTile = 1
end if
if hitTile = 1 then
if agents(i).onThePath = 1 then
followPath(agents(i))
end if
end if
if hitTile = 1 and agents(i).onThePath = 0 and int(rnd(1)*20)=0 then
agents(i).dx = int(rnd(1)*3)-1
agents(i).dy = int(Rnd(1)*3)-1
while agents(i).dx = 0 and agents(i).dy = 0
agents(i).dx = int(rnd(1)*3)-1
agents(i).dy = int(Rnd(1)*3)-1
wend
end if
dim as integer p,q
if hitTile = 1 and agents(i).onThePath = 0 then
for jj as integer = -1 to 1
for ii as integer = -1 to 1
p = agents(i).x\16+ii
q = agents(i).y\16+jj
if p>0 and p<640 and q>0 and q<480 and agents(i).onThePath = 0 then
if world(p,q) = 4 then 'FOUND MUSHROOM
world(p,q) = 0 'remove from world
CellSetSolid(p,q,FALSE) 'remove from ASTAR MAP
agents(i).item = 1 'holding an item
agents(i).path = makePath(agents(i).target.x,agents(i).target.y,(agents(i).x\16),(agents(i).y\16))
agents(i).onThePath = 1
agents(i).counter = 0 'zero agent current index position on path
end if
end if
next ii
next jj
end if
moveAgents(agents(i))
next i
drawWorld()
end sub
'dim as integer x,y
CellClearAll()
'fill world with rocks and trees
fillWorld()
for i as integer = 0 to agentCount
agents(i).x = i*8*16
agents(i).y = 2*16
agents(i).target.x = i*8
agents(i).target.y = 28
agents(i).dx = int(rnd(1)*3)-1
agents(i).dy = int(Rnd(1)*3)-1
while agents(i).dx = 0 and agents(i).dy = 0
agents(i).dx = int(rnd(1)*3)-1
agents(i).dy = int(Rnd(1)*3)-1
wend
next i
dim as double now1
now1 = timer
do
if timer > now1 + 0.01 then
now1 = timer
update()
end if
sleep 2
loop until multikey(&H01)
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
DATA 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,2,2,1,1,1,1,2,2,1,1,1,1
DATA 1,1,1,1,2,2,1,1,1,1,2,2,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1
DATA 1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1
DATA 1,1,1,1,1,1,2,2,2,2,1,1,1,1,1,1
DATA 1,1,1,1,1,1,2,2,2,2,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
DATA 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
DATA 0,0,3,3,3,3,3,3,3,3,3,3,3,3,0,0
DATA 0,0,3,3,3,3,3,3,3,3,3,3,3,3,0,0
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,3,2,2,3,3,3,3,2,2,3,3,3,3
DATA 3,3,3,3,2,2,3,3,3,3,2,2,3,3,3,3
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,3,2,2,2,2,2,2,2,2,3,3,3,3
DATA 3,3,3,3,2,2,2,2,2,2,2,2,3,3,3,3
DATA 3,3,3,3,3,3,2,2,2,2,3,3,3,3,3,3
DATA 3,3,3,3,3,3,2,2,2,2,3,3,3,3,3,3
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 0,0,3,3,3,3,3,3,3,3,3,3,3,3,0,0
DATA 0,0,3,3,3,3,3,3,3,3,3,3,3,3,0,0
DATA 0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0
DATA 0,0,0,0,0,4,4,5,5,4,4,0,0,0,0,0
DATA 0,0,0,0,0,4,4,5,5,4,4,0,0,0,0,0
DATA 0,0,0,4,4,5,5,5,5,5,5,4,4,0,0,0
DATA 0,0,0,4,4,5,5,5,5,5,5,4,4,0,0,0
DATA 0,4,4,5,5,5,5,5,5,5,5,5,5,4,4,0
DATA 0,4,4,5,5,5,5,5,5,5,5,5,5,4,4,0
DATA 0,4,4,5,5,5,5,5,5,5,5,5,5,4,4,0
DATA 0,4,4,5,5,5,5,5,5,5,5,5,5,4,4,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,0,0,4,4,6,6,4,4,0,0,0,0,0
DATA 0,0,0,0,0,4,4,6,6,4,4,0,0,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,0,4,4,4,4,4,4,4,4,0,0,0,0
DATA 0,0,4,4,4,4,7,4,4,8,8,8,4,4,0,0
DATA 0,4,4,4,8,7,8,8,8,8,8,8,8,8,4,0
DATA 0,4,4,8,4,8,8,8,8,8,8,8,8,8,8,4
DATA 0,4,8,4,7,8,8,8,8,8,8,8,8,8,8,4
DATA 0,4,7,8,7,8,7,7,7,7,8,8,8,8,8,4
DATA 0,4,4,4,8,8,8,8,8,8,8,8,8,8,8,4
DATA 0,4,4,4,4,4,4,4,7,7,7,8,8,4,4,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,0,0,0,0,0
DATA 0,0,0,0,0,4,4,7,7,8,4,0,0,0,0,0
DATA 0,0,0,0,0,4,4,7,7,7,4,0,0,0,0,0
DATA 0,0,0,0,4,4,4,8,7,7,4,0,0,0,0,0
DATA 0,0,0,0,4,4,4,8,8,4,4,0,0,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,0,0,0,0,0
DATA 0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,0
DATA 0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,4,1,1,4,0,0,0,0,0,0
DATA 0,0,0,0,0,4,1,1,1,1,4,0,0,0,0,0
DATA 0,0,0,0,4,1,1,1,1,1,1,4,0,0,0,0
DATA 0,0,0,4,1,1,1,1,1,1,1,1,4,0,0,0
DATA 0,0,4,1,1,1,1,1,1,1,1,1,1,4,0,0
DATA 0,4,1,1,1,1,1,1,1,1,1,1,1,1,4,0
DATA 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
DATA 4,7,7,7,7,7,7,7,7,7,7,7,7,7,7,4
DATA 4,7,4,4,4,7,4,4,4,4,7,4,4,4,7,4
DATA 4,7,4,3,4,7,4,5,5,4,7,4,3,4,7,4
DATA 4,7,4,3,4,7,4,5,5,4,7,4,3,4,7,4
DATA 4,7,4,4,4,7,4,5,5,4,7,4,4,4,7,4
DATA 4,7,7,7,7,7,4,5,5,4,7,7,7,7,7,4
DATA 4,7,7,7,7,7,4,5,5,4,7,7,7,7,7,4
DATA 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
There IS a computational advantage. Which only gets greater the more points you need to transform.BasicCoder2 wrote:Computationally there is no advantage. I have to translate the direction,speed into a change in the x and y coordinates.
Yes, indeed. It's more a question of mathematical reasoning. You seem to prefer the body syntonic type of reasoning. It's quite cool and probably you should implement the interface of the agents like that (so you can program the agents in a high-level fashion, giving them commands like 'rotate 90 left fire cannon'), but at the low level, vector math provides several advantages that you should consider.BasicCoder2 wrote:However in everyday life we talk about travelling in a particular direction (degrees) at a particular speed.
Not always. How would you handle colliding agents?BasicCoder2 wrote:With path finding a game programmer just wants to get a path (a list of positions) between two points.
Yes, exactly. With Flow Field, there's no 'path aquisition', the path is already calculated for all agents that share the same goal(s). The agents only have to follow it (see the picture that I posted before). It's like calculating A* once and then use it for all agents. This is why it can handle thousands of pathing agents at the same time, with minimal cost. Supreme Commander is a game that uses FFPF, as is Planetary Anihilation -these are RTS that have a massive scale. But besides scalability, it provides several advantages that I already mentioned.BasicCoder2 wrote:So you would be suggesting a flow field implementation replacement for the path acquisition function.
he was saying there's no computational advantage with his current systemBasicCoder2 wrote:Computationally there is no advantage. I have to translate the direction,speed into a change in the x and y coordinates.
No, indeed. If he's to use vector math, he'll need to lay out things differently. We are discussing if the approach is worthwhile or not =Ddafhi wrote:he was saying there's no computational advantage with his current system
Perhaps, perhaps not. On any case, he's entitled to do whatever he thinks it's best for him. I suggested Flow Field Pathfinding because it's trivial to code, easy to use, and fits nicely with the concept he's developing =Ddafhi wrote:actually i take it back. maybe BC2 no likely the idea of a flow field for "all the vector calcs"
Deal with the collision and then recompute the path.paul doe wrote:Not always. How would you handle colliding agents?BasicCoder2 wrote:With path finding a game programmer just wants to get a path (a list of positions) between two points.
In the mushroom collector example they all have different homes to go to?the path is already calculated for all agents that share the same goal(s).
BasicCoder2 wrote:Deal with the collision and then recompute the path.paul doe wrote:Not always. How would you handle colliding agents?BasicCoder2 wrote:With path finding a game programmer just wants to get a path (a list of positions) between two points.
Essentially push the goto X goal on a goal stack and pop it off after the current new goal (deal with collision) is complete.In the mushroom collector example they all have different homes to go to?the path is already calculated for all agents that share the same goal(s).
I am not fixed on any given solution for anything. I gave the mushroom example so you could demonstrate an alternative function to ASTAR. A game programmer figures out at a high level what to do and then has to have or write a set of functions to achieve that outcome. The direction, speed is how I think we think about it at a high level even if implementing it in code means converting it to a change in position along the x axis and the y axis. Think of how we might give a verbal description of how to get to some location. Agents could implement the same thing. Follow a road. Turn left at the intersection. Follow the river until you reach a bridge and cross over it. And so on ... Generating a path is really just implementing a GPS for the agent to make use of.
This doesn't have to be about tanks, it can be players in a soccer game, Vikings on a mission, Settlers building their village or the FB Community Game suggestion of players programming space ships in a shoot em up match.