Diamond Miner Demo

Game development specific discussions.
BasicCoder2
Posts: 3525
Joined: Jan 01, 2009 7:03

Diamond Miner Demo

Postby BasicCoder2 » Apr 06, 2020 10:51

Hold the space bar down to work the drill and the arrow keys to move the miner.

Code: Select all

chdir exepath()
#include once "FBImage.bi"

const TMAPW = 20   'size of tile array
const TMAPH = 15

const TILEW = 64   'size of tile
const TILEH = 64

const WINW = 640   'size of window over BMAP
const WINH = 480

const BMAPW = 1280  'size of bitmap of tile array
const BMAPH = 960

'==============================================================================

dim shared as integer pauseTimer    'time since last key press
dim shared as integer diamondCount  'count diamonds collected
dim shared as integer ladderCount   'resources used to build ladders
dim shared as integer drillingCount 'usage of drill
dim shared as integer timeTaken     'time game takes to run

'===============================================================================
'STATES
const WALK_RIGHT     = 0
const WALK_LEFT      = 1
const CLIMB_UP       = 2
const CLIMB_DOWN     = 3
const FALLING        = 4
const DRILL_RIGHT    = 5
const DRILL_LEFT     = 6
const DRILL_DOWN     = 7
const DRILL_UP       = 8
const LOOKING_LEFT   = 9
const LOOKING_RIGHT  = 10
const LOOKING_UP     = 11
const LOOKING_DOWN   = 12
const WAVING         = 13

'====================================================================

'TILE NUMBERS
const LADDER  = 1
const DIAMOND = 2

'====================================================================

dim shared as integer WINX,WINY   'position of window over tiles display

dim shared as integer TILEX,TILEY 'current tile occupied

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls   'white paper, pen black

'=====================================================================
'  create bitmaps
'=====================================================================

dim shared as any ptr background
background = imagecreate(BMAPW,BMAPH)
line background,(0,0)-(BMAPW-1,64*3),rgb(100,100,255),bf 'blue sky
line background,(0,64*3)-(BMAPW-1,BMAPH-1),rgb(189,136,83),bf 'ground

for i as integer = 0 to 4000
    if int(rnd(1)*2)=0 then
        circle background,( int(rnd(1)*1280), int(rnd(1)*(960-64*3-6))+64*3+6) ,int(rnd(1)*5)+1,rgb(142,99,68),,,,f
    else
        circle background,( int(rnd(1)*1280), int(rnd(1)*(960-64*3-6))+64*3+6) ,int(rnd(1)*5)+1,rgb(187,121,63),,,,f
    end if
next i


dim shared as any ptr Sheet
Sheet = imagecreate(256,576)
'bload "miner-Sheet64.bmp",Sheet
Sheet = LoadRGBAFile("miner-Sheet64.png")

dim shared as any ptr fgTileSheet
fgTileSheet = imagecreate(1024,64)
'bload "fgTileSheet2.bmp",fgTileSheet
fgTileSheet = LoadRGBAFile("fg-tile-sheet64.png")

dim shared as any ptr bgTileSheet
bgTileSheet = imagecreate(512,64)
'bload "dirtTilesBB.bmp",bgTileSheet
bgTileSheet = LoadRGBAFile("dirt-tiles64.png")

dim shared as any ptr diamondDrillerText
diamondDrillerText = imagecreate(504,64)
'bload ".bmp",diamondDrillerText
diamondDrillerText = LoadRGBAFile("diamond-driller-text64.png")

dim shared as any ptr DISPLAY
DISPLAY = imagecreate(1280,960)  'draw display

'==============================================================================

type SPRITE
    as integer x         'current position of image
    as integer y
    as integer dx
    as integer dy
    as integer w
    as integer h
    as integer d         'last direction up/down/left/right
    as integer hx        'hit and positioning box within image
    as integer hy
    as integer hw
    as integer hh
    as integer xd        'velocity in pixel change
    as integer yd
    as integer ID
    as integer state     'current state agent is in
    as integer a         'this sprite is being used if a = 1
    as integer item      'item held by agent
end type

dim shared as SPRITE miner   'create an sprite


miner.x =  64*0  'starting position tile(0,2) HOME BASE
miner.y =  64*2
miner.dx = 0
miner.dy = 0
miner.w  = 64
miner.h  = 64
miner.state  = LOOKING_UP  'looking forward

'=============================================================================

'this holds the variables for a strip of animation frames on a sprite sheet
type STRIPS
    as integer x,y,w,h 'top/left x,y of first frame in sheet and width and height of all frames
    as integer f       'current frame
    as integer tf      'total frames in animation strip
    as integer r       'life of each frame per game cycle
end type

'this will display an animation using a strip
sub drawStrip(s as STRIPS)
    put DISPLAY,(miner.x,miner.y),Sheet,( s.f * s.w + s.x, s.y)-(s.f * s.w + s.x +s.w-1, s.y + s.h -1),trans
    s.f = s.f + 1
    if s.f >= s.tf then s.f = 0
end sub

dim shared as STRIPS strip(0 to 14)  'animation for each state
dim shared as string sLabel(0 to 14) 'label of strip

'strip(state)
sLabel(0) =  "WALK_RIGHT"
sLabel(1) =  "WALK_LEFT"
sLabel(2) =  "CLIMB_UP"
sLabel(3) =  "CLIMB_DOWN"
sLabel(4) =  "FALLING"
sLabel(5) =  "DRILL_RIGHT"
sLabel(6) =  "DRILL_LEFT"
sLabel(7) =  "DRILL_DOWN"
sLabel(8) =  "DRILL_UP"
sLabel(9) =  "LOOKING_LEFT"
sLabel(10) = "LOOKING_RIGHT"
sLabel(11) = "LOOKING_UP"
sLabel(12) = "LOOKING_DOWN"
sLabel(13) = "WAVING"


'set animation strips for each state

strip(0).tf = 4   'WALK_RIGHT
strip(0).f  = 0
strip(0).x  = 0
strip(0).y  = 0
strip(0).w  = 64
strip(0).h  = 64

strip(1).tf = 4   'WALK_LEFT
strip(1).f  = 0
strip(1).x  = 0
strip(1).y  = 64
strip(1).w  = 64
strip(1).h  = 64

strip(2).tf = 4   'CLIMB_UP
strip(2).f  = 0
strip(2).x  = 0
strip(2).y  = 64*2
strip(2).w  = 64
strip(2).h  = 64

strip(3).tf = 4   'CLIMB_DOWN
strip(3).f  = 0
strip(3).x  = 0
strip(3).y  = 64*2
strip(3).w  = 64
strip(3).h  = 64

strip(4).tf = 4   'FALLING
strip(4).f  = 0
strip(4).x  = 0
strip(4).y  = 64*3
strip(4).w  = 64
strip(4).h  = 64

strip(5).tf = 4   'DRILL_RIGHT
strip(5).f  = 0
strip(5).x  = 0
strip(5).y  = 64*5
strip(5).w  = 64
strip(5).h  = 64


strip(6).tf = 4   'DRILL_LEFT
strip(6).f  = 0
strip(6).x  = 0
strip(6).y  = 64*6
strip(6).w  = 64
strip(6).h  = 64


strip(7).tf = 4   'DRILL_DOWN
strip(7).f  = 0
strip(7).x  = 0
strip(7).y  = 64*7
strip(7).w  = 64
strip(7).h  = 64


strip(8).tf = 4   'DRILL_UP
strip(8).f  = 0
strip(8).x  = 0
strip(8).y  = 64*8
strip(8).w  = 64
strip(8).h  = 64

strip(9).tf = 1   'LOOKING_LEFT
strip(9).f  = 0
strip(9).x  = 0
strip(9).y  = 64*1
strip(9).w  = 64
strip(9).h  = 64

strip(10).tf = 1   'LOOKING_RIGHT
strip(10).f  = 0
strip(10).x  = 64*3
strip(10).y  = 0
strip(10).w  = 64
strip(10).h  = 64

strip(11).tf = 1   'LOOKING_UP
strip(11).f  = 0
strip(11).x  = 0
strip(11).y  = 64*4
strip(11).w  = 64
strip(11).h  = 64

strip(12).tf = 1   'LOOKING DOWN
strip(12).f  = 0
strip(12).x  = 0
strip(12).y  = 64*4
strip(12).w  = 64
strip(12).h  = 64

strip(13).tf = 4   'WAVING
strip(13).f  = 0
strip(13).x  = 0
strip(13).y  = 64*4
strip(13).w  = 64
strip(13).h  = 64

dim shared as integer TMAP(0 to TMAPW,0 to TMAPH)  'tile map array
dim shared as integer GMAP(0 to TMAPW,0 to TMAPH)  'tile map array

sub readTileData()
    restore TILE_DATA
    for j as integer = 0 to TMAPH-1
        for i as integer = 0 to TMAPW-1
            read TMAP(i,j)
        next i
    next j
end sub

sub fillWithDiamonds()
    dim as integer x,y,i

    while i < 16  ' diamonds
        x = int(Rnd(1)*TMAPW)
        y = int(Rnd(1)*TMAPH)
        if y > 3 then
            if GMAP(x,y)=0 then
                GMAP(x,y) = DIAMOND      'insert diamond
                i = i + 1
            end if
        end if
    wend
end sub


'returns true if character on center of tile
function onTile() as boolean
    if miner.x = int(miner.x\TILEW)*TILEW and miner.y = int(miner.y\TILEH)*TILEH then
        return true
    else
        return false
    end if
end function

sub updateDisplay()
    dim as integer TILEX,TILEY
   
    line DISPLAY,(0,0)-(BMAPW-1,BMAPH-1),rgb(255,0,255),bf  'clear bitmap
    put DISPLAY,(0,0),background,trans
   
    for j as integer = 0 to TMAPH-1
        for i as integer = 0 to TMAPW-1
            'background

            put DISPLAY,(i*64,j*64),bgTileSheet,(TMAP(i,j)*64,0)-(TMAP(i,j)*64+63,63),trans

            put DISPLAY,(i*64,j*64),fgTileSheet,(GMAP(i,j)*64,0)-(GMAP(i,j)*64+63,63),trans

           
        next i
    next j
    drawStrip(strip(miner.state)) 'show animation for this state
    put DISPLAY,(0,0),diamondDrillerText,trans
   
    TILEX = int(miner.x\TILEW)  'get tile coordinates of current tile
    TILEY = int(miner.y\TILEH)
    line DISPLAY,(0,128)-(63,128+63),rgb(255,0,0),b  'home base
    draw string DISPLAY, (4,120)," HOME BASE",rgb(0,0,0)
    'line DISPLAY,(TILEX*64,TILEY*64)-(TILEX*64+63,TILEY*64+63),rgb(255,255,0),b
end sub



sub update()
    updateDisplay()  'draw background, tiles and miner
    screenlock
    cls
    put (0,0),DISPLAY,(WINX,WINY)-(WINX+WINW-1,WINY+WINH-1),trans    'show window over world
    locate 2,1
    print " diamondCount: ";diamondCount  'count diamonds collected
    print " ladderCount:  ";ladderCount   'resources used to build ladders
    print " drillingCount:";drillingCount 'usage of drill
    if timeTaken<>0 then
        print "TIME TAKEN =";timeTaken
    end if
    screenunlock
end sub

dim as double time2

readTileData()

'WAIT FOR PLAYER TO START GAME
do
    update()
    time2 = int(rnd(1)*10)  'so each game has random diamond distribution
    screenlock
    locate 10,20
    print "HIT ANY KEY TO START"
    screenunlock
loop while inkey=""

fillWithDiamonds()

dim as double time1
time1 = timer        'game loop timer
time2 = timer        'time taken to finish game

do

   
    if (timer-time1)>0.05 then
        time1 = timer  'reset time1

        update()

        if onTile() then
           
            miner.dx = 0
            miner.dy = 0
            if miner.d = 0 then miner.state = LOOKING_RIGHT
            if miner.d = 1 then miner.state = LOOKING_LEFT
            if miner.d = 2 then miner.state = LOOKING_DOWN
            if miner.d = 3 then miner.state = LOOKING_UP
           
            pauseTimer = pauseTimer + 1
            if pauseTimer > 60 then
                pauseTimer = 0
            end if
           
           
            TILEX = int(miner.x\TILEW)  'get tile coordinates of current tile
            TILEY = int(miner.y\TILEH)
           
            'any diamond?
            if GMAP(TILEX,TILEY)= DIAMOND then
                GMAP(TILEX,TILEY) = 0
                diamondCount = diamondCount + 1
            end if
           
            'elapse time after key event start waving at 50 cycles stop at 60 cycles
            if pauseTimer > 50 and pauseTimer < 60 then
                miner.d = 2
                miner.state = WAVING
            end if
       
           
            if multikey(&H4D) then  'move right
                miner.d = 0  'looking right
                if TMAP(TILEX+1,TILEY)=0 and TILEX <> TMAPW-1 then
                    miner.state = WALK_RIGHT
                    miner.dx = 8
                    miner.dy = 0
                end if
                pauseTimer = 0  'start counting since last key press
            end if
           
            if multikey(&H4B) then 'move left
                miner.d = 1  'looking left
                if TMAP(TILEX-1,TILEY)=0 then
                    miner.state = WALK_LEFT
                    miner.dx = -8
                    miner.dy = 0
                end if
                pauseTimer = 0  'start counting since last key press
            end if
           
            if multikey(&H48) then
                miner.d = 2   'looking up
                if TMAP(TILEX,TILEY-1)=0 and TILEY > 2 then  'clear to move and not on surface
                    GMAP(TILEX,TILEY) = LADDER 'make a ladder
                    ladderCount = ladderCount + 1
                    miner.state = CLIMB_UP
                    miner.dx = 0
                    miner.dy = -8
                end if
                pauseTimer = 0  'start counting since last key press
            end if
           
            if multikey(&H50) then
                miner.d = 3  'looking down
                if GMAP(TILEX,TILEY+1) = LADDER then
                    miner.state = CLIMB_DOWN
                    miner.dx = 0
                    miner.dy = 8
                end if
                pauseTimer = 0  'start counting since last key press
            end if
           
               
            if multikey(&H39) then  'space bar to drill soil
               
                if miner.d = 0 and TMAP(TILEX+1,TILEY) > 0 then
                    miner.state = DRILL_RIGHT  'start drilling
                    TMAP(TILEX+1,TILEY) = TMAP(TILEX+1,TILEY)-1
                    drillingCount = drillingCount + 1
                end if
               
                if miner.d = 1 and TMAP(TILEX-1,TILEY) > 0 then
                    miner.state = DRILL_LEFT
                    TMAP(TILEX-1,TILEY) = TMAP(TILEX-1,TILEY)-1
                    drillingCount = drillingCount + 1
                end if
               
                if miner.d = 2 and TMAP(TILEX,TILEY-1) > 0 then
                    miner.state = DRILL_UP
                    TMAP(TILEX,TILEY-1) = TMAP(TILEX,TILEY-1)-1
                    drillingCount = drillingCount + 1
                end if
               
                if miner.d = 3 and TMAP(TILEX,TILEY+1) > 0 then
                    miner.state = DRILL_DOWN
                    TMAP(TILEX,TILEY+1) = TMAP(TILEX,TILEY+1)-1
                    drillingCount = drillingCount + 1
                end if
               
                pauseTimer = 0
               
            end if
           
            'if multikey(&H30) then  'b  build ladder (this is automatic when climbing)
            '    GMAP(TILEX,TILEY)= LADDER
            'end if
           
            'gravity
            if TILEY<>TMAPH-1 then 'not on bottom
                if TMAP(TILEX,TILEY+1)=0 and GMAP(TILEX,TILEY+1)<> LADDER then  'then clear to fall
                    miner.d = 3
                    miner.state = FALLING
                    miner.dx = 0
                    miner.dy = 8
                    pauseTimer = 0
                end if
            end if
           
        end if 'on tile
       
        'move miner
        miner.x = miner.x + miner.dx
        miner.y = miner.y + miner.dy

        'check for out of boundary
        if miner.x < 0 then
            miner.x = 0
        end if
   
        if miner.x > TMAPW*TILEW-TILEW then
            miner.x = TMAPW*TILEW-TILEW
        end if
   
        if miner.y < 0 then
            miner.y = 0
        end if
   
        if miner.y > TMAPH*TILEH-TILEH then
            miner.y = TMAPH*TILEH-TILEH
        end if
   
        'compute window position over BitMap Display
        WINX = miner.x - WINW\2
        if WINX < 0 then WINX = 0
        if WINX + WINW-1 >= BMAPW then WINX = BMAPW-WINW-1
        WINY = miner.y - WINH\2
        if WINY < 0 then WINY = 0
        if WINY + WINH >= BMAPH-1 then WINY = BMAPH-WINH-1
       
    end if
   
    if diamondCount = 16 and timeTaken = 0 then  'stop game timer
        timeTaken = timer - time2
    end if
   
    Sleep 2
   
loop until multikey(&H01)


TILE_DATA:
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 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
data 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7


Image
Image
Image
Image

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests