Board Logo
« Winter fun 2016 Minesweeper »

Welcome Guest. Please Login or Register.
Nov 22nd, 2017, 7:59pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 veryhotthread  Author  Topic: Winter fun 2016 Minesweeper  (Read 2155 times)
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3131
xx Winter fun 2016 Minesweeper
« Thread started on: Nov 1st, 2016, 04:58am »

This is a bit more of a challenge in that the entire game is relatively complex but well within Just BASIC's capabilities.

Here is a link to Minesweeper reference page. That's the game we want to see.
 
« Last Edit: Nov 1st, 2016, 04:59am by Rod » User IP Logged

tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3618
xx Re: Winter fun 2016 Minesweeper
« Reply #1 on: Nov 2nd, 2016, 03:44am »

I remember debugging it in on Spectrum. Ah those pixels. Not quite sure if I did it myself or typed in from a magazine, though.
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1301
xx Re: Winter fun 2016 Minesweeper
« Reply #2 on: Nov 2nd, 2016, 4:53pm »

I like this one.
User IP Logged

cundo aka MSlayer
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3131
xx Re: Winter fun 2016 Minesweeper
« Reply #3 on: Nov 9th, 2016, 02:40am »

Here is a quick and dirty minesweeper program. You will need to unzip these graphics to the same folder you put the .bas program in.

Code:
nomainwin
    ' find how much whitespace the windows scheme is taking
    ' Anatoly's tip
    WindowWidth = 200
    WindowHeight = 200
    open "Ajusting..." for graphics_nf_nsb as #1
    #1, "home ; down ; posxy w h"
    w=200-2*w : h = 200-2*h
    close #1


    ' setup a  420 x 440 graphics view
    ' the graphic box borders are just outside the window edge
    WindowWidth  = 420+w
    WindowHeight = 440+h
    UpperLeftX   = (DisplayWidth-WindowWidth)/2
    UpperLeftY   = (DisplayHeight-WindowHeight)/2
    graphicbox #1.g, 0,0,422,442
    open "Liberty Minesweeper" for window_nf as #1
    print #1, "trapclose [quit]"
    'visible drawing coordinates are 0 to 419 ie 420 pixels
    loadbmp "mrk","markers.bmp"
    #1.g "down ; drawbmp mrk"
    #1.g "getbmp sea 0 0 30 30"
    #1.g "getbmp nu0 30 0 30 30"
    #1.g "getbmp flg 60 0 30 30"
    #1.g "getbmp nu1 90 0 30 30"
    #1.g "getbmp nu2 120 0 30 30"
    #1.g "getbmp nu3 150 0 30 30"
    #1.g "getbmp nu4 180 0 30 30"
    #1.g "getbmp nu5 210 0 30 30"
    #1.g "getbmp nu9 240 0 30 30"
    #1.g "getbmp exp 270 0 30 30"
    loadbmp "bak","minefield.bmp"
    #1.g "drawbmp bak 0 0"
    dim grid(12,12)
    dim mine(12,12)
    'sow some random mines, watch out for same cell placement
    mines=20
    while mines>0
        c=int(rnd(0)*12+1)
        r=int(rnd(0)*12+1)
        if mine(c,r)<>9 then mine(c,r)=9 : mines=mines-1
    wend

    'now for each cell calculate how many mine neighbours
    for c=1 to 12
        for r=1 to 12
            'check surrounding cells
            'get cell range
            cmin=c-(c>1)
            cmax=c+(c<12)
            rmin=r-(r>1)
            rmax=r+(r<12)
            m=0
            for cc=cmin to cmax
                for rr=rmin to rmax
                    if cc=c and rr=r then [skip]
                    if mine(cc,rr)=9 then m=m+1
                    [skip]
                next
            next
            if mine(c,r)<>9 then mine(c,r)=m
            #1.g "drawbmp nu";mine(c,r);" ";c*30;" ";r*30
        next
    next

    'hide the board
    for c=1 to 12
        for r=1 to 12
            #1.g "drawbmp sea ";c*30;" ";r*30
            grid(c,r)=7
        next
    next

    'start event checking for mouse input
    #1.g "when leftButtonDown [leftclick]"
    #1.g "when rightButtonDown [rightclick]"
    wait


    [leftclick]
    'check the cell clicked
    c=int(MouseX/30)
    r=int(MouseY/30)
    'if we clicked on a flag do nothing
    if grid(c,r)=8 then wait
    'if we found a mine then boom!
    if mine(c,r)=9 then [boom]
    'if not a flag or a mine then draw what we found
    #1.g "drawbmp nu";mine(c,r);" ";c*30;" ";r*30
    'mark it played
    grid(c,r)=-1
    'if the cell is clear find other clear cell neighbours
    'I create a stack to remember the clear cells I find
    'not true recursion but it seeks out clear cells
    'and draws the bounding edge
    if mine(c,r)=0 then
        stackctr=1
        dim stack(144,2)
        stack(stackctr,1)=c
        stack(stackctr,2)=r
        while stackctr>0
            'check surrounding cells
            'get cell range
            cc=stack(stackctr,1)
            rr=stack(stackctr,2)
            stackctr=stackctr-1
            cmin=cc-(cc>1)
            cmax=cc+(cc<12)
            rmin=rr-(rr>1)
            rmax=rr+(rr<12)
            for cc=cmin to cmax
                for rr=rmin to rmax
                    if cc=c and rr=r then [skipit]
                    if grid(cc,rr)=-1 then [skipit]
                    if mine(cc,rr)<9 then
                        if mine(cc,rr)=0 then
                            stackctr=stackctr+1
                            stack(stackctr,1)=cc
                            stack(stackctr,2)=rr
                            #1.g "drawbmp nu0 ";cc*30;" ";rr*30
                        else
                            #1.g "drawbmp nu";mine(cc,rr);" ";cc*30;" ";rr*30
                        end if
                        'mark cell played
                        grid(cc,rr)=-1
                    end if
                    [skipit]
                next
            next
        wend
    end if

    'check for success
    'there should be no sea (7) left only flagged sea(8) and played cells (-1)
    failed=0
    for c= 1 to 12
        for r= 1 to 12
            if grid(c,r)=7 then failed=1
        next
    next
    if failed =0 then notice "Success"
    wait

    'set or unset warning flag
    [rightclick]
    c=int(MouseX/30)
    r=int(MouseY/30)
    if grid(c,r)=8 then
        #1.g "drawbmp sea ";c*30;" ";r*30
        grid(c,r)=7
    else
        if grid(c,r)=7 then
            #1.g "drawbmp flg ";c*30;" ";r*30
            grid(c,r)=8
        end if
    end if
    wait

    [boom]
    'stop event checking for mouse input
    #1.g "when leftButtonDown"
    #1.g "when rightButtonDown"
    for c=1 to 12
        for r=1 to 12
            if mine(c,r)=9 then #1.g "drawbmp exp ";c*30;" ";r*30
        next
    next
    notice "Game Over"
    wait

    [quit]
    close #1
    end
 
« Last Edit: Nov 9th, 2016, 02:41am by Rod » User IP Logged

tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3618
xx Re: Winter fun 2016 Minesweeper
« Reply #4 on: Nov 9th, 2016, 08:30am »

Haven't run it yet, but this
Code:
            'get cell range
            cmin=c-(c>1)
            cmax=c+(c<12)
            rmin=r-(r>1)
            rmax=r+(r<12) 
is some clever bit of coding I never met.
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1301
xx Re: Winter fun 2016 Minesweeper
« Reply #5 on: Nov 9th, 2016, 10:09am »

Should I post mine here or in a new thread? I think I have it under 10Kb.
User IP Logged

cundo aka MSlayer
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: Winter fun 2016 Minesweeper
« Reply #6 on: Nov 9th, 2016, 10:23am »

In my opinion, it makes sense to post all the Mine sweeper games here in one thread, unless something takes off on a tangent.

I've yet to check Rod's version out but very surprised how short it ran! wink

Append:
Oh, I see Rod has left us some work. I have swept all the cells twice and there was no awareness that the game was over plus I got an error when I closed the screen after sweeping all the cells first time (unless I flagged an extra mine? No mine counts either...).

Very good start though, finding the cells around the empties is hardest part and this wasn't done recursively?

Is the mines counter in lower right corner for number of flags placed or mines found?
« Last Edit: Nov 9th, 2016, 10:54am by bplus » User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3131
xx Re: Winter fun 2016 Minesweeper
« Reply #7 on: Nov 9th, 2016, 10:55am »

Post anything to do with minesweeper challenge here.

Quick and dirty means untested and likely bugged. I was getting it to recognise the end of game so will need to see whats happening. But concentrate on your own implementations.
« Last Edit: Nov 9th, 2016, 10:56am by Rod » User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: Winter fun 2016 Minesweeper
« Reply #8 on: Nov 9th, 2016, 1:57pm »

Test for success:

At present, you could mark the whole board with red flags and run a successful test without a single cell revealed!

Try this:
Code:
    'check for success
    'there should be no sea (7) left only flagged sea(8) and played cells (-1)

    ' test the free cell count = 144 - mines
    freeCells = 0
    for c= 1 to 12
        for r= 1 to 12
            if grid(c, r) = -1 then freeCells = freeCells + 1
        next
    next
    if freeCells = 144 - 20 then notice "Success"
 


It's short and sweet and congruent with the way Windows Minesweeper plays, in that you don't have to flag all the mines, you only have to reveal all the free cells (which is why the game was also called Free Cell).

Also I learned I had to click a blank cell sometimes to get a success noticed. (May have to still, I only tested above code once to see if it worked, it did without extra click.)

Rod, I really like your method of counting mine neighbors specially what Anatoly has already noted, very nice!
« Last Edit: Nov 9th, 2016, 2:10pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: Winter fun 2016 Minesweeper
« Reply #9 on: Nov 9th, 2016, 3:48pm »

OK test seems to be working well, so let's play again if we want and keep score of wins versus attempts:

Code:
'Rod's Minesweeper version 2016-11-09 copied from JB
'2016-11-09 Mods by bplus new test for success,
' Offer to play again after win or loss tracking wins with score and number of
' attempts with attempts. EDIT: Add Checks that r andc are in game board! and flush!

nomainwin
    ' find how much whitespace the windows scheme is taking
    ' Anatoly's tip
    WindowWidth = 200
    WindowHeight = 200
    open "Ajusting..." for graphics_nf_nsb as #1
    #1, "home ; down ; posxy w h"
    w=200-2*w : h = 200-2*h
    close #1


    ' setup a  420 x 440 graphics view
    ' the graphic box borders are just outside the window edge
    WindowWidth  = 420+w
    WindowHeight = 440+h
    UpperLeftX   = (DisplayWidth-WindowWidth)/2
    UpperLeftY   = (DisplayHeight-WindowHeight)/2
    graphicbox #1.g, 0,0,422,442
    open "Rod's Minesweeper posted at JB" for window_nf as #1
    print #1, "trapclose [quit]"
    'visible drawing coordinates are 0 to 419 ie 420 pixels
    loadbmp "mrk","markers.bmp"
    #1.g "down ; drawbmp mrk"
    #1.g "getbmp sea 0 0 30 30"
    #1.g "getbmp nu0 30 0 30 30"
    #1.g "getbmp flg 60 0 30 30"
    #1.g "getbmp nu1 90 0 30 30"
    #1.g "getbmp nu2 120 0 30 30"
    #1.g "getbmp nu3 150 0 30 30"
    #1.g "getbmp nu4 180 0 30 30"
    #1.g "getbmp nu5 210 0 30 30"
    #1.g "getbmp nu9 240 0 30 30"
    #1.g "getbmp exp 270 0 30 30"
    loadbmp "bak","minefield.bmp"
    score = 0
    attempts = 0

[playAgain]
    attempts = attempts + 1
    #1.g "drawbmp bak 0 0"
    dim grid(12,12)
    dim mine(12,12)
    'sow some random mines, watch out for same cell placement
    mines=20
    while mines>0
        c=int(rnd(0)*12+1)
        r=int(rnd(0)*12+1)
        if mine(c,r)<>9 then mine(c,r)=9 : mines=mines-1
    wend

    'now for each cell calculate how many mine neighbours
    for c=1 to 12
        for r=1 to 12
            'check surrounding cells
            'get cell range
            cmin=c-(c>1)
            cmax=c+(c<12)
            rmin=r-(r>1)
            rmax=r+(r<12)
            m=0
            for cc=cmin to cmax
                for rr=rmin to rmax
                    if cc=c and rr=r then [skip]
                    if mine(cc,rr)=9 then m=m+1
                    [skip]
                next
            next
            if mine(c,r)<>9 then mine(c,r)=m
            #1.g "drawbmp nu";mine(c,r);" ";c*30;" ";r*30
        next
    next

    'hide the board
    for c=1 to 12
        for r=1 to 12
            #1.g "drawbmp sea ";c*30;" ";r*30
            grid(c,r)=7
        next
    next
    #1.g "flush"
    'start event checking for mouse input
    #1.g "when leftButtonDown [leftclick]"
    #1.g "when rightButtonDown [rightclick]"
    wait


    [leftclick]
    'check the cell clicked
    c=int(MouseX/30)
    r=int(MouseY/30)
if c > 0 and c < 13 and r > 0 and r < 13 then
    'if we clicked on a flag do nothing
    if grid(c,r)=8 then wait
    'if we found a mine then boom!
    if mine(c,r)=9 then [boom]
    'if not a flag or a mine then draw what we found
    #1.g "drawbmp nu";mine(c,r);" ";c*30;" ";r*30
    #1.g "flush"
    'mark it played
    grid(c,r)=-1
    'if the cell is clear find other clear cell neighbours
    'I create a stack to remember the clear cells I find
    'not true recursion but it seeks out clear cells
    'and draws the bounding edge
    if mine(c,r)=0 then
        stackctr=1
        dim stack(144,2)
        stack(stackctr,1)=c
        stack(stackctr,2)=r
        while stackctr>0
            'check surrounding cells
            'get cell range
            cc=stack(stackctr,1)
            rr=stack(stackctr,2)
            stackctr=stackctr-1
            cmin=cc-(cc>1)
            cmax=cc+(cc<12)
            rmin=rr-(rr>1)
            rmax=rr+(rr<12)
            for cc=cmin to cmax
                for rr=rmin to rmax
                    if cc=c and rr=r then [skipit]
                    if grid(cc,rr)=-1 then [skipit]
                    if mine(cc,rr)<9 then
                        if mine(cc,rr)=0 then
                            stackctr=stackctr+1
                            stack(stackctr,1)=cc
                            stack(stackctr,2)=rr
                            #1.g "drawbmp nu0 ";cc*30;" ";rr*30
                        else
                            #1.g "drawbmp nu";mine(cc,rr);" ";cc*30;" ";rr*30
                        end if
                        #1.g "flush"
                        'mark cell played
                        grid(cc,rr)=-1
                    end if
                    [skipit]
                next
            next
        wend
    end if

    'check for success
    'there should be no sea (7) left only flagged sea(8) and played cells (-1)

    ' test the free cell count = 144 - mines
    freeCells = 0
    for c= 1 to 12
        for r= 1 to 12
            if grid(c, r) = -1 then freeCells = freeCells + 1
        next
    next
    if freeCells = 144 - 20 then
        score = score + 1
        confirm "Success! surely you want to play again?";again$
        if again$ = "yes" then goto [playAgain] else goto [quit]
    end if
end if
    'wait

    'set or unset warning flag
    [rightclick]
    c=int(MouseX/30)
    r=int(MouseY/30)
    if c > 0 and c < 13 and r > 0 and r < 13 then
        if grid(c,r)=8 then
            #1.g "drawbmp sea ";c*30;" ";r*30
            grid(c,r)=7
        else
            if grid(c,r)=7 then
                #1.g "drawbmp flg ";c*30;" ";r*30
                grid(c,r)=8
            end if
        end if
        #1.g "flush"
    end if
    wait

    [boom]
    'stop event checking for mouse input
    #1.g "when leftButtonDown"
    #1.g "when rightButtonDown"
    for c=1 to 12
        for r=1 to 12
            if mine(c,r)=9 then #1.g "drawbmp exp ";c*30;" ";r*30
        next
    next
    'notice "Game Over"
    confirm "Game Over, play again?";again$
    if again$ = "yes" then goto [playAgain]

    'wait

    [quit]
    notice "Today's win count is ";score;" in ";attempts;" attempts."
    close #1
    end
 


Append: just discovered some bugs when clicking outside the game frame and Anatoly's favorite pet peeve! ;-))

Expect an edit soon! OK edited 2016-11-09 5:26 PM my time
« Last Edit: Nov 9th, 2016, 4:28pm by bplus » User IP Logged

B+
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1301
xx Re: Winter fun 2016 Minesweeper
« Reply #10 on: Nov 9th, 2016, 3:57pm »

OK, here it is. It adds the mines at random, so no algorithm to place them. And you really need to discover all the mines.
Code:
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
    nOfCells = 10 : 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
    UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/2)
    menu #main,"&File","&Restart",[restart],"&Quit",[quit]
    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

    [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
    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

    wait

    [flushgfx]
        #main "segment SegID;flush"
        if SegID>3 then #main "delsegment "; SegID-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
 

Edit: small fix
« Last Edit: Nov 9th, 2016, 4:22pm by Facundo » User IP Logged

cundo aka MSlayer
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: Winter fun 2016 Minesweeper
« Reply #11 on: Nov 9th, 2016, 5:02pm »

Hi Facundo,

Nice, yours has buttons. Amazing how different this version feels to play!

Loosing the game board when I min/max the window, which I have come to call the Anatoly Test. wink
User IP Logged

B+
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1301
xx Re: Winter fun 2016 Minesweeper
« Reply #12 on: Nov 9th, 2016, 5:19pm »

Okay, Okay ha ha, the FLUSH was there actually Code:
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
    nOfCells = 10 : 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
    UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY = INT((DisplayHeight-WindowHeight)/2)
    menu #main,"&File","&Restart",[restart],"&Quit",[quit]
    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

    [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
 
User IP Logged

cundo aka MSlayer
TyCamden
Global Moderator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1431
xx Re: Winter fun 2016 Minesweeper
« Reply #13 on: Nov 10th, 2016, 7:38pm »

on Nov 9th, 2016, 5:19pm, Facundo wrote:
Okay, Okay ha ha, the FLUSH was there actually


Great program ! I love it.

Suggestions:

1.) When you right-click a square to make it a flag, and then click it again, it goes away. Can you make it so that there are three states of being: Empty, Flag, and Question Mark ?

2.) Have difficulty options, so you could play Easy, Medium, Hard, or Custom. This would affect the size of the board and the number of mines.
User IP Logged

TyCamden

Please give credit if you use code I post, no need to ask for permission.


Just BASIC 1.01, Windows 7 Home Premium version (2009), AMD Athelon II 320 Dual-Core Processor 2.10 GHz - 4.00 GB RAM (3.75 usable) - 64-bit OS
TyCamden
Global Moderator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1431
xx Re: Winter fun 2016 Minesweeper
« Reply #14 on: Nov 11th, 2016, 5:16pm »

on Nov 10th, 2016, 7:38pm, TyCamden wrote:
Great program ! I love it.

Suggestions:

1.) When you right-click a square to make it a flag, and then click it again, it goes away. Can you make it so that there are three states of being: Empty, Flag, and Question Mark ?

2.) Have difficulty options, so you could play Easy, Medium, Hard, or Custom. This would affect the size of the board and the number of mines.


I was not sure how to add suggestion 1, but I finished suggestion 2. The code was too long to post here.

For Facundo's MineSweeper program with Difficulty levels, see the code at this site:

http://jbfilesarchive.com/phpBB3/viewtopic.php?f=4&t=2124
User IP Logged

TyCamden

Please give credit if you use code I post, no need to ask for permission.


Just BASIC 1.01, Windows 7 Home Premium version (2009), AMD Athelon II 320 Dual-Core Processor 2.10 GHz - 4.00 GB RAM (3.75 usable) - 64-bit OS
Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls