So I have implemented pushing blocks. When the player is next to and facing a block hitting the SPACE BAR will cause the block to move off in that direction until it hits another block or the boundary.
Code: Select all
const WORLDW = 13
const WORLDH = 15
const TILEW = 32
const TILEH = 32
const SCRW = WORLDW*TILEW
const SCRH = WORLDH*TILEH
type AGENT
as integer x 'current position
as integer y
as integer w
as integer h
as integer dx 'velocity between -1 and +1
as integer dy
as integer d 'direction
as integer f 'current frame
as integer tf 'total frames
as integer count 'delay between frame increment
as integer ID
as any ptr img 'sprite image block
as integer a
end type
dim shared as integer count 'frame delay
dim shared as integer blkID
dim shared as integer agentCount
agentCount = 5 'player = 0 and block = agentCount-1
blkID = agentCount-1
dim shared as integer WINX,WINY,WINW,WINH
screenres SCRW, SCRH, 32
color rgb(0,0,0),rgb(255,255,255):cls
chdir exepath() ' !!! for image loading be sure it's the right folder
dim shared as any ptr block1
block1 = imagecreate(96,128)
'paint images in block
for j as integer = 0 to 3
for i as integer = 0 to 2
line block1,(i*32,j*32)-(i*32+31,j*32+31),rgb(255,i*100,0),bf
line block1,(i*32,j*32)-(i*32+31,j*32+31),rgb(0,0,0),b
next i
next j
dim shared as any ptr greenBlob
greenBlob = imagecreate(96,128)
bload "greenBlob1.bmp",greenBlob
dim shared as any ptr redPenguin
redPenguin = imagecreate(96,128)
bload "redPenguin1.bmp",redPenguin
dim shared as AGENT ag(0 to agentCount-1)
for i as integer = 1 to agentCount-2 'skip player ag(0) and player(agentCount-1)
ag(i).w = 32
ag(i).h = 32
ag(i).y = 0
ag(i).x = i*TILEW*2
ag(i).id = i
ag(i).dx = int(rnd(1)*3)-1
ag(i).dy = int(rnd(1)*3)-1
while ag(i).dx = 0 and ag(i).dy=0
ag(i).dx = int(rnd(1)*3)-1
ag(i).dy = int(rnd(1)*3)-1
wend
ag(i).img = greenBlob
ag(i).a = 1
next i
ag(0).id = 0
ag(0).w = 32
ag(0).h = 32
ag(0).img = redPenguin
ag(0).a = 1
ag(blkID).id = blkID
ag(blkID).w = 32
ag(blkID).h = 32
ag(blkID).x = 32
ag(blkID).y = 0
ag(blkID).dx = 0
ag(blkID).dy = 0
ag(blkID).img = block1
ag(blkID).a = 0
dim shared as integer world(WORLDW,WORLDH)
for j as integer = 0 to WORLDH-1
for i as integer = 0 to WORLDW-1
read world(i,j)
next i
next j
function spriteCollision(b1 as AGENT,b2 as AGENT) as boolean
return b2.y < (b1.y + b1.h) and (b2.y + b2.h) > b1.y and b2.x < (b1.x + b1.w) and (b2.x + b2.w) > b1.x
end function
sub drawWorld()
screenlock
cls
'draw tiles
for j as integer = 0 to WORLDH-1
for i as integer = 0 to WORLDW-1
if world(i,j)=1 then
line (i*TILEW,j*TILEH)-(i*TILEW+TILEW,j*TILEH+TILEH),rgb(100,100,200),bf
end if
if world(i,j)=2 then
line (i*TILEW,j*TILEH)-(i*TILEW+TILEW,j*TILEH+TILEH),rgb(200,100,100),bf
end if
next i
next j
'draw agents
for i as integer = 0 to agentCount-1
if ag(i).a = 1 then
if ag(i).dx = 0 and ag(i).dy = 0 then ag(i).f = 1
draw string (ag(i).x,ag(i).y),str(i)
put (ag(i).x,ag(i).y),ag(i).img,(ag(i).f*32,ag(i).d*32)-(ag(i).f*32+31,ag(i).d*32+31),trans
end if
next i
screenunlock
end sub
sub makeMove(ag as AGENT)
ag.x = ag.x + ag.dx
ag.y = ag.y + ag.dy
end sub
function outOfBounds(ag as AGENT) as boolean
if ag.x < 0 or ag.x > SCRW-TILEW or ag.y < 0 or ag.y > SCRH-TILEH then
return TRUE
else
return FALSE
end if
end function
function tileCollision(ag as AGENT) as boolean
dim as boolean hit
dim as integer TILEX,TILEY
'test overlap of another tile
TILEX = int(ag.x/TILEW)
TILEY = int(ag.y/TILEH)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x+TILEW-1)/TILEW)
TILEY = int((ag.y)/TILEH)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x)/TILEW)
TILEY = int((ag.y+TILEH-1)/TILEH)
if world(TILEX,TILEY)<>0 then hit = 1
TILEX = int((ag.x+TILEW-1)/TILEW)
TILEY = int((ag.y+TILEH-1)/TILEH)
if world(TILEX,TILEY)<>0 then hit = 1
return hit
end function
sub undoMove(ag as AGENT)
ag.x = ag.x - ag.dx 'undo move
ag.y = ag.y - ag.dy
end sub
sub changeDirection(ag as AGENT)
ag.dx = int(rnd(1)*3)-1
ag.dy = int(rnd(1)*3)-1
while (ag.dx and ag.dy) or (ag.dx=0 and ag.dy=0)
ag.dx = int(rnd(1)*3)-1
ag.dy = int(rnd(1)*3)-1
wend
end sub
function onTile(ag as AGENT) as boolean
if ag.x = int(ag.x\TILEW)*TILEW and ag.y = int(ag.y\TILEH)*TILEH then
return TRUE
else
return FALSE
end if
end function
sub setDirection(ag as AGENT)
If ag.dx < 0 then ag.d = 1
If ag.dx > 0 then ag.d = 2
If ag.dy < 0 then ag.d = 3
If ag.dy > 0 then ag.d = 0
end sub
sub upDateFrame(ag as AGENT)
ag.count = ag.count + 1
if ag.count>10 then
ag.count = 0
ag.f = ag.f + 1
if ag.f = 3 then ag.f = 0
end if
end sub
sub update()
dim as integer hit
for i as integer = 0 to agentCount-1
if ag(i).a = 1 then
hit = 0
makeMove(ag(i))
if outOfBounds(ag(i)) then
hit = 1
end if
if tileCollision(ag(i)) then
hit = 2
end if
updateFrame(ag(i))
for j as integer = 0 to agentCount-1 'for each other sprite
if i <> j then 'not with itself
if ag(j).a = 1 then 'it exists
if spriteCollision(ag(i),ag(j)) = TRUE then
hit = 3
end if
end if
end if
next j
if hit <> 0 then
if i = blkID then
if hit = 1 or hit = 2 then
undoMove(ag(blkID))
ag(blkID).a = 0
world(ag(blkID).x\TILEW,ag(blkID).y\TILEH)=1
end if
else
undoMove(ag(i))
if i<>0 then 'not player
changeDirection(ag(i))
setDirection(ag(i))
end if
end if
end if
end if
next i
'read player input if on center of tile
if onTile(ag(0)) then
ag(0).dx = 0
ag(0).dy = 0
'only one of four directions possible
If MultiKey(&H4B) then ag(0).dx = -2:ag(0).dy = 0
If MultiKey(&H4D) then ag(0).dx = 2:ag(0).dy = 0
If MultiKey(&H48) then ag(0).dy = -2:ag(0).dx = 0
If MultiKey(&H50) then ag(0).dy = 2:ag(0).dx = 0
setDirection(ag(0))
if multikey(&H39) then
if ag(0).d = 0 and world(ag(0).x\TILEW,ag(0).y\TILEH+1)<>0 then 'moving down
world(ag(0).x\TILEW,ag(0).y\TILEH+1)=0
ag(blkID).dy = 1
ag(blkID).dx = 0
ag(blkID).a = 1
ag(blkID).x = ag(0).x
ag(blkID).y = ag(0).y+32
end if
if ag(0).d = 1 and world(ag(0).x\TILEW-1,ag(0).y\TILEH)<>0 then 'moving left
world(ag(0).x\TILEW-1,ag(0).y\TILEH)=0
ag(blkID).dx = -1
ag(blkID).dy = 0
ag(blkID).a = 1
ag(blkID).x = ag(0).x-32
ag(blkID).y = ag(0).y
end if
if ag(0).d = 2 and world(ag(0).x\TILEW+1,ag(0).y\TILEH)<>0 then 'moving right
world(ag(0).x\TILEW+1,ag(0).y\TILEH)=0
ag(blkID).dx = 1
ag(blkID).dy = 0
ag(blkID).a = 1
ag(blkID).x = ag(0).x+32
ag(blkID).y = ag(0).y
end if
if ag(0).d = 3 and world(ag(0).x\TILEW,ag(0).y\TILEH-1)<>0 then 'moving up
world(ag(0).x\TILEW,ag(0).y\TILEH-1)=0
ag(blkID).dy = -1
ag(blkID).dx = 0
ag(blkID).a = 1
ag(blkID).x = ag(0).x
ag(blkID).y = ag(0).y - 32
end if
end if
end if
end sub
dim as double now1
now1 = timer
update()
do
if timer > now1 + 0.01 then
now1 = timer
update()
drawWorld()
end if
sleep 2
loop until multikey(&H01)
data 0,0,0,0,0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,1,1,1,1,0,0,1,0
data 0,1,0,1,0,1,0,1,0,1,0,0,0
data 1,2,0,2,0,0,0,0,0,1,0,2,0
data 1,0,0,0,0,0,0,0,0,1,0,1,0
data 0,0,1,0,0,0,1,1,0,1,0,1,0
data 1,0,0,0,0,0,0,0,0,1,0,1,0
data 1,1,1,0,1,1,0,1,1,1,0,1,0
data 0,0,0,0,0,0,0,1,0,1,0,0,0
data 0,0,0,0,1,1,0,0,0,0,0,1,1
data 0,0,0,0,0,1,0,0,0,0,0,0,0
data 0,1,0,0,0,1,0,1,0,0,0,0,0
data 0,1,0,0,0,0,0,0,1,1,0,1,0
data 0,0,0,0,0,0,0,0,0,0,0,1,0
data 0,1,0,0,0,0,0,0,0,1,0,1,0