[MODULE] Minesweeper ALL OS

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

[MODULE] Minesweeper ALL OS

Post by Mijikai »

I have written a Minesweeper Module 8)
Have fun :D

Image

Code:

Code: Select all

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
Last edited by Mijikai on Mon Oct 29, 2018 12:50 pm, edited 1 time in total.
Cyllceaux
Enthusiast
Enthusiast
Posts: 458
Joined: Mon Jun 23, 2014 1:18 pm
Contact:

Re: [MODULE] Minesweeper ALL OS

Post by Cyllceaux »

This is awesome :shock:
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: [MODULE] Minesweeper ALL OS

Post by Kwai chang caine »

Very nice !!!!
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
pdwyer
Addict
Addict
Posts: 2813
Joined: Tue May 08, 2007 1:27 pm
Location: Chiba, Japan

Re: [MODULE] Minesweeper ALL OS

Post by pdwyer »

Thank you!! :D :shock:

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
Paul Dwyer

“In nature, it’s not the strongest nor the most intelligent who survives. It’s the most adaptable to change” - Charles Darwin
“If you can't explain it to a six-year old you really don't understand it yourself.” - Albert Einstein
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: [MODULE] Minesweeper ALL OS

Post by davido »

@Mijikai,

Excellent demo.
Thank you for sharing. :D
DE AA EB
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: [MODULE] Minesweeper ALL OS

Post by Fred »

That's a cool module, perfect for an easter egg :)
Post Reply