The character can only move tile to tile there is no in between positions.
This makes it easier to position the sprite to move between tile sized obstacles.
You need to load each .png image into a paint program and save them as .bmp
The tiles and background may look simple but more artistic versions will follow if I keep working on the program.
Code: Select all
screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls 'white paper, pen black
dim shared as any ptr minerSheet
minerSheet = imagecreate(128,288)
bload "minerSheet.bmp",minerSheet
dim shared as any ptr background
background = imagecreate(640,480)
bload "background.bmp",background
dim shared as any ptr dirt
dirt = imagecreate(32,32)
bload "dirt.bmp",dirt
dim shared as any ptr nugget
nugget = imagecreate(32,32)
bload "nugget.bmp",nugget
dim shared as any ptr ladder
ladder = imagecreate(32,32)
bload "ladder.bmp",ladder
dim shared as integer frameCount
dim shared as integer frameTimer
dim shared as integer GoldTotal
const TMAPW = 20 'size of tile map array
const TMAPH = 15
const TILEW = 32 'size of tile
const TILEH = 32
dim shared as integer TILEX, TILEY
type agent
as integer x 'current pixel position
as integer y
as integer dx 'change in pixel position per frame
as integer dy
as integer d 'image number
end type
dim shared as agent ag 'create an agent
ag.x = 4*TILEW 'start at tile(4,2)
ag.y = 2*TILEH
dim shared as integer TMAP(0 to TMAPW-1,0 to TMAPH-1)
for j as integer = 0 to 14
for i as integer = 0 to 19
read TMAP(i,j)
next i
next j
dim shared as integer GMAP(0 to TMAPW-1,0 to TMAPH-1)
for i as integer = 0 to 20
GMAP(int(Rnd(1)*20),int(rnd(1)*10)+3) = 1
next i
sub drawTiles()
for j as integer = 0 to 14
for i as integer = 0 to 19
if TMAP(i,j) = 1 then
put (i*32,j*32),dirt,trans
end if
if TMAP(i,j) = 2 then
put (i*32,j*32),ladder,trans
end if
if GMAP(i,j) = 1 then
put (i*32,j*32),nugget,trans
end if
next i
next j
end sub
sub display()
screenlock
cls
put (0,0),background,trans
drawTiles()
put (ag.x,ag.y),minerSheet,(frameCount*32, ag.d * 32)-(frameCount*32 + 31, ag.d * 32 + 31),trans
frameTimer = frameTimer + 1
if frameTimer = 8 then
frameTimer = 0
frameCount = frameCount + 1
if frameCount > 3 then frameCount = 0
end if
line (TILEX*32,TILEY*32)-(TILEX*32+31,TILEY*32+31),rgb(255,255,0),b
locate 2,1
print " GOLD =";GoldTotal
print " Press [d] key to DIG"
print " Press [b] key to make LADDER"
print " cursor keys move miner"
screenunlock
end sub
dim as double start
start = timer
do
display()
dim as integer onTile
onTile = 0
'test if ag.x,ag.y is in the center of a tile
if ag.x = int(ag.x\TILEW)*TILEW and ag.y = int(ag.y\TILEH)*TILEH then
onTile = 1 'yes on center
end if
TILEX = int(ag.x\TILEW)
TILEY = int(ag.y\TILEH)
'when on tile check for next move
if onTile = 1 then
if GMAP(TILEX,TILEY)=1 then
goldTotal = goldTotal + 1
GMAP(TILEX,TILEY)=0
end if
if multikey(&H20) then
if ag.d = 0 then
ag.d = 5
end if
if ag.d = 1 then
ag.d = 6
end if
if ag.d = 2 then
ag.d = 8
end if
if ag.d = 4 then
ag.d = 7
end if
'do animation
start = timer
while (timer-start) < 1
display()
sleep 2
wend
if ag.d = 5 then ag.d = 0:TMAP(TILEX+1,TILEY)=0
if ag.d = 6 then ag.d = 1:TMAP(TILEX-1,TILEY)=0
if ag.d = 7 then ag.d = 4:TMAP(TILEX,TILEY+1)=0
if ag.d = 8 then ag.d = 2:TMAP(TILEX,TILEY-1)=0
end if
if multikey(&H30) then
TMAP(TILEX,TILEY)=2 'build ladder
end if
ag.dx = 0
ag.dy = 0
if multikey(&H4D) then 'move right
ag.d = 0
if TMAP(TILEX+1,TILEY)<>1 then
ag.dx = 1
end if
end if
if multikey(&H4B) then 'move left
ag.d = 1
if TMAP(TILEX-1,TILEY)<>1 then
ag.dx = -1
end if
end if
if multikey(&H48) then 'move up
ag.d = 2
if TMAP(TILEX,TILEY) = 2 and (TMAP(TILEX,TILEY-1) = 0 or TMAP(TILEX,TILEY-1)=2) then
ag.dx = 0
ag.dy = -1
end if
end if
if multikey(&H50) then 'move down
ag.d = 4
if TMAP(TILEX,TILEY+1)=2 then
ag.dx = 0
ag.dy = 1
ag.d = 2
end if
end if
'gravity
if TMAP(TILEX,TILEY+1)=0 then
ag.dy = 1
ag.dx = 0 'no side movement
ag.d = 3
end if
if TMAP(TILEX,TILEY+1)<>0 and ag.d = 3 then 'stop falling
ag.d = 4
end if
if ag.dx = 0 and ag.dy = 0 and ag.d < 5 then frameCount = 0
end if
'make move to next tile
ag.x = ag.x + ag.dx
ag.y = ag.y + ag.dy
'check for out of boundary
if ag.x < 0 then ag.x = 0
if ag.x > TMAPW*TILEW-TILEW then
ag.x = ag.x - ag.dx
end if
if ag.y < 0 then ag.y = 0
if ag.y > TMAPH*TILEH-TILEH then
ag.y = ag.y - ag.dy
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,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
data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data 1,1,1,1,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,1,1,1,1
data 1,1,1,1,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,1,1,1,1
data 1,1,1,1,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,1,1,1,1
data 1,1,1,1,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,1,1,1,1
data 1,1,1,1,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,1,1,1,1
data 1,1,1,1,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,1,1,1,1
