A FreeCell game using Cards.dll

• Download source code - 108 KB
• Download demo - 36.5 KB

Introduction

There are many good articles on the net on how to use the Cards dynamic link library, so I thought it would be fun to make my favorite one player card game, FreeCell.

Background

I really like FreeCell. In 1992, Marc L. Allen programmed and published one of the better FreeCell games available for Windows. It still works today on 32 bit Windows XP and Vista, but it is a 16 bit application, so it can't run on Vista or XP 64. I really liked the interface he used, so I decided to code a modern version of his original FreeCell Game.

Using the Code

This project uses the Cards.dll library to draw the playing cards. There are many good articles on the net on how to use the Cards dynamic link library. If you are not familiar with the cards library, I recommend you read Matt Pietrek's article on the subject: http://catch22.net/tuts/cards.

Cards.dll exposes four functions and one sub routine. They are:

• cdtInit: This function initializes the cards library, and must be called first.
VB

Private Declare Function cdtInit Lib "cards.dll" (ByRef width As Integer, _
                ByRef height As Integer) As Boolean

This function takes two arguments: the width and height of the card. These are integer variables supplied by the calling application, and are used to record the default values used by the Cards Library for card width and height. The default values are 71 pixels for card width, and 96 pixels for card height. These values are important if you are going to change the default sizes, because the ratio of 71 by 96 should be maintained, so that the card images are not distorted. But most applications use the default values, which work fine in most cases. If you are using the default values for your cards and don’t need the size, you can simply use zeros in place of the Width and Height variables.

• cdtTerm: This sub routine is the library’s destructor method, and it frees the library from memory if no other applications are using it.
VB

Declare Sub cdtTerm Lib "cards.dll" ()

Call this method when your application exits, or when you are finished drawing any cards.

• cdtDraw: This function draws the cards using their default size.
VB

Declare Function cdtDraw Lib "cards.dll" (ByVal hDC As IntPtr, ByVal x As Integer, _
        ByVal y As Integer, ByVal Card As Integer, _
        ByVal Type As Integer, ByVal clr As Integer) As Integer

This function takes the following arguments:

• hDC: The Handle for the object that the card image will be drawn on.
• X: The x-axis origin for the card image.
• Y: The y-axis origin for the card image.
• Card: The card value. Either the face value of the card, or the value for the pattern to draw if drawing the card back.
• Type: Specifies to draw the face, back, or inverted face of the card. Set this value to zero to draw the card face, and one to draw the card back.
• Clr: Sets the background color for the CrossHatch card back. All other card backs and fronts are bitmaps, so setting this has no effect for any other card back. Leave this value at zero, unless you are drawing a card back with the CrossHatch pattern.
• cdtDrawExt: Same as cdtDraw except this function allows you to specify the height and width of the card being drawn.
VB

Declare Function cdtDrawExt Lib "cards.dll" (ByVal hdc As IntPtr, ByVal x As Integer, _
        ByVal y As Integer, ByVal dx As Integer, ByVal dy As Integer, _
        ByVal card As Integer, ByVal type As Integer, _
        ByVal color As Long) As Boolean

• cdtAnimate: Animates the card back. Call this function in a loop with iState initially set to zero, and loop until the function returns zero. I personally have never used this function.
VB

Declare Function cdtAnimate Lib "cards.dll" (ByVal hDC As IntPtr, _
        ByVal ecbCardBack As Integer, ByVal x As Integer, _
        ByVal y As Integer, ByVal iState As Integer) As Integer

Card values are based on a standard 52 card deck, with no Jokers. Card values are derived from their suit and face value.

The formula for determining a card value is: FaceValue * 4 + SuitValue, or 4F + Suit.

The face and suit value enumerations are as follows:

Public Enum Suit As Byte
    CLUBS = 0
    DIAMONDS = 1
    HEARTS = 2
    SPADES = 3
End Enum

Public Enum Face As Byte
    Ace = 0
    Two = 1
    Three = 2
    Four = 3
    Five = 4
    Six = 5
    Seven = 6
    Eight = 7
    Nine = 8
    Ten = 9
    Jack = 10
    Queen = 11
    King = 12
End Enum

Examples using 4F + Suit = Card Value:

• The Ace of Spades would be 4 * 0 + 3 = a Card Value of 3.
• The Eight of Clubs would be 4 * 7 + 0 = a Card Value of 28.

Here are all of the card values:

' Card values:
            Ace| 2 | 3  | 4  | 5  | 6  | 7  | 8  | 9  | 10 |Jack|Queen|King
' CLUBS:     0   4   8    12   16   20   24   28   32   36   40   44   48
' DIAMONDS:  1   5   9    13   17   21   25   29   33   37   41   45   49
' HEARTS:    2   6   10   14   18   22   26   30   34   38   42   46   50
' SPADES:    3   7   11   15   19   23   27   31   35   39   43   47   51

In my card class, the card is initialized with its card value, and this value never changes for the lifetime of that card. This makes drawing the card face really easy.

Public Class Card : Inherits Control
    Public CardValue As Byte
    Public OldPoint As Point
    Sub New(ByVal cardvalue As Byte)
        Me.Size = New Size(CardWidth, CardHeight)
        Me.CardValue = cardvalue
    End Sub

    Private Sub PaintCard(ByVal sender As Object, ByVal e As PaintEventArgs) _
                Handles Me.Paint
        cdtDraw(e.Graphics.GetHdc, 0, 0, DirectCast(sender, Card).CardValue, 0, 0)
    End Sub
End Class

The Cards library does not have any methods to sort or compare the cards. You have to write your own methods, based on the card game. The methods shown below are for FreeCell:

' Method for returning face value based on raw card value.
' The formula for card value is (card = face * 4 + Suit)

Private Function CardFaceValue(ByVal CardValue As Byte, ByVal suite As Suit) As Face
    Return CType((CardValue - suite) / 4, Face)
End Function

Public ReadOnly Property FaceValue(ByVal CardValue As Byte) As Face
    Get
        Return CType(CardFaceValue(CardValue, SuitValue(CardValue)), Face)
    End Get
End Property

' This property returns the "raw" Card Value for next higher card
' in sequence in the same suit. If card is a king, the ace in 
' same suit is returned. If card is an ace, the two in same suit
' is returned.

Public ReadOnly Property NextFaceValue(ByVal CardValue As Byte) As Byte
    Get
        ' Determine face and suit for current card value.
        Dim f As Face = FaceValue(CardValue)
        Dim s As Suit = SuitValue(CardValue)
        If f < Face.King Then
            ' return next higher card value by adding 1 to face value.
            Return CByte(s + (f + 1) * 4)
        Else
            ' return ace in same suit as the next logical higher
            ' card than the king.
            Return CByte(s + Face.Ace * 4)
        End If
    End Get
End Property

' This property returns the "raw" Card Value for the next lower card
' in sequence in the same suit. If card is an ace, then the King card
' will be returned. If card is a 2, the ace is returned.
Public ReadOnly Property PrevCardValue(ByVal CardValue As Byte) As Byte
    Get
        ' Determine face and suit for current card value.
        Dim f As Face = FaceValue(CardValue)
        Dim s As Suit = SuitValue(CardValue)
        ' return next lower card value in same suit by subtracting 1 from face value.
        ' If the math is done right, it should properly convert to byte value.
        If CardValue > 3 Then
            Return CByte(s + (f - 1) * 4)
        Else
            ' Current card is an ace, so return the king in same suit.
            Return CByte(s + Face.King * 4)
        End If
    End Get
End Property

' Returns the opposite color for CardValue argument.
Public ReadOnly Property OppositeSuit(ByVal CardValue As Byte) As SuitColor
    Get
        Select Case SuitValue(CardValue)
            Case Suit.CLUBS, Suit.SPADES
                ' Return opposite color.
                Return SuitColor.Red
            Case Suit.DIAMONDS, Suit.HEARTS
                ' Return opposite color.
                Return SuitColor.Black
        End Select
    End Get
End Property

' Returns  two bytes that equal the card values for next 2 lower
' cards in opposite suit, like in FreeCell, when sorting cards
' in columns.
Public Function PrevOppositeSuite(ByVal CardValue As Byte) As Byte()
   Dim s As Suit = SuitValue(CardValue)
   Dim OppCards(1) As Byte
   Dim f As Face = Me.CardFaceValue(CardValue, s)
    If f = Face.Ace Then
        ' Set to King.
        f = Face.King
    Else
        ' Set to next lower face value.
        f = CType(f - 1, Face)
    End If
    Select Case s
        Case Suit.CLUBS, Suit.SPADES
            OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
            OppCards(1) = CByte(f * 4 + Suit.HEARTS)
        Case Suit.DIAMONDS, Suit.HEARTS
            OppCards(0) = CByte(f * 4 + Suit.SPADES)
            OppCards(1) = CByte(f * 4 + Suit.CLUBS)
    End Select
    Return OppCards
End Function

' Returns  two bytes that equal the card values for next 2 higer
' cards in opposite suit, like in FreeCell, when sorting cards
' in columns.
Public Function NextOppositeSuite(ByVal CardValue As Byte) As Byte()
    Dim s As Suit = SuitValue(CardValue)
    Dim OppCards(1) As Byte
    Dim f As Face = Me.CardFaceValue(CardValue, s)
    If f = Face.King Then
        ' Set to Ace.
        f = Face.Ace
    Else
        ' Set to next higher face value.
        f = CType(f + 1, Face)
    End If
    Select Case s
        Case Suit.CLUBS, Suit.SPADES
            OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
            OppCards(1) = CByte(f * 4 + Suit.HEARTS)
        Case Suit.DIAMONDS, Suit.HEARTS
            OppCards(0) = CByte(f * 4 + Suit.SPADES)
            OppCards(1) = CByte(f * 4 + Suit.CLUBS)
    End Select
    Return OppCards
End Function

' method for returning suit value.
Public Function SuitValue(ByVal CardValue As Byte) As Suit
    Select Case CardValue
        Case 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48
            Return Suit.CLUBS
        Case 1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49
            Return Suit.DIAMONDS
        Case 2, 6, 10, 14, 18, 22, 26, 30, 34, 38, 42, 46, 50
            Return Suit.HEARTS
        Case Else
            Return Suit.SPADES
    End Select
End Function

The Freecell game uses the MouseDown, MouseMove, and MouseUp events to move the cards. I also use double-click for when the cards can clear to the ace home cells.

One problem with detecting mouse down and mouse up and also double-click is, when the user double-clicks, you have to be able to disregard the mouse down and mouse up events. What I did was I made a doubleclick boolean and sets it to true on the mouse down event, and sets it to false during mouse move. In my mouse up event, the code exits if doubleclick is true. That way, when the user double-clicks but the card did not move, the code in mouse up ignores the call.

Sub Card_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
    If e.Clicks = 1 AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
        ' MouseMove will fire first time user clicks card.
        ' Only fire mouse move if mouse location changes.
        OldMousept = e.Location
        ' double-click flag is always set to true.
        ' It is set false if card is moved.
        ' This is so mouseUp event only
        ' fires if card was moved.
        DblClick = True
        Dim c As Card = DirectCast(sender, Card)
        c.BringToFront()
        Xpos = Control.MousePosition.X - c.Left
        Ypos = Control.MousePosition.Y - c.Top
    End If
End Sub

Sub Card_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
    If e.Clicks = 0 AndAlso e.Button = Windows.Forms.MouseButtons.Left AndAlso _
                            e.Location <> OldMousept Then
        DblClick = False
        DirectCast(sender, Card).Location = _
          New Point(Control.MousePosition.X - Xpos, _
                    Control.MousePosition.Y - Ypos)
    End If
End Sub

Sub Card_MouseUp(ByVal sender As Object, _
                 ByVal e As System.Windows.Forms.MouseEventArgs)
    ' The DblClick flag is always set to true at mouse-down event,
    ' to prevent this sub from firing when the user is double-clicking
    ' the card. If not double-clicking, then when the card is moved
    ' the mouse move event of the card resets DblClick to
    ' false. If we remove the DblClick flag, this sub will fire
    ' multiple times when the user double-clicks the card.
    If Not DblClick AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
        Dim c As Card = DirectCast(sender, Card)
        Dim idx As Integer
        ' Determine if card is being dropped over another card,
        ' and if it is, try to dock the card.

        ' First the Location.X/Left position is checked against
        ' possible Left-Right docking ranges. If a match is
        ' found then the Location.Y/Top position is checked against
        ' possible Top-Bottom docking ranges. There are only 16
        ' possible docking areas: 8 columns, 4 free cells, and 4
        ' Ace Docking areas.

        ' For the 8 columns, the location of the top card in the
        ' column is used. If the column card count is zero, then
        ' the Row(0) location is used.

        ' The numbers were determined using card locations and card
        ' sizes. In most cases, only 40 % of the destination card
        ' needs to be covered for dragged card to be dropped there. 

        Select Case c.Left
            Case 77 To 150 ' Aces
                Select Case c.Top
                    ' Determine if card is partly covering one of the Aces spots.
                    Case 138 To 238 '  0 Ace of Clubs.
                        TryDockAce(c, 0, True)
                    Case 247 To 347 ' 1 Ace of Diamonds.
                        TryDockAce(c, 1, True)
                    Case 356 To 456 ' 2 Ace of Hearts.
                        TryDockAce(c, 2, True)
                    Case 469 To 565 ' 3 Ace of spades.
                        TryDockAce(c, 3, True)
                    Case Else
                        ' Card not playable at location it was dropped to.
                        ' Move card back to old position.
                        c.Location = c.OldPoint
                End Select
                ' Values for rows and column positions:
                '  Rows (Y Pos) {135, 160, 185, 210, 235, 260, 285}
                '  Columns (X Pos) {195, 278, 361, 444, 527, 610, 693, 776}
            Case 157 To 233 ' Column 0
                idx = Columns(0).Count - 1
                Select Case True
                    Case idx > -1
                        ' First verify that this is not the same top card in
                        ' the column. If it is, return it to its old location.
                        If Columns(0)(idx) Is c Then
                            c.Location = c.OldPoint
                            ' Check if Top of card is being dropped
                            ' in range of column 0's Y position. All Cards
                            ' should auto-dock/auto-drop when released, if
                            ' 40-50% covering area of the destination card.
                        ElseIf c.Top >= Columns(0)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(0)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 0, False)
                        Else
                            ' Card not playable at location it was dropped to.
                            c.Location = c.OldPoint
                        End If
                        ' If column has no cards in it, check if card is being
                        ' dropped over row zero in the empty column.
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                        ' Move the card into the empty row and handle where
                        ' the card came from.
                        MoveToEmptyCol(c, 0, False)
                    Case Else
                        ' Card not playable at location it was dropped to.
                        c.Location = c.OldPoint
                End Select
            Case 240 To 316 ' Column 1
                idx = Columns(1).Count - 1
                Select Case True
                  Case idx > -1
                        If Columns(1)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(1)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(1)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 1, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                        MoveToEmptyCol(c, 1, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 323 To 399 'Either Column 2 or FreeCell 0.
                Select Case True
                    Case c.Top >= 570 AndAlso c.Top <= 681
                        ' Card is over Free Cell 0.
                        ' Try to dock to Free Cell 0.
                        TryDockFC(c, 0)
                    Case Columns(2).Count > 0
                        idx = Columns(2).Count - 1
                        If Columns(2)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(2)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(2)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 2, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                    ' Card over first row in empty column.
                        MoveToEmptyCol(c, 2, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 406 To 482 ' Either Column 3 or FreeCell 1.
                Select Case True
                    Case c.Top >= 570 AndAlso c.Top <= 681
                        ' Card is over Free Cell 1.
                        ' Try to dock to Free Cell 1.
                        TryDockFC(c, 1)
                    Case Columns(3).Count > 0
                        idx = Columns(3).Count - 1
                        If Columns(3)(idx) Is c Then
                          c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(3)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(3)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 3, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                    ' Card over first row in empty column.
                        MoveToEmptyCol(c, 3, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 489 To 565 ' Either Column 4 or FreeCell 2.
                Select Case True
                    Case c.Top >= 570 AndAlso c.Top <= 681
                        ' Card is over Free Cell 2.
                        ' Try to dock to Free Cell 2.
                        TryDockFC(c, 2)
                    Case Columns(4).Count > 0
                        idx = Columns(4).Count - 1
                        If Columns(4)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(4)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(4)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 4, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                    ' Card over first row in empty column.
                        MoveToEmptyCol(c, 4, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 572 To 648  ' Either Column 5 or FreeCell 3.
                Select Case True
                    Case c.Top >= 570 AndAlso c.Top <= 681
                        ' Card is over Free Cell 3.
                        ' Try to dock to Free Cell 3.
                        TryDockFC(c, 3)
                    Case Columns(5).Count > 0
                         idx = Columns(5).Count - 1
                          If Columns(5)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(5)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(5)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 5, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                    ' Card over first row in empty column.
                        MoveToEmptyCol(c, 5, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 649 To 731 ' Column 6
                idx = Columns(6).Count - 1
                Select Case True
                    Case idx > -1
                        If Columns(6)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(6)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(6)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 6, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                        Me.MoveToEmptyCol(c, 6, False)
                    Case Else
                        c.Location = c.OldPoint
                End Select
            Case 732 To 814 ' Column 7
                idx = Columns(7).Count - 1
                Select Case True
                    Case idx > -1
                       If Columns(7)(idx) Is c Then
                            c.Location = c.OldPoint
                        ElseIf c.Top >= Columns(7)(idx).Top - 50 AndAlso _
                               c.Top <= Columns(7)(idx).Top + 70 Then
                            TryMoveToColumn(c, idx, 7, False)
                        Else
                            c.Location = c.OldPoint
                        End If
                    Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
                        Me.MoveToEmptyCol(c, 7, False)
                      Case Else
                        c.Location = c.OldPoint
                End Select
            Case Else
                ' Card not playable at location it was dropped to.
                ' Move card back to old position.
                c.Location = c.OldPoint
        End Select
    End If
End Sub

Once all cards have been cleared to the Ace Home Cells, in FreeCell, the game has been won. In this game, a thread re-initializes the cards and spreads them out, using a thread-safe invoke method to move each card. Cards are spread out at a random distance. Sometimes they are spread out just enough to see each card. Sometimes they are spread way out, like in the picture below:

Most Freecell games have saved games, or saved decks that can be selected and played. Microsoft FreeCell for Windows XP has 100,000 selectable games. I decided to store 100,000 games in an embedded binary file for selecting games. The simplest way to do this for Freecell is to store a pattern of 52 bytes in a particular order that it will be dealt out in, for the game. With no padding between the bytes, my 100,000 games took up over 5 MB, which is why my application is over 5 MB. I tried compressing the file, and it was still over 3 MB. Microsoft manages to store the same 100,000 games, and their FreeCell app is only 55 kilobytes. If anyone knows how they manage this, I would like to know.

Updated: Thanks, MojoFlys, for pointing out that when getting a set of cards for a new game, instead of loading a set of bytes, you can simply use the selected game number as a seed for an instance of a random class, and generate the cards that way. Then, you can make a specific card deal based on the game number selected, without having to store anything.

I modified the project, and here is the new method for the user selected game. GameIndex is the selected game, an Integer between 1 and 100,000. Much easier than having to store 100,000 games!

Dim r As New Random(GameIndex)
Dim Cards(51) As Byte
Dim st As New Generic.Stack(Of Byte)
Do
    For b As Byte = 0 To 51
        b = CType(r.Next(0, 52), Byte)
        If Not st.Contains(b) Then
            st.Push(b)
        End If
    Next b
Loop Until st.Count = 52

Updated: I found a bug in the code that records which cards are sorted, and can be moved as a column. It was in the SetSorted subroutine. Here is the updated code. The project download and executable download have both been updated. Note that in the old subroutine, in the For Next loop, if the next opposite card did not match, the Else statement was missing, and it would not exit the sub. Instead, it would keep looping, so you could have two sets of sorted cards in the same column, and move events would be added to cards that should remain un-moveable.

Sub SetSorted(ByVal Col As Byte)
    Dim idx As Integer
    ' Remove sorted card events from all
    ' of the cards in the column.
    For idx = 0 To Columns(Col).Count - 1
        RemoveSortedEvents(Columns(Col)(idx))
    Next idx
    idx = Columns(Col).Count - 1
    ' For there to be a moveable group of cards, there must
    ' be at least 2 cards/count must be at least 2.
    If idx > 0 Then
        Dim Cards As Byte()
        For i As Integer = idx To 1 Step -1
            Cards = pc.NextOppositeSuite(Columns(Col)(i).CardValue)
            If Cards(0) = Columns(Col)(i - 1).CardValue OrElse _
               Cards(1) = Columns(Col)(i - 1).CardValue Then
                AddSortedEvents(Columns(Col)(i - 1))
            Else
                Exit Sub
            End If
        Next i
    End If
End Sub

This project was really a lot of fun to code, and it was one of those fun projects you have a hard time putting down. I started coding it over one weekend, and one weekend of coding for fun turned into three :).

Please note that to run this application in Windows Vista, you will need to copy Cards.dll to the same folder that the exe file is in, or you can also run RegSvr32 and register cards.dll in Vista.

Freeeware: Please feel free to use or modify any of the code in this project, but do not use it for any commercial product.

Disclaimer: I am not responsible for any damage to any computer equipment, or for any data loss that might occur while using any of the code posted in this article. Use this code at your own risk.