Hangman

- JanetTerra JanetTerra Jan 21, 2007

This simple Hangman game makes a random selection from a list of 20 words.
You can add to that list by modifying the WordList$() function.

You will be asked to use a custom wordlist from a file at the beginning too.

To play, copy the following code to your clipboard. To copy to your clipboard
>Highlight the entire code.
>Right click your mouse on any of the highlighted area.
>Choose COPY from the drop down menu.

Goto Run BASIC and select the Write Your Own tab.

Paste the code into the Run BASIC editor.
>Right click your mouse in the editor.
>Choose PASTE from the drop down menu.

    ' Hangman by Janet Terra
    ' Released to Public Domain 1/21/07
 
    answer$ = "N"
    input "Use words from a custom text file (Y/[N])"; answer$
 
    if instr("Yy",answer$) = 0 then
        Words$ = WordList$()
    else
        print
        upload "Upload ANSI (no UNICODE) text file to select words from:"; fname$
        Words$ = FileList$(fname$)
    end if
 
[restart]
    HangWord$ = GetWord$(Words$)
    GuessWord$ = ""
    Alpha$ = ""
    nWrongGuesses = 0
 
    For i = 1 to Len(HangWord$)
        GuessWord$ = GuessWord$;"_"
    Next i
    For i = 65 to 90
        Alpha$ = Alpha$;Chr$(i)
    Next i
 
    Graphic #g, 400, 300
 
[GuessLetter]
    cls
    #g Cls("White")
    Call Gallows
    If nWrongGuesses > 0 Then
        Call HangedMan1
    End If
    If nWrongGuesses > 1 Then
        Call HangedMan2
    End If
    If nWrongGuesses > 2 Then
        Call HangedMan3
    End If
    If nWrongGuesses > 3 Then
        Call HangedMan4
    End If
    If nWrongGuesses > 4 Then
        Call HangedMan5
    End If
    If nWrongGuesses > 5 Then
        Call HangedMan6
    End If
    Call HangWord GuessWord$
    Call Alphabet Alpha$
    #g Flush()
    Render #g
    ltr$ = ""
 
    Input "Letter > ";ltr$
    If ltr$ = "" then [GameOver]
    Alpha$ = Alphabet$(Alpha$, ltr$)
    If Instr(lower$(HangWord$), Lower$(ltr$)) Then
        GuessWord$ = CorrectGuess$(HangWord$, GuessWord$, ltr$)
    Else
        nWrongGuesses = nWrongGuesses + 1
    End If
 
    If Instr(GuessWord$, "_") = 0 Then
        cls
        Call HangWord GuessWord$
        Call Alphabet Alpha$
        Call GameWin HangWord$
    Else
        If nWrongGuesses < 7 Then
            Goto [GuessLetter]
        Else
            cls
            Call HangedMan7
            Call GameLose HangWord$
        End if
    End If
 
[GameOver]
    cls
    #g Flush()
    Render #g
    z$ = "N"
    Input "Like to play again (Y/[N])";z$
    if instr("Yy", z$) > 0 then [restart]
    End
 
Sub GameWin HangWord$
    #g Color("Red")
    #g Place(50, 170)
    #g "\You guessed it!"
    #g "\";HangWord$
End Sub
 
Sub GameLose HangWord$
    #g Color("Red")
    #g Place(50, 170)
    #g "\You lose!"
    #g "\";HangWord$
End Sub
 
Sub HangWord text$
    #g Color("Black")
    x = 50
    For i = 1 to Len(text$)
        #g Place(x, 50)
        #g "\";Mid$(text$, i, 1)
        x = x + 20
    Next i
End Sub
 
Sub Alphabet Alpha$
    #g Color("Black")
    x = 10
    For i = 1 to Len(Alpha$)
        #g Place(x, 280)
        #g "\";Mid$(Alpha$, i, 1)
        x = x + 15
    Next i
End Sub
 
Sub Gallows
    #g Color("brown")
    #g Size(5)
    #g Line(150, 110, 150, 100)
    #g Size(10)
    #g Line(150, 100, 250, 100)
    #g Line(220, 100, 250, 130)
    #g Line(250, 100, 250, 250)
    #g Line(250, 220, 280, 250)
    #g Line(250, 220, 220, 250)
    #g Color("Green")
    #g Line(300, 250, 100, 250)
End Sub
 
Sub HangedMan1
    #g Color("blue")
    #g Size(4)
    #g Place(150, 125)
    #g Circle(15)
End Sub
 
Sub HangedMan2
    #g Color("blue")
    #g Size(5)
    #g Line(150, 140, 150, 190)
End Sub
 
Sub HangedMan3
    #g Color("blue")
    #g Size(5)
    #g Line(150, 160, 125, 140)
End Sub
 
Sub HangedMan4
    #g Color("blue")
    #g Size(5)
    #g Line(150, 160, 175, 140)
End Sub
 
Sub HangedMan5
    #g Color("blue")
    #g Size(5)
    #g Line(150, 190, 125, 230)
End Sub
 
Sub HangedMan6
    #g Color("blue")
    #g Size(5)
    #g Line(150, 190, 175, 230)
End Sub
 
Sub HangedMan7
    #g Color("gray")
    #g Size(7)
    #g Line(125, 115, 175, 115)
    #g Line(140, 110, 160, 110)
End Sub
 
Sub HangWord text$
    #g Color("Black")
    x = 50
    For i = 1 to Len(text$)
        #g Place(x, 50)
        #g "\";Mid$(text$, i, 1)
        x = x + 20
    Next i
End Sub
 
Function CorrectGuess$(HangWord$, GuessWord$, ltr$)
    CorrectGuess$ = ""
    For i = 1 to Len(HangWord$)
        If Mid$(lower$(HangWord$), i, 1) = Lower$(ltr$) Then
            CorrectGuess$ = CorrectGuess$;Mid$(HangWord$, i, 1)
        Else
            CorrectGuess$ = CorrectGuess$;Mid$(GuessWord$, i, 1)
        End If
    Next i
End Function
 
Function Alphabet$(Alpha$, ltr$)
    Alphabet$ = ""
    For i = 65 to 90
        If Mid$(Alpha$, i - 64, 1) = Upper$(ltr$) Then
            Alphabet$ = Alphabet$;Chr$(0)
        Else
            Alphabet$ = Alphabet$;Mid$(Alpha$, i - 64, 1)
        End If
    Next i
End Function
 
Function GetWord$(list$)
    words = 1
    while word$(list$, words) <> ""
        words = words + 1
    wend
    words = words - 1
 
    HangWord = Int(Rnd(1) * words) + 1
    GetWord$ = Word$(list$, HangWord)
End Function
 
function WordList$()
    list$ = "shoulder revenge grinder engraved larger garble calendar bravely"
    list$ = list$ + " delusion ultimate quality defect bruised toughest shampoo"
    WordList$ = list$ + " fumble removed multiply fixture gopher"
end function
 
function FileList$(fname$)
    minLength = 4
 
    if fname$ = "" then
        FileList$ = WordList$()
    else
        Letters$ = "abcdefghijklmnopqrstuvwxyz"
        Letters$ = Letters$; upper$(Letters$)
 
        open fname$ for input as #f
        while not(eof(#f)) and Found < 50
            input #f, oneWord$
 
            count = 1
            while word$(oneWord$, count) <> ""
                theWord$ = word$(oneWord$, count)
                if len(theWord$) > minLength then
                    if instr(FileList$, " "; theWord$; " ") = 0 then
                        FileList$ = FileList$; " "
                        for i = 1 to len(theWord$)
                            char$ = mid$(theWord$, i, 1)
                            if instr(Letters$, char$) > 0 then
                                FileList$ = FileList$; char$
                            end if
                        next
                        FileList$ = FileList$; " "
                        Found = Found + 1
                    end if
                end if
                count = count + 1
            wend
        wend
        close #f
        print "Found "; Found; " words longer than "; minLength; " letters."
    end if
end function


Comments or suggestions about this code? Use the discussion tab.
Thanks.