The original thread is here: http://justbasic.conforums.com/index.cg ... 1477994290
Code:
Code: Select all
' Facundo's Minesweeper program
' TyCamden added Difficulty Levels
nomainwin
cr$ = chr$(13)
text1$ = "BooM !";cr$; "Restarting game."
text2$ = "Created for the minesweeper challenge.";cr$;_
"Written in Just BASIC. ";cr$;_
"Home Page: justbasic.com";cr$;_
"Forum: justbasic.conforums.com";cr$;_
"Visit home page ?"
dim mineAt(1,1), nextMine(1,1)
dim redflag(1,1), check(1,1)
global widthOfCell, heightOfCell, nOfCells
diff = 1
' difficulty 1 = default (easy), 2 = medium, 3 = hard, 4 = Expert
[setup]
widthOfCell = 30
heightOfCell = widthOfCell
' easy is a 10x10 grid, medium is 15x15, hard is 20x20
select case diff
case 1 ' easy
nOfCells = 10
nOfMines = 20 ' this is an upper limit
case 2 ' medium
nOfCells = 15
nOfMines = 30 ' this is an upper limit
case 3 ' hard
nOfCells = 20
nOfMines = 40 ' this is an upper limit
case else ' 4, or Expert
nOfCells = 20
nOfMines = 99 ' this is an upper limit
end select
' nOfMines = int(nOfCells*2-.5) ' this is an upper limit .... OLD CODE
' nOfCells = (diff*5)+5 ..................................... OLD CODE
WindowWidth = widthOfCell*( nOfCells+2 )+widthOfCell/2
' WindowHeight = heightOfCell*(nOfCells+5)+heightOfCell/2 ... OLD CODE
WindowHeight = heightOfCell*(nOfCells+3)+heightOfCell/2
UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
UpperLeftY = INT((DisplayHeight-WindowHeight)/2)
menu #main,"&File","&Restart",[restart],"&Quit",[quit]
menu #main,"&Difficulty","&Easy",[easy],"&Medium",[medium],"&Hard",[hard],"&Expert",[expert]
menu #main,"&Help","&About",[showAbout]
Open "JBMines 101" for graphics_nf_nsb as #main
#main "trapclose [quit]"
#main "down;fill palegray"
#main "color white;place ";widthOfCell -1;" ";heightOfCell -1
#main "box ";widthOfCell+widthOfCell;" ";heightOfCell+heightOfCell
#main "color darkgray;place "; widthOfCell +1 ; " "; heightOfCell +1
#main "box "; widthOfCell+widthOfCell ;" "; heightOfCell+heightOfCell +1
#main "getbmp blankbmp ";widthOfCell ;" ";heightOfCell;" ";widthOfCell ;" ";heightOfCell
#main "color white;place ";widthOfCell +1;" ";heightOfCell +1
#main "box ";widthOfCell+widthOfCell;" ";heightOfCell+heightOfCell
#main "color black;place "; widthOfCell -1 ; " "; heightOfCell -1
#main "box "; widthOfCell+widthOfCell ;" "; heightOfCell+heightOfCell
#main "getbmp buttonbmp ";widthOfCell ;" ";heightOfCell;" ";widthOfCell ;" ";heightOfCell
restore [redflag]
read width : read height
For h = 1 to height
For w = 1 to width
read c
if c=1 then #main "color red" else #main "color palegray"
#main "set ";w;" ";h
next w
next h
#main "getbmp flagbmp 1 1 "; width;" "; height
#main "cls;fill palegray"
for y = 1 to nOfCells
for x = 1 to nOfCells
#main "drawbmp buttonbmp ";x*widthOfCell;" ";y*heightOfCell
next x
next y
buttonx= int(((nOfCells+1)*widthOfCell)/2)
buttony= 0
#main "drawbmp buttonbmp "; buttonx ;" "; buttony
restore [awesome]
read width : read height
colorList$ = "green;brown;black;white;pink"
For h = 1 to height
For w = 1 to width
old.c = c
read c
if c>0 then
#main "color ";word$(colorList$,c,";")
#main "set ";w+buttonx+1;" ";h+buttony+1
end if
next w : next h
#main "getbmp facebmp "; buttonx+1; " "; buttony+1; " "; width+1; " "; height+1
#main "segment mainSegID;flush"
#main "when leftButtonDown [lbd]"
#main "when leftButtonUp [lbu]"
#main "when rightButtonDown [rbd]"
#main "when rightButtonUp [rbu]"
[restart]
howMany = 0
won = 0 ' this flags disables input actually
flagCounter = 0
redim mineAt(100,100) : redim nextMine(100,100)
redim redflag(100,100) : redim check(100,100)
for i = 1 to nOfMines
ranx = int(rnd(0)*nOfCells)+1
rany = int(rnd(0)*nOfCells)+1
if mineAt( ranx , rany ) = 0 then
howMany = howMany + 1
mineAt( ranx , rany ) =1
for nexty = rany-1 to rany+1
for nextx = ranx-1 to ranx+1
if nexty>0 and nexty<=nOfCells then
if nextx>0 and nextx<=nOfCells then
if mineAt( nextx, nexty )= 0 then
nextMine( nextx, nexty )= nextMine( nextx, nexty )+1
end if
end if
end if
next nextx
next nexty
end if
next i
#main "redraw ";mainSegID
gosub [status]
gosub [flushgfx]
wait
[easy]
diff = 1
close #main
goto [setup]
[medium]
diff = 2
close #main
goto [setup]
[hard]
diff = 3
close #main
goto [setup]
[expert]
diff = 4
close #main
goto [setup]
[lbd]
mx = MouseX
my = MouseY
restartGame=0
if mx >=buttonx and mx <=buttonx+widthOfCell then
if my >=buttony and my <=buttony+widthOfCell then
#main "drawbmp blankbmp "; buttonx ;" "; buttony
#main "drawbmp facebmp "; buttonx+2 ;" "; buttony+2
restartGame =1
wait
end if
end if
'gosub [flushgfx]
wait
[lbu]
mx = int(MouseX/widthOfCell)
my = int(MouseY/heightOfCell)
if restartGame then goto [restart]
if won then wait
if mx<1 or my <1 then wait
if mx>nOfCells or my >nOfCells then wait
#main "drawbmp blankbmp ";mx*widthOfCell;" ";my*heightOfCell
if mineAt( mx, my ) <> 0 then
#main "color black;backcolor red"
#main "place "; mx*widthOfCell +3;" ";my*heightOfCell +heightOfCell*0.7
#main "|*"
playwave "nofile.wav", synch
notice text1$
goto [restart]
wait
end if
if nextMine( mx, my ) <> 0 then
#main "color blue;place "; mx*widthOfCell +3;" ";my*heightOfCell +heightOfCell*0.7
#main "|";nextMine( mx, my )
check(mx, my)=1
wait
end if
call clearCells mx, my
gosub [flushgfx]
wait
[rbd]
if won then wait
mx = int(MouseX/widthOfCell)
my = int(MouseY/heightOfCell)
if mx<1 or my <1 then wait
if mx>nOfCells or my >nOfCells then wait
if check(mx, my)= 0 then
if redflag( mx,my)= 0 then
#main "drawbmp flagbmp ";mx*widthOfCell +widthOfCell/3 ;" ";my*heightOfCell+ heightOfCell/3
redflag( mx,my )=1
flagCounter = flagCounter + 1
else
#main "drawbmp buttonbmp ";mx*widthOfCell;" ";my*heightOfCell
redflag( mx,my )=0
flagCounter = flagCounter -1
end if
end if
gosub [status]
wait
[rbu] ' win check
if won then wait
nope = 0
if flagCounter = howMany then
for y = 1 to nOfCells
for x = 1 to nOfCells
if mineAt( x, y )<>0 then
if redflag( x ,y ) <> mineAt( x, y ) then
nope = 1 : exit for
end if
end if
next x
if nope then exit for
next y
playwave "nosounhere.wav",synch
if nope then
notice "Wrong!!"
else
notice "Well done." : won = 1
end if
end if
gosub [flushgfx]
wait
[flushgfx]
#main "segment newSeg;flush"
if newSeg>4 then #main "delsegment ";newSeg - 1
' #main "font Courier_new ";widthOfCell-5;" ";heightOfCell-5;" BOLD"
#main "backcolor palegray"
return
[showAbout]
title$ = "JBMines "; chr$(169) ;" 2016 by Facundo"; cr$
playwave "nofile.wav",asynch
confirm text2$; answer$
if answer$ = "yes" then run "rundll32.exe url.dll,FileProtocolHandler http:\\www.justbasic.com"
wait
[status]
#main "Place "; widthOfCell+1;" "; heightOfCell*0.7-1
#main "font Courier_new 16 16 bold"
#main "color 0 55 55; backcolor palegray"
#main "|"; using("##",flagCounter) ;"/"; using("##",howMany)
#main "font Courier_new ";widthOfCell-5;" ";heightOfCell-5;" BOLD"
#main "backcolor palegray"
return
[quit]
unloadbmp "facebmp"
unloadbmp "blankbmp"
unloadbmp "buttonbmp"
unloadbmp "flagbmp"
close #main : end
[awesome]
DATA 25,25
DATA 0,0,0,0,0,0,0,0,1,2,3,3,3,3,3,2,1
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,3,2,1,1,1,1,1,2,3
DATA 3,2,0,0,0,0,0,0,0,0,0,0,0,3,3,1,1,1,1,1,1,1,1,1,1
DATA 1,3,3,0,0,0,0,0,0,0,0,0,3,2,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,2,3,0,0,0,0,0,0,0,3,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,3,0,0,0,0,0,3,2,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,2,3,0,0,0,2,3,2,2,2,3,2,1,1,1,1,1,1,2,2,2
DATA 3,2,1,1,1,3,2,0,0,3,1,2,4,4,3,3,1,1,1,1,1,2,4,4,4
DATA 3,3,2,1,1,1,3,0,1,3,2,4,4,4,3,3,2,1,1,1,1,2,4,4,4
DATA 3,3,3,1,1,1,3,0,2,2,2,4,4,4,4,4,3,1,1,1,1,1,4,4,4
DATA 4,4,2,1,1,1,2,2,3,1,2,4,4,4,4,4,3,1,1,1,1,2,4,4,4
DATA 4,4,2,1,1,1,1,3,3,1,1,2,2,2,2,2,2,1,1,1,1,2,2,2,2
DATA 2,2,2,1,1,1,1,3,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,3,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,3,3,1,1,2,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,2,1,1,1,1,3,2,2,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,1,1,1,2,2,1,3,1,1,2,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,1,1,1,3,0,0,3,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3
DATA 3,3,3,1,1,1,3,0,0,2,3,1,1,2,3,3,3,3,3,3,2,5,5,2,3
DATA 3,3,2,1,1,3,2,0,0,0,3,2,1,1,3,3,3,3,3,5,5,5,5,5,5
DATA 3,3,1,1,2,3,0,0,0,0,0,3,1,1,1,3,3,3,5,5,5,5,5,5,2
DATA 3,1,1,2,3,0,0,0,0,0,0,0,3,2,1,1,3,3,5,5,5,5,2,3,2
DATA 1,1,2,3,0,0,0,0,0,0,0,0,0,3,3,1,1,1,2,2,2,2,5,1,1
DATA 1,3,3,0,0,0,0,0,0,0,0,0,0,0,2,3,3,2,1,1,1,1,1,2,3
DATA 3,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,3,3,3,3,2,0
DATA 0,0,0,0,0,0,0,0
[redflag]
DATA 9,8
DATA 1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1,1
DATA 0,0,0,0,0,0,0,1,1
DATA 0,0,0,0,0,0,0,1,1
DATA 0,0,0,0,0,0,0,1,1
sub clearCells x1, y1
if mineAt( x1, y1 ) <> 0 then exit sub
for ry = y1-1 to y1+1
for rx = x1-1 To x1+1
if rx>0 and rx<=nOfCells then
if ry>0 and ry<=nOfCells then
if mineAt( rx, ry ) = 0 and check( rx, ry) = 0 then
if redflag( rx, ry ) = 0 then
check( rx, ry) = 1
#main "drawbmp blankbmp "; rx*widthOfCell; " "; ry*heightOfCell
if nextMine( rx, ry ) <> 0 then
#main "color blue"
#main "place "; rx*widthOfCell +3;" ";ry*heightOfCell +heightOfCell*0.7
#main "|";nextMine( rx, ry )
end if
if nextMine( rx, ry ) = 0 then call clearCells rx, ry
end if
end if
end if
end if
next:next
End sub
