This is a simple first try implementing some of the Boulder Dash behaviours. It uses ASC graphics.
A player must keep moving when under a rock, you cannot hold it in place. If you don't keep moving you will be hit and returned to the start position. That will occur if you are just tapping the arrow keys to move from tile to tile instead of holding the key down until you have passed the rock overhead without stopping.
The rocks do not roll off each other.
To exit the program when bored hit the ESC key.
The font size is rather small so to double the size and use images instead run makeBlock16 to create a bitmap that is needed by the second example (same code mechanics, different display).
makeBlock16.bas
Code: Select all
screenres 1280,600,32
dim shared as any ptr ascBlock8
ascBlock8 = imagecreate(8*16,8*16)
dim shared as any ptr ascBlock16
ascBlock16 = imagecreate(16*16,16*16)
for j as integer = 0 to 15
for i as integer = 0 to 15
draw string ascBlock8,(i*8,j*8),chr(i+j*16)
next i
next j
put (0,0),ascBlock8,trans
'sleep
dim as ulong v
for j as integer = 0 to 8*16
for i as integer = 0 to 8*16
v = point(i,j,ascBlock8)
line ascBlock16,(i*2,j*2)-(i*2+1,j*2+1),v,bf
next i
next j
cls
put (0,0),ascBlock16,trans
'sleep
for j as integer = 0 to 16*16-1
for i as integer = 0 to 16*16-1
if point(i,j,ascBlock16)=rgb(0,0,0) then
pset ascBlock16,(i,j),rgb(255,0,255)
end if
next i
next j
cls
put (0,0),ascBlock16,pset
bsave "ascBlock16.bmp",ascBlock16
print "ascBlock16"
'sleep
Code: Select all
screenres 640,480,32
cls
dim shared as integer diamondScore
dim shared as integer playerHit
const TMAPW = 40 'size of tmap in tiles
const TMAPH = 22
type SPRITE
as integer x
as integer y
as integer dx
as integer dy
as integer d 'direction 0,1,2,3,4
end type
dim shared as SPRITE player
player.x = 3
player.y = 2
dim shared as integer TMAP(TMAPW,TMAPH) 'tile id
'read tile id array into TMAP()
for j as integer = 0 to TMAPH-1
for i as integer = 0 to TMAPW-1
read TMAP(i,j)
next i
next j
sub redoBitMap
screenlock
cls
dim as integer ID
for j as integer = 0 to TMAPH-1
for i as integer = 0 to TMAPW-1
ID = TMAP(i,j)
if ID = 1 then
draw string(i*8,j*8),chr(10),rgb(155,155,200)
end if
if ID = 2 then
draw string(i*8,j*8),chr(177),rgb(200,150,0)
end if
if ID = 4 then
draw string(i*8,j*8),chr(4),rgb(100,100,255)
end if
if ID = 3 then
draw string(i*8,j*8),chr(7),rgb(255,150,0) 'chr(79)
end if
if ID = 5 then
draw string(i*8,j*8),chr(8)
end if
draw string (player.x*8,player.y*8),chr(2),rgb(255,255,0)
next i
next j
locate 24,2
print "DIAMOND SCORE =";diamondScore
print
print " PLAYER HIT =";playerHit
screenunlock
end sub
redoBitMap()
sub dropRocks()
for j as integer = TMAPH-2 to 2 step -1
for i as integer = 1 to TMAPW-2
if TMAP(i,j)=0 and TMAP(i,j-1)=3 then
TMAP(i,j)=3
TMAP(i,j-1)=0
end if
next i
next j
end sub
sub makeMove()
if TMAP(player.x,player.y)=3 then
playerHit = playerHit + 1
end if
player.dx = 0
player.dy = 0
if player.d = 1 then
if TMAP(player.x,player.y-1)<>1 and TMAP(player.x,player.y-1)<>5 and TMAP(player.x,player.y-1)<>3 then 'UP
player.dy = - 1
end if
end if
if player.d = 2 then
if TMAP(player.x,player.y+1)<>1 and TMAP(player.x,player.y+1)<>5 and TMAP(player.x,player.y+1)<>3 then 'DOWN
player.dy = + 1
end if
end if
if player.d = 3 then
if TMAP(player.x-1,player.y)<>1 and TMAP(player.x-1,player.y)<>5 and TMAP(player.x-1,player.y)<>3 then 'LEFT
player.dx = - 1
end if
end if
if player.d = 4 then
if TMAP(player.x+1,player.y)<>1 and TMAP(player.x+1,player.y)<>5 and TMAP(player.x+1,player.y)<>3 then 'RIGHT
player.dx = + 1
end if
end if
TMAP(player.x,player.y)=0 'clear old spot for rock to fall
player.x = player.x + player.dx
player.y = player.y + player.dy
if TMAP(player.x,player.y)= 4 then
diamondScore = diamondScore + 1
end if
end sub
dim as double st
st = timer
do
if (timer - st) > .1 then
st = timer
dropRocks()
if playerHit = 1 then
TMAP(player.x,player.y)=3
player.x = 3
player.y = 2
end if
player.d = 0
if multikey(&H48) then player.d = 1
if multikey(&H50) then player.d = 2
if multikey(&H4B) then player.d = 3
if multikey(&H4D) then player.d = 4
makeMove()
redoBitMap()
end if
sleep 2
loop until multikey(&H01)
'TMAP data
data 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,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,2,2,2,2,2,2,0,2,2,4,2,3,0,2,2,2,2,2,3,2,3,2,2,2,2,2,2,2,0,2,2,2,2,3,2,2,2,2,1
data 1,2,3,2,3,2,2,2,2,2,2,0,2,2,2,2,2,2,2,2,2,3,4,2,2,3,2,2,2,2,0,2,2,2,2,2,0,2,2,1
data 1,2,2,2,2,2,2,2,2,2,2,0,2,2,0,2,2,2,2,2,3,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,1
data 1,3,2,0,0,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,2,3,2,2,2,2,3,2,2,2,3,2,2,2,2,2,1
data 1,3,2,3,3,2,2,2,2,2,2,2,2,2,3,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,3,0,2,1
data 1,2,2,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,3,2,0,3,2,2,2,2,2,2,2,2,3,2,3,3,2,1
data 1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2,2,2,3,2,2,3,2,1
data 1,2,0,2,2,2,3,2,2,4,2,0,2,2,3,2,3,2,2,2,2,2,2,2,2,2,2,3,2,3,0,2,2,2,2,2,2,3,2,1
data 1,2,2,4,2,2,2,2,2,3,2,2,2,2,2,0,2,2,2,2,2,2,2,2,3,0,0,3,2,2,4,2,2,2,2,3,2,2,2,1
data 1,2,2,2,3,2,2,3,2,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,2,3,2,2,3,2,2,2,2,2,2,2,2,1
data 1,2,0,2,2,2,2,2,3,2,2,2,2,2,2,2,2,3,3,0,2,2,2,2,2,2,2,3,2,2,3,2,4,2,2,2,2,0,2,1
data 1,2,3,2,2,0,2,2,3,2,0,0,2,2,2,2,2,3,2,3,4,2,2,4,2,2,2,2,3,2,2,2,3,2,2,4,2,3,2,1
data 1,2,4,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,2,2,3,2,2,2,2,2,2,2,2,4,2,2,2,2,2,3,1
data 1,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1
data 1,0,0,2,2,2,2,2,2,2,2,2,0,2,2,2,4,2,2,2,2,3,2,2,2,2,2,3,2,2,2,3,2,2,2,2,2,2,2,1
data 1,3,0,2,2,2,2,2,2,2,2,2,3,3,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,3,2,3,0,2,2,2,1
data 1,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,3,2,0,0,2,2,2,2,4,2,2,2,3,2,3,3,2,2,2,1
data 1,2,2,2,2,3,4,2,2,0,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,3,4,2,2,2,2,2,2,3,2,2,2,1
data 1,2,2,2,0,2,2,0,2,3,2,2,3,2,3,3,2,2,2,2,2,2,2,2,2,3,2,3,4,2,2,2,2,2,2,3,2,2,3,1
data 1,2,4,2,2,2,2,3,2,2,2,2,2,0,2,2,2,2,2,2,2,2,2,0,2,3,2,2,3,2,2,2,2,3,2,2,2,3,2,1
data 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,1,1,1,1,1,1,1,1,1,1,1,1,1
Code: Select all
screenres 640,480,32
cls
dim shared as any ptr ascBlock16
ascBlock16 = imagecreate(256,256,rgb(255,0,255))
bload "ascBlock16.bmp",ascBlock16
dim shared as integer diamondScore
dim shared as integer playerHit
const TMAPW = 40 'size of tmap in tiles
const TMAPH = 22
const TILEW = 16
const TILEH = 16
type SPRITE
as integer x
as integer y
as integer dx
as integer dy
as integer d 'direction 0,1,2,3,4
end type
dim shared as SPRITE player
player.x = 3
player.y = 2
dim shared as integer TMAP(TMAPW,TMAPH) 'tile id
'read tile id array into TMAP()
for j as integer = 0 to TMAPH-1
for i as integer = 0 to TMAPW-1
read TMAP(i,j)
next i
next j
sub redoBitMap
screenlock
cls
dim as integer ID
for j as integer = 0 to TMAPH-1
for i as integer = 0 to TMAPW-1
ID = TMAP(i,j)
if ID = 1 then
'draw string(i*8,j*8),chr(10),rgb(155,155,200)
put (i*TILEW,j*TILEH),ascBlock16,(10*16,0)-(10*16+15,15),trans
'put (i*TILEW,j*TILEH),ascBlock16,(10*16,0)-(10*16+15,15),trans
end if
if ID = 2 then
'draw string(i*8,j*8),chr(177),rgb(200,150,0)
put (i*TILEW,j*TILEH),ascBlock16,(1*16,11*16)-(1*16+15,11*16+15),trans
end if
if ID = 4 then
'draw string(i*8,j*8),chr(4),rgb(100,100,255)
put (i*TILEW,j*TILEH),ascBlock16,(4*16,0)-(4*16+15,15),trans
end if
if ID = 3 then
'draw string(i*8,j*8),chr(7),rgb(255,150,0) 'chr(79)
put (i*TILEW,j*TILEH),ascBlock16,(15*16,4*16)-(15*16+15,4*16+15),trans
end if
if ID = 5 then
'draw string(i*8,j*8),chr(8)
put (i*TILEW,j*TILEH),ascBlock16,(8*16,0)-(8*16+15,15),trans
end if
'draw string (player.x*8,player.y*8),chr(2),rgb(255,255,0)
next i
next j
put (player.x*16,player.y*16),ascBlock16,(2*16,0)-(2*16+15,15),trans
locate 47,2
print "DIAMOND SCORE =";diamondScore
print
print " PLAYER HIT =";playerHit
screenunlock
end sub
redoBitMap()
sub dropRocks()
for j as integer = TMAPH-2 to 2 step -1
for i as integer = 1 to TMAPW-2
if TMAP(i,j)=0 and TMAP(i,j-1)=3 then
TMAP(i,j)=3
TMAP(i,j-1)=0
end if
next i
next j
end sub
sub makeMove()
if TMAP(player.x,player.y)=3 then
playerHit = playerHit + 1
end if
player.dx = 0
player.dy = 0
if player.d = 1 then
if TMAP(player.x,player.y-1)<>1 and TMAP(player.x,player.y-1)<>5 and TMAP(player.x,player.y-1)<>3 then 'UP
player.dy = - 1
end if
end if
if player.d = 2 then
if TMAP(player.x,player.y+1)<>1 and TMAP(player.x,player.y+1)<>5 and TMAP(player.x,player.y+1)<>3 then 'DOWN
player.dy = + 1
end if
end if
if player.d = 3 then
if TMAP(player.x-1,player.y)<>1 and TMAP(player.x-1,player.y)<>5 and TMAP(player.x-1,player.y)<>3 then 'LEFT
player.dx = - 1
end if
end if
if player.d = 4 then
if TMAP(player.x+1,player.y)<>1 and TMAP(player.x+1,player.y)<>5 and TMAP(player.x+1,player.y)<>3 then 'RIGHT
player.dx = + 1
end if
end if
TMAP(player.x,player.y)=0 'clear old spot for rock to fall
player.x = player.x + player.dx
player.y = player.y + player.dy
if TMAP(player.x,player.y)= 4 then
diamondScore = diamondScore + 1
end if
end sub
dim as double st
st = timer
do
if (timer - st) > .1 then
st = timer
dropRocks()
if playerHit = 1 then
TMAP(player.x,player.y)=3
player.x = 3
player.y = 2
end if
player.d = 0
if multikey(&H48) then player.d = 1
if multikey(&H50) then player.d = 2
if multikey(&H4B) then player.d = 3
if multikey(&H4D) then player.d = 4
makeMove()
redoBitMap()
end if
sleep 2
loop until multikey(&H01)
'TMAP data
data 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,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,2,2,2,2,2,2,0,2,2,4,2,3,0,2,2,2,2,2,3,2,3,2,2,2,2,2,2,2,0,2,2,2,2,3,2,2,2,2,1
data 1,2,3,2,3,2,2,2,2,2,2,0,2,2,2,2,2,2,2,2,2,3,4,2,2,3,2,2,2,2,0,2,2,2,2,2,0,2,2,1
data 1,2,2,2,2,2,2,2,2,2,2,0,2,2,0,2,2,2,2,2,3,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,1
data 1,3,2,0,0,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,2,3,2,2,2,2,3,2,2,2,3,2,2,2,2,2,1
data 1,3,2,3,3,2,2,2,2,2,2,2,2,2,3,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,3,0,2,1
data 1,2,2,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,3,2,0,3,2,2,2,2,2,2,2,2,3,2,3,3,2,1
data 1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2,2,2,3,2,2,3,2,1
data 1,2,0,2,2,2,3,2,2,4,2,0,2,2,3,2,3,2,2,2,2,2,2,2,2,2,2,3,2,3,0,2,2,2,2,2,2,3,2,1
data 1,2,2,4,2,2,2,2,2,3,2,2,2,2,2,0,2,2,2,2,2,2,2,2,3,0,0,3,2,2,4,2,2,2,2,3,2,2,2,1
data 1,2,2,2,3,2,2,3,2,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,2,3,2,2,3,2,2,2,2,2,2,2,2,1
data 1,2,0,2,2,2,2,2,3,2,2,2,2,2,2,2,2,3,3,0,2,2,2,2,2,2,2,3,2,2,3,2,4,2,2,2,2,0,2,1
data 1,2,3,2,2,0,2,2,3,2,0,0,2,2,2,2,2,3,2,3,4,2,2,4,2,2,2,2,3,2,2,2,3,2,2,4,2,3,2,1
data 1,2,4,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,2,2,3,2,2,2,2,2,2,2,2,4,2,2,2,2,2,3,1
data 1,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1
data 1,0,0,2,2,2,2,2,2,2,2,2,0,2,2,2,4,2,2,2,2,3,2,2,2,2,2,3,2,2,2,3,2,2,2,2,2,2,2,1
data 1,3,0,2,2,2,2,2,2,2,2,2,3,3,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,3,2,3,0,2,2,2,1
data 1,2,3,2,2,3,2,2,2,2,2,2,2,2,3,2,2,2,2,2,3,2,0,0,2,2,2,2,4,2,2,2,3,2,3,3,2,2,2,1
data 1,2,2,2,2,3,4,2,2,0,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,3,2,3,4,2,2,2,2,2,2,3,2,2,2,1
data 1,2,2,2,0,2,2,0,2,3,2,2,3,2,3,3,2,2,2,2,2,2,2,2,2,3,2,3,4,2,2,2,2,2,2,3,2,2,3,1
data 1,2,4,2,2,2,2,3,2,2,2,2,2,0,2,2,2,2,2,2,2,2,2,0,2,3,2,2,3,2,2,2,2,3,2,2,2,3,2,1
data 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,1,1,1,1,1,1,1,1,1,1,1,1,1