MineSweeper by Facundo with my tweaks

Just BASIC Games
TyCamden
Posts: 42
Joined: Tue Apr 28, 2009 6:20 am

MineSweeper by Facundo with my tweaks

Post by TyCamden » Fri Nov 11, 2016 11:10 pm

Here is a MineSweeper program by Facundo, but I added difficulty levels.

The original thread is here: http://justbasic.conforums.com/index.cg ... 1477994290

Code:

Code: Select all

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

    [setup]
    nOfCells = (diff*5)+5
        ' easy is a 10x10 grid, medium is 15x15, hard is 20x20

    widthOfCell = 30
    heightOfCell = widthOfCell
    nOfMines = int(nOfCells*2-.5) ' this is an upper limit
    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]
    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]

    [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