SuperSweeper - work in progress

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

SuperSweeper - work in progress

Post by TyCamden » Tue Nov 22, 2016 2:17 am

Code: Select all

' MEGASWEEPER
' code based on Minesweeper program by
'   Facundo
'
'   TyCamden changes include:
'       Larger board
'       More mines
'       Added scroll bars
'
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

    [setup]
    widthOfCell = 30
    heightOfCell = widthOfCell
'    nOfCells = 20 .... OLD CODE
'    nOfMines = 99 ' this is an upper limit .... OLD CODE
    nOfCells = 50
    nOfMines = 520 ' this is an upper limit
'    nOfMines = int(nOfCells*2-.5) ' this is an upper limit .... OLD CODE
'    nOfCells = (diff*5)+5 ..................................... OLD CODE
'       difficulty used to be 1-4 where it was Easy, Medium, Hard, Expert
    nomainwin
'    WindowWidth     = 250 +20
'    WindowHeight    = 250 +40
    WindowWidth     = 700 +20
    WindowHeight    = 700 +40
'    WindowWidth = widthOfCell*( nOfCells+2 )+widthOfCell/2 ... OLD CODE
'    WindowHeight = heightOfCell*(nOfCells+5)+heightOfCell/2 ... OLD OLD CODE
    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 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

cundo
Posts: 19
Joined: Wed Mar 12, 2008 11:12 pm

Re: SuperSweeper - work in progress

Post by cundo » Thu Nov 24, 2016 8:04 pm

Code: Select all

' MEGASWEEPER
' code based on Minesweeper program by
'   Facundo
'   ---Trying to get a larger playing area---
'
'   TyCamden changes include:
'       Larger board
'       More mines
'       Added scroll bars
'

    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

    [setup]
    widthOfCell = 29
    heightOfCell = widthOfCell
'    nOfCells = 20 .... OLD CODE
'    nOfMines = 99 ' this is an upper limit .... OLD CODE
    nOfCells = 32
    nOfMines = 50 ' this is an upper limit
'    nOfMines = int(nOfCells*2-.5) ' this is an upper limit .... OLD CODE
'    nOfCells = (diff*5)+5 ..................................... OLD CODE
'       difficulty used to be 1-4 where it was Easy, Medium, Hard, Expert

'    WindowWidth     = 250 +20
'    WindowHeight    = 250 +40
    WindowWidth     = 700 +20
    WindowHeight    = 700 +40
'    WindowWidth = widthOfCell*( nOfCells+2 )+widthOfCell/2 ... OLD CODE
'    WindowHeight = heightOfCell*(nOfCells+5)+heightOfCell/2 ... OLD OLD CODE
    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 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 "segment currentID"
    print "currentID",currentID ' need to improve this
    if currentID>mainSegID then
        from = mainSegID + 1
        here =  currentID-1
        for i = from to here
          #main "delsegment ";i
        next i
    end if
    #main "redraw "

    gosub [status]
    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]
        gosub [status]

    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 "|*"

           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
        gosub [flushgfx]
        gosub [status]
            wait
        end if
         call clearCells  mx, my
        gosub [flushgfx]
        gosub [status]

    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 [flushgfx]
    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
     if nope then
        notice "Wrong!!"
        else
      notice "Well done." : won = 1
     end if

    end if
    gosub [flushgfx]
    gosub [status]

    wait

    [flushgfx]

        #main "flush"
       ' #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

Who is online

Users browsing this forum: CommonCrawl [Bot], MSNbot Media and 0 guests