CopyCat - a memory-improver game

[PhilOfPerth]

A little memory-improver  game for people like me:

Code: (Select All)

SW = 1040: SH = 720
Screen _NewImage(SW, SH, 32)
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&

Common Shared CPR, Ctr, Lev, List$, TotScore, Show$, Try$, Record
CPR = Int(SW / _PrintWidth("X")): Ctr = Int((CPR + 1) / 2) '         CPR is chars Per Row, Ctr is horiz centre in this screensize
_ScreenMove (_DesktopWidth - SW) / 2, 90 '                           move screen display to horiz centre
OK$ = "o4l32cde": Bad$ = "o3l32edc" '                                sound strings
Record = 30: TopPlr$ = "ANON" '                                      default record
If _FileExists("CopycatTop") Then
    Open "CopycatTop" For Input As #1
    Input #1, Record, TopPlr$
    Close #1
End If

Randomize Timer

Start:
yellow: Centre "COPYCAT", 10
Centre "Try to copy the text, exactly as presented (lower case is ok)", 12: white
Centre "Earn 5 points for each letter correct and in its correct position,", 14
Centre "Earn 1 point for each correct letter that's in the wrong position,", 15
Centre "Game ends when you type a letter that is not anywhere in the text.", 16
Centre "An extra letter will be added after each try.", 18: yellow
txt$ = "Record is" + Str$(Record) + " by " + TopPlr$
Centre txt$, 20
Centre "Press R to Reset the Record, any other key to start.", 22
While k$ = "": k$ = InKey$: Wend
If UCase$(k$) = "R" Then
    Record = 30: TopPlr$ = "ANON"
    Open "CopycatTop" For Output As #1
    Write #1, Record, TopPlr$
    Close #1
    WIPE "20": Centre "Record reset", 20
    Sleep 1
End If
Play OK$: Cls

GetText:
Cls
txt$ = "Record is" + Str$(Record) + " by " + TopPlr$
Centre txt$, 1
TotScore = TotScore + score: Lev = Lev + 1
txt$ = "Your score is " + Str$(TotScore)
Centre txt$, 3
_KeyClear
score = 0: Show$ = ""
Centre "Memorize this:", 12: white
List$ = List$ + Chr$(Int(Rnd * 26) + 65)
Centre List$, 13
Sleep 3
WIPE "1213"
yellow: Centre "Now type it", 12: white

Locate 19, 39 - Len(List$) \ 2 '                                     start of list
Input Try$
Play OK$
Try$ = UCase$(Try$)
WIPE "19"
For a = 1 To Len(Try$): Show$ = Show$ + Mid$(Try$, a, 1) + "   ": Next
yellow: Centre Show$, 19
Analyze
GoTo GetText

Sub Analyze
    Centre List$, 13
    LeftPo = 42 - Len(Show$) / 2
    ThisV = 0
    For a = 1 To Len(Try$)
        L$ = Mid$(Try$, a, 1) '                                      get each Try letter
        Po = InStr(1, List$, L$) '                                   find its position in List$
        Select Case Po
            Case Is = 0 '                                            not in the list
                Play "L16O2CP32O1P32GP32EP32C"
                V = 0 '                                              value 0
                Locate 20, LeftPo + 4 * (a - 1) - 2
                Print s
                Sleep 1
                GameEnd
                Run
            Case Is = a '                                            position is same as position in list
                Play "L32O4CP16"
                V = 5: ThisV = ThisV + V '                           value 5 points
                Mid$(List$, Po, 1) = LCase$(Mid$(List$, Po, 1))
            Case Else
                Play "L32O3CP32"
                V = 1: ThisV = ThisV + V '                           value 1 point; add to total for this try
                Mid$(List$, Po, 1) = LCase$(Mid$(List$, Po, 1)) '    change temporarily to lower-case to prevent re-finding
        End Select
        Locate 20, LeftPo + 4 * (a - 1) - 2 '                        show value below letter
        Print V
    Next
    TotScore = ThisV + TotScore '                                    add total value of this try to running total
    Txt$ = "This try scored " + Str$(ThisV) + " points"
    Centre Txt$, 22
    Sleep 1: Cls
    List$ = UCase$(List$) '                                          change list letters back to Upper-case
End Sub

Sub GameEnd
    Sleep 2
    Cls
    txt$ = "You reached level " + Str$(Lev)
    Centre txt$, 7
    txt$ = "and you scored " + Str$(TotScore) + " points"
    Centre txt$, 8
    If TotScore > Record Then
        Centre "You've set a new record. Please type your name ", 10
        Locate 12, 38: Input Name$
        Name$ = UCase$(Name$)
        If Name$ < "A" Or Name$ > "Z" Then Name$ = "ANON" '          default name if not given
        Open "CopycatTop" For Output As #1
        Write #1, TotScore, Name$ '                                  save new record
        Close #1
    End If
    Cls
End Sub

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

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

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

Sub WIPE (RN$)
    If Len(RN$) = 1 Then RN$ = "0" + RN$ '                           extend single digit row numbers to 2 digits
    For A = 1 To Len(RN$) - 1 Step 2
        WipedLine = Val(Mid$(RN$, A, 2))
        Locate WipedLine, 1: Print Space$(CPR - 1);
    Next
End Sub

Sub Centre (Txt$, RowNum) '                                          centre text on row
    Ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1 '                         position will be centre minus half text-length
    Locate RowNum, Ctr
    Print Txt$;
End Sub

[bplus]

Looking good!

[SierraKen]

That's a fun game! Reminds me of my Simon (non-computer game). With my memory problems I could use this too, thanks!

[NakedApe]

Nice, Phil! I guess writing the letters down would be cheating, huh? *wink*

[Pete]

Hot damn, I need one of these. Ah, what's it do again???

Pete