PureBasic Forums - English

Posted: **Sun Oct 28, 2018 12:11 pm**

I have written a Minesweeper Module

Have fun

Code:

EnableExplicit

;PureBasic v.5.62 x64
;-------------------------
;Minesweeper (ALL OS)
;Version: alpha 18
;© 2018 by Mijikai
;-------------------------

DeclareModule MINESWEEPER
  Declare.i Create(X.i,Y.i,Width.i,Height.i,MinesX.b,MinesY.b,Mines.b)
  Declare.i Set(*mine,MinesX.b,MinesY.b,Mines.b)
  Declare.i Id(*mine)
  Declare.i Handle(*mine)
  Declare.i Active(*mine)
  Declare.i Fields(*mine)
  Declare.i Mines(*mine)
  Declare.i Error(*mine)
  Declare.i Reset(*mine)
  Declare.i Free(*mine)
EndDeclareModule

Module MINESWEEPER
  
  EnableExplicit

  Macro SetBit(Target,Bit)
    Target | (1 << Bit)
  EndMacro
  
  Macro GetBit(Target,Bit)
    (Target >> Bit) & 1
  EndMacro
  
  Macro ResetBit(Target,Bit)
    Target & ~(1 << Bit)
  EndMacro
  
  Macro SetBits(Target,Offset,Bits)
    Target & ~(%1111 << Offset) | (Bits << Offset)
  EndMacro
  
  Macro GetBits(Target,Offset)
    ((Target >> Offset) & %1111)
  EndMacro
  
  Structure GADGET_STRUCT
    Id.i
    Handle.i
    Width.i
    Height.i
  EndStructure
  
  Structure MINESWEEPER_STRUCT
    Gadget.GADGET_STRUCT
    Width.d
    Height.d
    CenterX.d
    CenterY.d
    FactorX.d
    FactorY.d
    OffsetX.d
    OffsetY.d
    InfoX.d
    InfoY.d
    HighlightX.d
    HighlightY.d
    MinesX.b
    MinesY.b
    Mines.i
    Fields.i
    Field.b[10000]
    Array Occupied.b(101,101)
    Font.i
    FontHandle.i
    FontX.d
    FontY.d
    Active.i
    Win.i
    Clock.q
    Timer.i
    Error.i
  EndStructure
  
  #RGBA_BACKGROUND  = $FF222222
  #RGBA_NEIGHBORS   = $FFF0FDFF
  #RGBA_TEXT        = $CCFFFFFF
  #RGBA_FIELD       = $FF784D28
  #RGBA_HIGHLIGHT   = $FFDB7B1B
  #RGBA_FLAG        = $FF1EF0A8
  #RGBA_INFO        = $DD333333
  #RGBA_YOUWIN      = $EF19A6FF
  #RGBA_GAMEOVER    = $EF1900FF
  
  Procedure.i mineField(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
    With *mine
      ProcedureReturn @\Field[0] + (Y * \MinesY) + X
    EndWith
  EndProcedure
  
  Procedure.i mineInitMines(*mine.MINESWEEPER_STRUCT)
    Protected Index.i
    Protected MinesX.b
    Protected MinesY.b
    Protected *Field.byte
    With *mine
      For Index = 0 To \Mines - 1
        Repeat
          MinesX = Random(\MinesX - 1)
          MinesY = Random(\MinesY - 1)
          If Not \Occupied(MinesX + 1,MinesY + 1)
            *Field = mineField(*mine,MinesX,MinesY)
            SetBit(*Field\b,0)
            \Occupied(MinesX + 1,MinesY + 1) = 1
          EndIf 
        Until *Field
        *Field = #Null
      Next
    EndWith
  EndProcedure
  
  Procedure.i mineNeighbors(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
    Protected Result.i
    Protected *Field.Byte
    With *mine
      *Field = mineField(*mine,X,Y)
      If Not \Occupied(X + 1,Y + 1)
        Result + \Occupied(X + 2,Y + 1)
        Result + \Occupied(X,Y + 1)
        Result + \Occupied(X + 1,Y + 2)
        Result + \Occupied(X + 1,Y)
        Result + \Occupied(X,Y + 2)
        Result + \Occupied(X + 2,Y)
        Result + \Occupied(X,Y)
        Result + \Occupied(X + 2,Y + 2)
        SetBits(*Field\b,3,Result)
      EndIf
      ProcedureReturn *Field
    EndWith
  EndProcedure
  
  Procedure.i mineInitFields(*mine.MINESWEEPER_STRUCT)
    Protected MineX.b
    Protected MineY.b
    Protected *Field.Byte
    With *mine
      For MineY = 0 To \MinesY - 1
        For MineX = 0 To \MinesX - 1
          *Field = mineNeighbors(*mine,MineX,MineY)
        Next
      Next
      For MineY = 0 To \MinesY - 1
        For MineX = 0 To \MinesX - 1
          *Field = mineField(*mine,MineX,MineY)
          If GetBits(*Field\b,3)
            \Occupied(MineX + 1,MineY + 1) = 2
          Else
            If Not GetBit(*Field\b,0)
              \Occupied(MineX + 1,MineY + 1) = 3
            EndIf
          EndIf
        Next
      Next
    EndWith
  EndProcedure
  
  Procedure.i mineInit(*mine.MINESWEEPER_STRUCT,MinesX.b,MinesY.b,Mines.b)
    With *mine
      \MinesX = MinesX
      \MinesY = MinesY
      \Mines = Mines
      \Fields = \MinesX * \MinesY
      \Width = \Gadget\Width / \MinesX
      \Height = \Gadget\Height / \MinesY
      \CenterX = \Width / 2
      \CenterY = \Height / 2
      \FactorX = \Width / 3
      \FactorY = \Height / 3
      \FontX = \Width / 4
      \FontY = \Height / 12
      \HighlightX = \Width - (\Width / 4)
      \HighlightY = \Height - (\Height / 4)
      \OffsetX =  \Width / 8
      \OffsetY =  \Height / 8
      \InfoX = \Gadget\Width / 100
      \InfoY = \Gadget\Height / 100
      If (\MinesX > 1 And \MinesX < 101) And 
         (\MinesY > 1 And \MinesY < 101) And 
         (\Fields > \Mines And \Mines > 0) And
         (\Gadget\Width > 99) And (\Gadget\Height > 99)
        \Font = LoadFont(#PB_Any,"Consolas",10)
        If \Font
          \FontHandle = FontID(\Font)
          mineInitMines(*mine)
          mineInitFields(*mine)
          ProcedureReturn #True
        EndIf
      EndIf
    EndWith
  EndProcedure
  
  Procedure.i mineRender(*mine.MINESWEEPER_STRUCT)
    Protected MinesX.b
    Protected MinesY.b
    Protected *Field.Byte
    Protected Neighbors
    With *mine
      If StartVectorDrawing(CanvasVectorOutput(\Gadget\Id))
        VectorSourceColor(#RGBA_BACKGROUND)
        AddPathBox(0,0,\Gadget\Width,\Gadget\Height)
        FillPath()
        For MinesY = 0 To \MinesY - 1
          For MinesX = 0 To \MinesX - 1
            *Field = mineField(*mine,MinesX,MinesY)
            If GetBit(*Field\b,1)
              If GetBit(*Field\b,0)
                VectorSourceColor($B0784DFF)
                AddPathEllipse((MinesX * \Width) + \CenterX ,(MinesY * \Height) + \CenterY ,\FactorX,\FactorY)
                FillPath()
              Else
                Neighbors = GetBits(*Field\b,3)
                If Neighbors
                  VectorSourceColor(#RGBA_NEIGHBORS >> Neighbors * 10)
                  MovePathCursor((MinesX * \Width) + \FontX,(MinesY * \Height) - \FontY)
                  VectorFont(\FontHandle,\Height)
                  DrawVectorText(Str(Neighbors))
                EndIf
              EndIf
            Else
              VectorSourceColor(#RGBA_FIELD)
              AddPathBox(MinesX * \Width,MinesY * \Height,\Width,\Height)
              FillPath()
              If GetBit(*Field\b,2)
                VectorSourceColor(#RGBA_FLAG)
                AddPathBox((MinesX * \Width) + \OffsetX,(MinesY * \Height) + \OffsetY,\HighlightX,\HighlightY)
                StrokePath(2,#PB_Path_RoundCorner)
              Else
                VectorSourceColor(#RGBA_HIGHLIGHT)
                AddPathBox((MinesX * \Width) + \OffsetX,(MinesY * \Height) + \OffsetY,\HighlightX,\HighlightY)
                StrokePath(1,#PB_Path_RoundCorner)
              EndIf
            EndIf 
          Next
        Next 
        If \Active = #False
          VectorSourceColor(#RGBA_INFO)
          AddPathBox(0,0,\Gadget\Width ,\Gadget\Height)
          FillPath()
          VectorSourceColor(#RGBA_TEXT)
          VectorFont(\FontHandle,\InfoY * 8)
          MovePathCursor(\InfoX * 4,\InfoY * 4)
          DrawVectorText("Time:   " + Str(\Clock) + " sec")
          MovePathCursor(\InfoX * 4,\InfoY * 14)
          DrawVectorText("Area:   " + Str(\MinesX) + " x " + Str(\MinesY))
          MovePathCursor(\InfoX * 4,\InfoY * 24)
          DrawVectorText("Fields: " + Str(\Fields))
          MovePathCursor(\InfoX * 4,\InfoY * 34)
          DrawVectorText("Mines:  " + Str(\Mines))
          VectorFont(\FontHandle,\InfoY * 10)
          If \Win
            MovePathCursor(\InfoX * 30,\InfoY * 50)
            VectorSourceColor(#RGBA_YOUWIN)
            DrawVectorText("YOU WIN")
          Else
            MovePathCursor(\InfoX * 26,\InfoY * 50)
            VectorSourceColor(#RGBA_GAMEOVER)
            DrawVectorText("GAME OVER")
          EndIf
          VectorSourceColor(#RGBA_TEXT)
          VectorFont(\FontHandle,\InfoY * 12)
          MovePathCursor(\InfoX * 14,\InfoY * 70)
          DrawVectorText("> P L A Y <")
        EndIf 
        StopVectorDrawing()
        ResizeGadget(\Gadget\Id,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
      Else
        \Error = 1
      EndIf 
    EndWith
  EndProcedure
  
  Procedure.i mineCount(*mine.MINESWEEPER_STRUCT)
    Protected MinesX.b
    Protected MinesY.b
    Protected *Field.Byte
    Protected Count.i
    With *mine
      For MinesY = 0 To \MinesY - 1
        For MinesX = 0 To \MinesX - 1
          *Field = mineField(*mine,MinesX,MinesY)
          If GetBit(*Field\b,1)
            Count + 1
          EndIf
        Next
      Next
      ProcedureReturn Bool(Count = (\Fields - \Mines))
    EndWith
  EndProcedure
  
  Procedure.i mineExplode(*mine.MINESWEEPER_STRUCT)
    Protected *Field.Byte
    Protected MinesX.b
    Protected MinesY.b
    With *mine  
      For MinesY = 0 To \MinesY - 1
        For MinesX = 0 To \MinesX - 1
          If \Occupied(MinesX + 1,MinesY + 1) = 1
            *Field = mineField(*mine,MinesX,MinesY)
            SetBit(*Field\b,1)
          EndIf
        Next
      Next
      \Active = #False
      \Clock = (ElapsedMilliseconds() - \Clock) / 1000
      \Win = mineCount(*mine)
    EndWith
  EndProcedure
  
  Procedure.i mineSweep(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
    Protected *Field.Byte
    With *mine
      If (X > -1 And X < \MinesX) And (Y > -1 And Y < \MinesY)
        \Occupied(X + 1,Y + 1) = 0
        If \Occupied(X + 2,Y + 1) = 3
          *Field = mineField(*mine,X + 1,Y)
          SetBit(*Field\b,1)
          mineSweep(*mine,X + 1,Y)
        ElseIf \Occupied(X + 2,Y + 1) = 2
          *Field = mineField(*mine,X + 1,Y)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X,Y + 1) = 3
          *Field = mineField(*mine,X - 1,Y)
          SetBit(*Field\b,1)
          mineSweep(*mine,X - 1,Y)
        ElseIf \Occupied(X,Y + 1) = 2
          *Field = mineField(*mine,X - 1,Y)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X + 1,Y + 2) = 3
          *Field = mineField(*mine,X,Y + 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X,Y + 1)
        ElseIf \Occupied(X + 1,Y + 2) = 2
          *Field = mineField(*mine,X,Y + 1)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X + 1,Y) = 3
          *Field = mineField(*mine,X,Y - 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X,Y - 1)
        ElseIf \Occupied(X + 1,Y) = 2
          *Field = mineField(*mine,X,Y - 1)
          SetBit(*Field\b,1)
        EndIf 
        If \Occupied(X,Y + 2) = 3
          *Field = mineField(*mine,X - 1,Y + 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X - 1,Y + 1)
        ElseIf \Occupied(X,Y + 2) = 2
          *Field = mineField(*mine,X - 1,Y + 1)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X + 2,Y) = 3
          *Field = mineField(*mine,X + 1,Y - 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X + 1,Y - 1)
        ElseIf \Occupied(X + 2,Y) = 2
          *Field = mineField(*mine,X + 1,Y - 1)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X,Y) = 3
          *Field = mineField(*mine,X - 1,Y - 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X - 1,Y - 1)
        ElseIf \Occupied(X,Y) = 2
          *Field = mineField(*mine,X - 1,Y - 1)
          SetBit(*Field\b,1)
        EndIf
        If \Occupied(X + 2,Y + 2) = 3
          *Field = mineField(*mine,X + 1,Y + 1)
          SetBit(*Field\b,1)
          mineSweep(*mine,X + 1,Y + 1)
        ElseIf \Occupied(X + 2,Y + 2) = 2
          *Field = mineField(*mine,X + 1,Y + 1)
          SetBit(*Field\b,1)
        EndIf
      EndIf 
    EndWith
  EndProcedure
  
  Procedure.i Reset(*mine.MINESWEEPER_STRUCT)
    With *mine
      FillMemory(@\Field[0],10000,0,#PB_Byte)
      FreeArray(\Occupied())
      Dim \Occupied(101,101)
      mineInitMines(*mine)
      mineInitFields(*mine)
      \Active = #True
      \Clock = #Null
      \Win = #False
      mineRender(*mine)
    EndWith
  EndProcedure
  
  Procedure.i Set(*mine.MINESWEEPER_STRUCT,MinesX.b,MinesY.b,Mines.b)
    With *mine
      If (MinesX > 1 And MinesX < 101) And 
         (MinesY > 1 And MinesY < 101) And 
         ((MinesX * MinesY) > Mines) And
         (Mines > 0)
        \MinesX = MinesX
        \MinesY = MinesY
        \Mines = Mines
        \Fields = \MinesX * \MinesY
        \Width = \Gadget\Width / \MinesX
        \Height = \Gadget\Height / \MinesY
        \CenterX = \Width / 2
        \CenterY = \Height / 2
        \FactorX = \Width / 3
        \FactorY = \Height / 3
        \FontX = \Width / 4
        \FontY = \Height / 12
        \HighlightX = \Width - (\Width / 4)
        \HighlightY = \Height - (\Height / 4)
        \OffsetX =  \Width / 8
        \OffsetY =  \Height / 8
        \InfoX = \Gadget\Width / 100
        \InfoY = \Gadget\Height / 100
        Reset(*mine)
      EndIf
    EndWith
  EndProcedure
  
  Procedure.i mineMouseLeftClick()
    Protected *mine.MINESWEEPER_STRUCT
    Protected MinesX.b
    Protected MinesY.b
    Protected *Field.Byte
    *mine = GetGadgetData(EventGadget())
    With *mine
      If \Active
        MinesX = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseX) / \Width)
        MinesY = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseY) / \Height)
        *Field = mineField(*mine,MinesX,MinesY)
        If Not GetBit(*Field\b,2)
          If GetBit(*Field\b,0)
            mineExplode(*mine)
          Else
            SetBit(*Field\b,1)
            If GetBits(*Field\b,3) = #Null
              mineSweep(*mine,MinesX,MinesY)
            EndIf
            \Win = mineCount(*mine)
            If \Win 
              \Active = #False
              \Clock = (ElapsedMilliseconds() - \Clock) / 1000
            EndIf 
          EndIf
        EndIf
        If \Clock = #Null
          \Clock = ElapsedMilliseconds()
        EndIf
      Else
        ProcedureReturn Reset(*mine)
      EndIf
      mineRender(*mine)
    EndWith
  EndProcedure
  
  Procedure.i mineMouseRightClick()
    Protected *mine.MINESWEEPER_STRUCT
    Protected MinesX.b
    Protected MinesY.b
    Protected *Field.Byte
    *mine = GetGadgetData(EventGadget())
    With *mine
      If \Active
        MinesX = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseX) / \Width)
        MinesY = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseY) / \Height)
        *Field = mineField(*mine,MinesX,MinesY)
        If GetBit(*Field\b,2)
          ResetBit(*Field\b,2)
        Else
          SetBit(*Field\b,2)
        EndIf
      EndIf
      mineRender(*mine)
    EndWith
  EndProcedure
  
  Procedure.i Create(X.i,Y.i,Width.i,Height.i,MinesX.b,MinesY.b,Mines.b)
    Protected *mine.MINESWEEPER_STRUCT
    *mine = AllocateStructure(MINESWEEPER_STRUCT)
    If *mine
      With *mine
        \Gadget\Width = Width
        \Gadget\Height = Height
        If mineInit(*mine,MinesX,MinesY,Mines)
          \Gadget\Id = CanvasGadget(#PB_Any,X,Y,Width,Height)
          If \Gadget\Id
            \Gadget\Handle = GadgetID(\Gadget\Id)
            SetGadgetData(\Gadget\Id,*mine)
            BindGadgetEvent(\Gadget\Id,@mineMouseLeftClick(),#PB_EventType_LeftClick)
            BindGadgetEvent(\Gadget\Id,@mineMouseRightClick(),#PB_EventType_RightClick)
            \Active = #True
            \Clock = #Null
            mineRender(*mine)
            ProcedureReturn *mine
          EndIf
        EndIf
      EndWith
      FreeStructure(*mine)
    EndIf 
  EndProcedure
  
  Procedure.i Id(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Gadget\Id
    EndWith
  EndProcedure
  
  Procedure.i Handle(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Gadget\Id
    EndWith
  EndProcedure
  
  Procedure.i Active(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Active
    EndWith
  EndProcedure
  
  Procedure.i Fields(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Fields
    EndWith
  EndProcedure
  
  Procedure.i Mines(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Mines
    EndWith
  EndProcedure
  
  Procedure.i Error(*mine.MINESWEEPER_STRUCT)
    With *mine
      ProcedureReturn \Error
    EndWith
  EndProcedure

  Procedure.i Free(*mine.MINESWEEPER_STRUCT)
    With *mine
      If IsGadget(\Gadget\Id)
        FreeGadget(\Gadget\Id)
      EndIf
      If IsFont(\Font)
        FreeFont(\Font)
      EndIf
      FreeStructure(*mine)
    EndWith
  EndProcedure
  
EndModule

Global M1.i
Global M2.i
Global M3.i

If OpenWindow(0,#Null,#Null,600,400,"Minesweeper Demo v.alpa",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  M1 = MINESWEEPER::Create(0,0,400,400,20,20,50)
  If M1
    M2 = MINESWEEPER::Create(400,0,200,200,20,20,60)
    If M2
      M3 = MINESWEEPER::Create(400,200,200,200,5,5,4)
      If M3
        Repeat
        Until WaitWindowEvent() = #PB_Event_CloseWindow
        MINESWEEPER::Free(M3)
      EndIf
      MINESWEEPER::Free(M2)
    EndIf 
    MINESWEEPER::Free(M1)
  EndIf 
  CloseWindow(0)
EndIf

End

Posted: **Mon Oct 29, 2018 4:06 am**

This is awesome

Posted: **Mon Oct 29, 2018 1:26 pm**

Very nice !!!!
Thanks for sharing

Posted: **Tue Jan 28, 2020 12:32 pm**

Thank you!!

I was having a problem where I couldn't use freearray() on an array that was a member of an array of structures. FreeArray would free the parent when I did this (which crashed the program when iterated across -not sure if that's intended behavior) :

Code: Select all

FreeArray(Nodes(NodeID)\Board())

Nodes() was free'd and not Board()

But I found this is your code:

Code: Select all

  Procedure.i Reset(*mine.MINESWEEPER_STRUCT)
    With *mine
      FillMemory(@\Field[0],10000,0,#PB_Byte)
      FreeArray(\Occupied())

Which led to this in my code:

Code: Select all

    Define *ArrayPtr.node
    *ArrayPtr = nodes(NodeID)\Board()
    FreeArray(*ArrayPtr\Board())

Which compiles, doesn't crash (so far) , and free's the array!!!
It might be playing with fire doing this but so far so good

Posted: **Tue Jan 28, 2020 7:46 pm**

@Mijikai,

Excellent demo.
Thank you for sharing.

Posted: **Tue Jan 28, 2020 7:54 pm**

That's a cool module, perfect for an easter egg

PureBasic Forums - English

[MODULE] Minesweeper ALL OS

[MODULE] Minesweeper ALL OS

Re: [MODULE] Minesweeper ALL OS

Re: [MODULE] Minesweeper ALL OS

Re: [MODULE] Minesweeper ALL OS

Re: [MODULE] Minesweeper ALL OS

Re: [MODULE] Minesweeper ALL OS