Boulder Dash clone coding challenge

Game development specific discussions.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Boulder Dash clone coding challenge

Post by BasicCoder2 »

I had thought about coding a version of Boulder Dash just as a coding challenge.

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
Boulder1.bas

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
Boulder2.bas uses graphics instead draw string

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
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Boulder Dash clone coding challenge

Post by aurelVZAB »

thanks BasicCoder2 :)
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Boulder Dash clone coding challenge

Post by BasicCoder2 »

I doubt it was of any interest for anyone. I think it has been over 10 years since FreeBASIC was used for making retro games except maybe Toad on Fire which was a mixture of techniques and was written over many years. Today those learning to program by making a simple game are directed to Python or JavaScript. These simpler kinds of games are played on android tablets or mobile phones.

I don't know if there were any FreeBASIC Boulder Dash clones written. I am writing a better and hopefully more original boulder dash like game. Mostly I use FreeBASIC for other projects. This effort was only for light relief as a challenge to fill in some spare time.

This was the beginning of another clone but there wasn't any responses.
viewtopic.php?t=28438
My 8 year old grand daughter liked it :)

Something that has interested me is the problem of writing code in a way that you can easily port it to another language. That usually means not using special features of any particular language (hard to do with Python). However I think it comes down to being good at both languages and simply coding the behaviours without regard to trying to translate it at the coded level.
Imortis
Moderator
Posts: 1923
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: Boulder Dash clone coding challenge

Post by Imortis »

BasicCoder2 wrote: Nov 09, 2022 21:05 I doubt it was of any interest for anyone.
...
This was the beginning of another clone but there wasn't any responses.
viewtopic.php?t=28438
My 8 year old grand daughter liked it :)
...
I can tell you the older post, though it got no reply, was quite popular. 1300+ views on the topic. I, for one, am always interested to see games being made in freeBASIC. I just don't know what to say to a game demo/code example. In the past I have seen people say things like "good job, can't wait to see the rest" only for people to get discouraged because they thought of it as finished. I have also seen people say things like "good work. very cool" only for those users to assume that was the best that could be done.

I don't always know a good way to interact with people, which is probably why I post so infrequently.

Anyway, I said all that to say, I am interested. I wish I could muster the time to make my own games/apps/anything in FB, but coding for my job has made finding the time and energy for such quite a chore.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Boulder Dash clone coding challenge

Post by BasicCoder2 »

@Imortis

If I was coding as a job I would want to be doing something else in my free time. Physical outlets are just so important for good health and mental well being. Coding is just an occasional interest for me which I see as puzzle solving. I had more fun trying to write a chess playing program than in actually playing a game of chess.

The comment about no replies was more about no one being interested in writing games in FreeBASIC anymore to exchange ideas. The last time I had exchanges on program code was the efforts to write agent based simulated worlds with isometric displays. Interesting stuff involving path and action plans by the inhabitants of those worlds. But if no one else is learning to program games I can understand the code would be of no interest at all and there would be nothing to talk about. On a Python or Javascript forum it may be different.

Yes mainly I have just written short demos as a real game would take months of hard work and many hours instead of a couple of nights work :)

When I posted my frogger demo,
viewtopic.php?t=18005
it was Roland Chastain that added to it with sound.
https://games.freebasic.net/dumpbyid.php?input=198
and later it was modified and improved in
https://games.freebasic.net/BASICGaming ... index.html
Post Reply