Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Variations on Peg Solitaire
#1
This game is another rendition of the old Peg Solitaire, with a few extra twists.
It uses a square grid, and players can choose between 3 modes, with horizontal+vertical jumps, diagonal jumps, or both, with a timer for each level. Hi-Scores are kept for the best 3 results for each mode. Score is based on pegs removed and time taken.
Code: (Select All)
SW = 1020: SH = 780 '                                                                     select window size
Screen _NewImage(SW, SH, 32)
Common Shared CPL, MX, MY, FROM, FromH, FromV, TOO, MidCell, TooH, Toov, Cells(), Mode, Score
Common Shared Best$(), T1, Name$, Distance, OK$, Bad$, Pick$, HiFrame$

Dim Cells(49, 5), Best$(18) '                                                             each cell has 4 positions and a char-number
OK$ = "l32o3cg": Bad$ = "l16o1gc": Pick$ = "o4l54g": HiFrame$ = "r145d83l145u83"
Data "40","HAMMER","30","HAMMER","20","HAMMER","35","HAMMER","25","HAMMER","15","HAMMER","30","HAMMER","20","HAMMER","10","HAMMER"

SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font f& '       monospace font
SMode = 32
CPL = SW / _PrintWidth("X") '                                                             chars per line for this window width
lhs = (_DesktopWidth - CPL) / 2 '                                                         position for LHS of window
_ScreenMove (_DesktopWidth - SW) / 2, 90 '                                                place window there
Play OK$

PrepareBestList:
Cls
If Not (_FileExists("best")) Then '                                                       if hi-score list is not found, create it
    centre "Hi-Score list refreshed", 14: Play OK$: Sleep 1: Restore
    refreshed = 1
    ReDim Best$(18)
    Open "best" For Output As #1
    For a = 1 To 18
        Read Best$(a)
        Write #1, Best$(a)
    Next
    Close
End If
Open "best" For Input As #1
For a = 1 To 18: Input #1, Best$(a): Next '                                                place hi-scores in Best$()
Close

Intro

ShowBest

KeepOrKill:
If refreshed = 0 Then
    k$ = ""
    Yellow: centre "Keep these records (y/n) ?", 37
    While k$ = "": k$ = InKey$: Wend
    If UCase$(k$) = "N" Then
        Kill "best": GoTo PrepareBestList '                                                 if not wanted, delete and create a new one
    End If
    Cls
End If
Cls
Play OK$

PlayerPrefs:
centre "Your name (to 6 characters) ?        ", 12 '                                        spaces move centre to left
Locate 12, 48: Input Name$
If Len(Name$) > 6 Then
    Name$ = Left$(Name$, 6)
Else If Len(Name$) < 2 Then Name$ = "ANON"
End If
Name$ = UCase$(Name$): WIPE "12": centre Name$, 12
Play OK$
Sleep 1
Cls
centre "Select a mode (1 to 3)", 14: Sleep
While k$ < "1" And k$ > "3": Wend
k$ = InKey$
Mode = Val(k$)
Cls

SetPegs: '                                                                                  7*7 cells, 5 elements each
For a = 0 To 6
    For b = 0 To 6
        Cells(a * 7 + b + 1, 1) = a * 52 + 314 '                                           1st element left top of cell
        Cells(a * 7 + b + 1, 2) = a * 52 + 366 '                                           2nd elementright top of cell
        Cells(a * 7 + b + 1, 3) = b * 40 + 48 '                                            3rd element left bottom of cell
        Cells(a * 7 + b + 1, 4) = b * 40 + 88 '                                            4th element right bottom of cell
        'Set Cells(49,5) for all cells to 42
        Cells(a * 7 + b + 1, 5) = 42 '                                                     5th element chr$(42) * in all cells
    Next
Next

SetVacantCell: '                                                                           Select Vacant cell, not on edge of grid
Do
    vac = Int(Rnd * 33) + 9 '                                                              select (random) empty cell
Loop Until vac Mod (7) <> 0 And vac Mod (7) <> 1 '                                         if this is an edge cell, try again
vacv = 3 + Int(vac / 7) * 2 + 1 '                                                          vacant cell vertical position in grid
vach = 19 + (vac Mod (7) + 1) * 4 '                                                        vacant cell horizontal position in grid
Cells(vac, 5) = 32 '                                                                       mark vac as vacant in cells() array
Cells(vac, 5) = 32 '                                                                       mark vacant cell as chr$(32) space in cells()                                                                                                     (32 is space)

ShowCells:
For a = 1 To 7 '                                                                           for each row of grid
    For b = 1 To 7 '                                                                       for each cell of row
        Locate 2 + a * 2, 23 + b * 4: Print "*" '                                          fill all with *
    Next
Next
Green
Locate vacv, vach: Print "O" '                                                             place green O in vacant cell to identify it

DrawGridFrame:
Play OK$
Yellow
H = 22 '                                                                                   start frame from horizontal 22
For a = 0 To 6 '                                                                           7 horizontal squares in frame
    For b = 0 To 6 '                                                                       7 vertical rows of squares
        PSet (a * 52 + 316, b * 40 + 48)
        Draw "r52d40l52u40"
    Next
Next

ShowEnd:
Locate 18, 38: Print "END" '                                                               show END cell
Yellow
PSet (473, 330): Draw "r52d36l52u36" '                                                     draw END frame

ShowBest

T1 = Timer '                                                                               start timer
txt$ = "Mode" + Str$(Mode) + " selected"
centre txt$, 24

ChooseFROM:
GetFrom '                                                                                  call sub to select FROM cell
If FROM < 0 Then Play Bad$: GoTo ChooseFROM
If FROM = 50 Then Done

ChooseTO:
GetToo
If TOO <= 0 Then Play Bad$: GoTo ChooseFROM
If TOO = 50 Then Done
FindMidCell
If Distance = 0 Then Play Bad$: GoTo ChooseFROM
ChangeCells

CalcScore
GoTo ChooseFROM

'                                                      *** Subs below here ***
Sub CreateBest
    If _FileExists("best") Then Kill "best"
    Restore
    ReDim Best$(18)
    Open "best" For Output As #1
    For a = 1 To 18
        Read Best$(a)
        Write #1, Best$(a)
    Next
    Close
    'End If
    Open "best" For Input As #1
    For a = 1 To 18: Input #1, Best$(a): Next
    Close
End Sub

Sub ShowBest
    Yellow: centre "Scores to Beat", 30
    Locate 32, 17
    Print "Mode 1"; Tab(37); "Mode 2"; Tab(57); "Mode 3": White
    For a = 0 To 2
        For b = 1 To 5 Step 2
            Locate 33 + a, 10 * b + 4
            Print Best$(a * 6 + b); Tab(10 * b + 8); Best$(a * 6 + b + 1)
        Next
    Next
    Yellow: PSet (160, 618): Draw HiFrame$: PSet (420, 618): Draw HiFrame$: PSet (680, 618): Draw HiFrame$

End Sub

Sub GetFrom:
    centre "Choose FROM location", 20
    Do
        While _MouseButton(1): m% = _MouseInput: Wend '                                    wait for left-mouse to restore
        m% = _MouseInput '                                                                 prepare mouse
        If _MouseButton(1) Then '                                                          get left-mouse status
            MX = _MouseX: MY = _MouseY '                                                   horiz and vert position
            If MX > 473 And MX < 526 And MY > 330 And MY < 371 Then FROM = 50: Exit Sub '  END cell, mark FROM as 50
            If MX < 316 Or MX > 680 Or MY < 48 Or MY > 328 Then FROM = -2: Exit Sub '      outside the grid, mark FROM as -2
            FromH = Int((MX - 316) / 52) + 1 '                                             horiz column of FROM cell
            FromV = Int((MY - 48) / 40) + 1 '                                              vert row of FROM cell
            FROM = (FromV - 1) * 7 + FromH '                                               number of FROM cell, 1 to 49
            If Cells(FROM, 5) = 32 Then FROM = -1: Exit Sub '                              vacant cell, mark From as -1
        End If
    Loop Until _MouseButton(1)
    Play Pick$
End Sub

Sub GetToo
    WIPE "20": centre "Choose TO location", 20
    Do
        While _MouseButton(1): m% = _MouseInput: Wend '                                    wait for left-mouse to restore
        m% = _MouseInput '                                                                 prepare mouse
        If _MouseButton(1) Then '                                                          get left-mouse status
            MX = _MouseX: MY = _MouseY '                                                   horiz and vert position
            If MX > 473 And MX < 526 And MY > 330 And MY < 371 Then TOO = 50: Exit Sub '   END cell, mark FROM as 50
            If MX < 316 Or MX > 680 Or MY < 48 Or MY > 328 Then TOO = -2: Exit Sub '       outside the grid, mark FROM as -2
            TooH = Int((MX - 316) / 52) + 1 '                                              horiz column of FROM cell
            Toov = Int((MY - 48) / 40) + 1 '                                               vert row of FROM cell
            TOO = (Toov - 1) * 7 + TooH '                                                  number of FROM cell, 1 to 49
            If Cells(TOO, 5) <> 32 Then TOO = -1: Exit Sub '                               vacant cell, mark From as -1
        End If
    Loop Until _MouseButton(1)
    Play Pick$
End Sub

Sub FindMidCell
    Distance = Abs(FROM - TOO) '                                                           FROM and TOO are selected cell numbers
    CheckDistance: '                                                                       check relative positions of cells
    Select Case Mode
        Case 1 '                                                                           2 horiz, vert or diag is +/- 2, 12, 14 or 16
            If Distance <> 2 And Distance <> 12 And Distance <> 14 And Distance <> 16 Then
                Distance = 0
                Red: centre "Cells must be 2 cells apart", 22
                Play Bad$: Sleep 2: Yellow
                WIPE "22": Exit Sub
            End If
        Case 2 '                                                                            2 horiz or vert is +/-2 or 14
            If Distance <> 2 And Distance <> 14 Then
                Distance = 0
                centre "Horizontal or vertical hops of 2 cells only", 22
                Play Bad$: Sleep 2: Yellow
                WIPE "22": Exit Sub
            End If
        Case 3 '                                                                            2 diag is +/- 12 or 16
            If Distance <> 12 And Distance <> 16 Then
                Distance = 0
                Red: centre "Diagonal hops of 2 cells only", 22
                Play Bad$: Sleep 2: Yellow
                WIPE "22": Exit Sub
            End If
    End Select
    MidCell = (FROM + TOO) / 2: MidCellv = (FromV + Toov) / 2 + 4: MidCellh = (FromH + TooH) / 2 + 4
    If Cells(MidCell, 5) = 32 Then
        Distance = 0
        Red: centre "Middle cell must be occupied!", 22
        Play Bad$: Sleep 2: Yellow
        WIPE "22": Exit Sub '                                                               if not, get another FROM cell
    End If
End Sub

Sub ChangeCells '                                                                            update grid  display
    Cells(FROM, 5) = 32
    Cells(MidCell, 5) = 32
    Cells(TOO, 5) = 42
    ShowChanges: '                                                                                                                                               show changed pegs
    Yellow
    Locate FromV * 2 + 2, FromH * 4 + 23: Print " "
    Locate Toov * 2 + 2, TooH * 4 + 23: Print "*"
    Locate (FromV * 2 + 2 + Toov * 2 + 2) / 2, (FromH * 4 + 23 + TooH * 4 + 23) / 2: Print " "
End Sub

Sub CalcScore '                                                                               update score
    WIPE "2628"
    Picks = Picks + 1
    Score = Picks * 10 + Int(T1 - Timer)
    txt$ = "Score:" + Str$(Score)
    centre txt$, 26
    txt$ = "Pegs Remaining:" + Str$(48 - Picks)
    centre txt$, 28
    Play OK$
End Sub

Sub Done ' Player has finished
    Cls
    Play OK$: Play OK$
    txt$ = "You scored " + LTrim$(Str$(Score))
    centre txt$, 17
    CheckHi
    Sleep: Run
End Sub

Sub CheckHi
    txt$ = "Checking against Hi-Scores for Mode" + Str$(Mode) + "..."
    centre txt$, 19
    win = 0
    sc1 = 1 + (Mode - 1) * 2: nm1 = 2 + (Mode - 1) * 2
    sc2 = 7 + (Mode - 1) * 2: nm2 = 8 + (Mode - 1) * 2
    sc3 = 13 + (Mode - 1) * 2: nm3 = 14 + (Mode - 1) * 2
    Select Case Score
        Case Is > Val(Best$(sc1)) ' better than first - move 2nd down, 1st down, place score and name in 1st
            Best$(sc3) = Best$(sc2): Best$(nm3) = Best$(nm2)
            Best$(sc2) = Best$(sc1): Best$(nm2) = Best$(nm1)
            Best$(sc1) = LTrim$(Str$(Score)): Best$(nm1) = Name$
            win = 1: txt$ = "Congratulations, you beat First place"
        Case Is = Val(Best$(sc1)), Is > Val(Best$(sc2)) ' better than second - move 2nd down, place score and name in 2nd
            Best$(sc3) = Best$(sc2): Best$(nm3) = Best$(nm2)
            Best$(sc2) = LTrim$(Str$(Score)): Best$(nm2) = Name$
            win = 1: txt$ = "Congratulations, you beat Second place"
        Case Is = Val(Best$(sc2)), Is > Val(Best$(sc3)) ' better than third - place score and name in 3rd
            Best$(sc3) = LTrim$(Str$(Score)): Best$(nm3) = Name$
            win = 1: txt$ = "Congratulations, you beat Third place"
    End Select
    If win = 1 Then
        centre txt$, 21: Sleep 3: Cls
        Open "best" For Output As #1
        For a = 1 To 18: Write #1, Best$(a): Next '                                           save new Best score
        Close

    End If
    ShowBest: Sleep 3: Run
End Sub

Sub White
    Color _RGB(255, 255, 255)
End Sub

Sub Red
    Color _RGB(255, 0, 0)
End Sub

Sub Green
    Color _RGB(0, 255, 0)
End Sub

Sub Yellow
    Color _RGB(255, 255, 0)
End Sub

Sub centre (txt$, linenum) '                                                                  centres text on selected line
    ctr = Int(CPL / 2 - Len(txt$) / 2) + 1 '                                                  centre is half of chars per line minus half string-length
    Locate linenum, ctr
    Print txt$
End Sub

Sub WIPE (ln$) '  (ln$ is string of  2-digit line-numbers)                                    "0122" wold mean lines 1 and 22
    For a = 1 To Len(ln$) - 1 Step 2
        wl = Val(Mid$(ln$, a, 2)) '                                                           get 2 digits of line to be wiped (wl),
        Locate wl, 1: Print Space$(CPL); '                                                    and write full row of spaces to that line
    Next
End Sub

Sub Intro
    'Show intro text
    Yellow
    centre "LeapFrog", 2: White: Print: Print
    Print "   A board of 7x7 cells is displayed, all except one occupied by pegs."
    Print "   Remove as many pegs as you can, by hopping another peg over them, as"
    Print "   quickly as you can. Hops may be in any direction (but see";: Yellow: Print " Modes";: White: Print " below),"
    Print "   over a single occupied cell, and the landing cell must be vacant.": Print
    Print "   With the mouse, choose a ";: Yellow: Print "FROM";: White: Print " cell, then a ";: Yellow
    Print "TO";: White: Print " cell, with one occupied"
    Print "   cell between them. If these conditions are met, the cell between them"
    Print "   is cleared, and the action can be repeated. Otherwise, the move is"
    Print "   rejected, and you must try again with different cells."
    Print "   Select the ";: Yellow: Print "END ";: White:
    Print " cell when you can find no more moves.": Print
    Print "   You receive ten points for each hop, but the final score is reduced by"
    Print "   one point per second of game time, so you need to be quick!"
    Print "   Or you can ignore the timer and just play to remove maximum pegs.": Print
    Yellow: centre "Modes", 20: White
    Print "   There are 3 Modes of play, each with different directions for hops:"
    Print "   1: Hop in any direction, horizontal, vertical or diagonal (Easy)"
    Print "   2: Horizontal or vertical hops only, any of four directions (Medium)"
    Print "   3: Diagonal hops only, any of four directions (Hard).": Print
    Print "   A Hi-score list of the three best results for each mode is kept, and"
    Print "   if you beat one of these, your result will be placed on this list."
End Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply




Users browsing this thread: 1 Guest(s)