The main difference between this and all the other demos is the choice of using a rotating world view around the user controlled tank (agent).
Thanks to counting_pine for fixing the floating point problem for me.
One day I might pull it all together and write a real game instead of all these demos :)
Code: Select all
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
dim shared as long fps 'for dodicat's regulator
'dodicat regulator
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
Static As Double timervalue,lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
'badidea's sprite rotate
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
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
end sub
const TILEW = 32
const TILEH = 32
const TMAPW = 100
const TMAPH = 100
const BMAPW = TILEW * TMAPW
const BMAPH = TILEH * TMAPH
const WINW = 15 * TILEW
const WINH = 15 * TILEH
dim shared as single WINX = 0 'window over display bitmap
dim shared as single WINY = 0
const SCRW = 1280
const SCRH = 480
screenres SCRW,SCRH,32 'create a SCRWxSCRH window
color rgb(0,0,0),rgb(255,255,255):cls 'black ink, white paper
dim shared as any ptr thumb
thumb = imagecreate(400,400)
type TANK
as single x 'x position of center of disc
as single y 'y position of center of disc
as single w
as single h
as single dx 'change in x position per cycle
as single dy 'change in y position per cycle
as single v 'speed restricted to -1.0 to +1.0
as single rad 'radius of DISC
as single angle1 'direction in degrees
as single angle2 'direction of turret
as ulong c 'color of DISC
as integer task 'current task being done by agent
as integer ID 'ID of agent
as integer lastAngle 'memory for agent
as integer hitWall 'memory for agent
as integer hitTank 'memory for agent
end type
'NOTE: t1.x,t1.y is the center of the image NOT the top/right corner
dim shared as TANK t(0 to 6) 'create six tanks
t(0).x = BMAPW\2 'place in center of world.bmp
t(0).y = BMAPH\2
t(0).w = 49
t(0).h = 49
t(0).rad = 25
t(0).angle1 = 270 'starting angle (direction)
for i as integer = 1 to 6
t(i).x = WINW+i*50
t(i).y = WINH+10
t(i).w = 49
t(i).h = 49
t(i).rad = 25
t(i).angle1 = int(rnd(1)*360) 'starting angle (direction)
t(i).v = 3
next i
dim shared as any ptr world 'pointer called world
world = imagecreate(BMAPW,BMAPH,rgb(216,145,89)) 'points to a 512x512 bitmap
'fill with grid
for j as integer = 0 to TMAPH-1
for i as integer = 0 to TMAPW-1
if int(Rnd(1)*15) = 0 then
line world,(i*32,j*32)-(i*32+31,j*32+31),rgb(18,170,45),bf
line thumb,(i*2, j*2)-(i*2 +1 ,j*2 + 1),rgb(18,170,45),bf
else
line world,(i*32,j*32)-(i*32+31,j*32+31),rgb(108,70,45),bf
line thumb,(i*2, j*2 )-(i*2 +1 ,j*2 + 1),rgb(108,70,45),bf
end if
next i
next j
'draw thick border 1/2 win1
for i as integer = 0 to 2
line world,(WINW\2-i-t(0).w\2,WINH\2-i-t(0).h\2)-(BMAPW-WINW\2+i+t(0).w\2,BMAPH-WINH\2+i+t(0).h\2),rgb(0,0,0),b
next i
'same in thumb image
line thumb,(9,9)-(182,182),rgb(250,250,250),b
dim shared as any ptr win1
win1 = imagecreate(WINW,WINH) 'display window over world bitmap
dim shared as any ptr tank
tank = imagecreate(49,49)
'bload "tank.bmp",tank
dim as ulong colors( 7)
colors(0)=RGB(255,0,255)
colors(1)=RGB(0,0,0)
colors(2)=RGB(224,160,0)
colors(3)=RGB(64,128,0)
colors(4)=RGB(128,224,64)
colors(5)=RGB(32,96,0)
colors(6)=RGB(0,64,0)
dim as integer n
for j as integer = 0 to 48
for i as integer = 0 to 48
read n
pset tank,(i,j),colors(n)
next i
next j
'create another sprite for tank2 with different colors
restore TANK_IMAGE
dim shared as any ptr tank2
tank2 = imagecreate(49,49)
colors(2)=RGB(0,160,224)
colors(3)=RGB(0,128,64)
colors(4)=RGB(64,224,248)
colors(5)=RGB(0,96,32)
colors(6)=RGB(0,64,0)
for j as integer = 0 to 48
for i as integer = 0 to 48
read n
pset tank2,(i,j),colors(n)
next i
next j
'working bitmaps for rotation and display of other tanks
dim shared as any ptr scrSave2(0 to 6)
dim shared as any ptr rottank2(0 to 6)
for i as integer = 0 to 6
scrSave2(i) = imagecreate(49,49)
rottank2(i) = imagecreate(49,49)
next i
'add bitmap to hold rotated window
dim shared as any ptr rotWin1
rotWin1 = imagecreate(WINW,WINH)
sub display()
screenlock
cls
put (1050,0),thumb,trans 'show reduced version of world
put (0,0),win1,trans 'show window on world
put (530,0),rotWin1,trans 'show rotated version of window on world
for i as integer = 0 to 6
if i=0 then
circle (t(i).x * 0.0625 + 1050, t(i).y * 0.0625),3,rgb(255,10,10),,,,f
else
circle (t(i).x * 0.0625 + 1050, t(i).y * 0.0625),3,rgb(150,150,255),,,,f
end if
next i
screenunlock
end sub
sub update()
'show win on world while rotatetank still there
put win1,(0,0),world,(Cint(WINX), Cint(WINY))-( Cint(WINX+WINW-1), Cint(WINY+WINH-1) ),pset
' RESTORE BACKGROUND OF SPRITES IN REVERSE ORDER TO DRAWING THEM
for i as integer = 6 to 0 step -1
'************************** tank 2 ***********************************
put world,( Cint(t(i).x-24),Cint(t(i).y-24) ),scrSave2(i),pset 'restore tank2 area
'***********************************************************************
next i
'update window position relative to t(0)
WINX = t(0).x - WINW\2
WINY = t(0).y - WINH\2
for i as integer = 0 to 6
'move tanks
t(i).dx = cos(t(i).angle1 * DtoR) * t(i).v
t(i).dy = sin(t(i).angle1 * DtoR) * t(i).v
t(i).x = t(i).x + t(i).dx
t(i).y = t(i).y + t(i).dy
'contact with boundary
if i=0 then
if t(i).x <= WINW\2 or t(i).y <= WINH\2 or t(i).x >= BMAPW-1-WINW\2 or t(0).y > BMAPH-1-WINH\2 then
t(i).x = t(i).x - t(i).dx
t(i).y = t(i).y - t(i).dy
end if
else
if t(i).x <= WINW\2 or t(i).y <= WINH\2 or t(i).x >= BMAPW-1-WINW\2 or t(i).y > BMAPH-1-WINH\2 then
'set exit angle, lastAngle, if first hit
if t(i).hitWall = 0 then
t(i).lastAngle = t(i).angle1 + 160
if t(i).lastAngle > 360 then t(i).lastAngle = t(i).lastAngle-360
end if
t(i).x = t(i).x - t(i).dx
t(i).y = t(i).y - t(i).dy
t(i).v = 0 'turn off motors
t(i).hitWall = 1 'flag it hit a wall
end if
end if
if i<>0 then
if t(i).hitWall = 1 then
if t(i).angle1 <> t(i).lastAngle then
t(i).angle1 = t(i).angle1 + 1
if t(i).angle1 > 360 then t(i).angle1 = t(i).angle1 - 360
else
t(i).hitWall = 0
t(i).v = 3 'start up motors
end if
end if
end if
'was there any contact with another tank?
for j as integer = 0 to 6
if i<>j then 'don't compare with self
if sqr( (t(i).x - t(j).x)^2 + (t(i).y - t(j).y)^2) <= t(i).rad then
t(i).x = t(i).x - t(i).dx
t(i).y = t(i).y - t(i).dy
t(i).angle1 = t(i).angle1 + 1
if t(i).angle1 > 359 then t(i).angle1 = t(i).angle1-360
t(i).hittank = 1 'flag it hit another tank
end if
end if
next j
next i
for i as integer = 0 to 6
'*************************** tank(i) *********************************
put scrSave2(i),(0,0),world,( Cint(t(i).x-24), Cint(t(i).y-24) )-( Cint(t(i).x+t(i).w-1-24), Cint(t(i).y+t(i).h-1-24) ),pset
if i=0 then
sprite_rotate(tank,rottank2(i),(360-t(i).angle1)*DtoR,rgb(255,0,255)) 'make rotated image
else
sprite_rotate(tank2,rottank2(i),(360-t(i).angle1)*DtoR,rgb(255,0,255)) 'make rotated image
end if
put world,( Cint(t(i).x-24), Cint(t(i).y-24) ),rottank2(i),trans 'overlay rotated tank
'*************************************************************************
next i
'create a rotated window
sprite_rotate(win1,rotWin1,(t(0).angle1-270)*DtoR,rgb(255,0,255))
end sub
sub userInput()
t(0).v = 0
'tank keys to move window
if multikey(&H50) then t(0).v = -5 'DOWN KEY
if multikey(&H48) then t(0).v = +5 'UP KEY
if multikey(&H4D) then t(0).angle1 = t(0).angle1 + 2 'RIGHT KEY
if multikey(&H4B) then t(0).angle1 = t(0).angle1 - 2
if t(0).angle1 < 0 then t(0).angle1 = t(0).angle1 + 360
if t(0).angle1 > 359 then t(0).angle1 = t(0).angle1 - 360
end sub
for i as integer = 0 to 6
'************************************* tank 2 ********************************************************
put scrSave2(i),(0,0),world,( Cint(t(i).x-24), Cint(t(i).y-24) )-( Cint(t(i).x+t(i).w-1-24), Cint(t(i).y+t(i).h-1-24) ),pset
'***********************************************************************************************************
next i
do
userInput()
update()
display()
sleep regulate(60,fps) '<--------------- set fps here
loop until multikey(&H01) 'loop until ESC key pressed
bsave "world.bmp",world
TANK_IMAGE:
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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,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,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,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,3,4,4,5,5,1,1,1,1,1,1,5,5,4,4,4,4,4,3,1,1,1,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,3,4,5,1,1,3,3,3,3,3,3,1,1,5,4,4,4,4,3,5,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,0,0,1,1,3,5,1,3,3,3,4,4,4,4,4,3,3,1,3,4,4,4,3,5,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,0,0,1,1,3,5,1,3,4,4,4,4,4,4,4,4,4,1,5,5,4,4,3,5,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,0,0,5,1,3,1,3,4,4,4,4,4,4,4,4,4,4,1,1,1,3,3,3,5,1,0,1,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,3,1,4,4,4,4,3,3,4,4,4,4,4,1,3,3,1,1,1,1,1,1,3,3,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,3,1,4,4,4,4,1,1,4,4,1,4,4,1,4,4,3,3,3,3,3,3,4,4,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,3,1,4,4,4,4,1,4,4,4,1,4,4,1,4,4,1,1,1,1,1,1,4,4,6,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,3,1,4,4,4,4,1,3,3,3,1,4,4,1,1,1,4,4,3,5,1,0,1,1,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,3,4,1,4,4,4,1,1,1,1,1,4,4,1,4,4,4,4,3,5,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,0,0,1,1,3,4,1,4,4,4,4,4,4,4,4,4,4,1,4,4,4,4,3,5,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,0,0,1,1,3,4,4,1,1,4,4,4,4,4,4,1,1,4,4,4,4,4,3,5,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,0,1,1,1,3,4,4,4,4,1,1,1,1,1,1,4,4,4,4,4,4,4,3,1,1,1,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,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,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,2,1,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,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,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,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,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,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,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,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,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,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,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,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,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,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,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,0,0,0,0,0,0,0,0,0,0,0,0,0,0