YAH (Yet Another Hangman)

Post by **JanetTerra** » Mon May 07, 2007 3:37 am

This Hangman is a conversion from the Run BASIC example to Just BASIC at a user's request. No file to download. Just copy and paste.

Code: Select all

' Hangman by Janet Terra
 ' Released to Public Doman 5/6/07

    Nomainwin

    Dim GameInfo$(10)
'   GameInfo$(1) = HangWord$
'   GameInfo$(2) = GuessWord$
'   GameInfo$(3) = Alpha$
'   GameInfo$(4) = Str$(nWrongGuesses)
'   GameInfo$(5) = Str$(GameMode)
'       GameMode = 1 ' Waiting for Keypress / Mouseclick
'       GameMode = 2 ' Game Won
'       GameMode = 3 ' Game Lost
    WindowWidth = 420
    WindowHeight = 400
    UpperLeftX = Int((DisplayWidth - WindowWidth) /2)
    UpperLeftY = Int((DisplayHeight - WindowHeight) /2)

    Open "Hangman" for Graphics_nsb_nf as #g
    #g, "Down; Trapclose XbyTrap"

    Call Gallows
    #g, "Discard; Getbmp HangScreen 0 0 420 400"
    #g, "Drawbmp HangScreen 0 0; Flush"
    Call NewGame "#g", ""

Wait

Sub XbyTrap handle$
    Unloadbmp "HangScreen"
    Unloadbmp "HangWord"
    Close #g
    End
End Sub

Sub NewGame handle$, char$
    #g, "Cls; Drawbmp HangScreen 0 0"
    HangWord$ = HangWord$()
    GameInfo$(1) = HangWord$
    GuessWord$ = ""
    For i = 1 to Len(HangWord$)
        GuessWord$ = GuessWord$;"_"
    Next i
    GameInfo$(2) = GuessWord$
    Call HangWord GuessWord$
    Alpha$ = ""
    For i = 65 to 90
        Alpha$ = Alpha$;Chr$(i)
    Next i
    GameInfo$(3) = Alpha$
    Call Alphabet Alpha$
    nWrongGuesses = 0
    GameInfo$(4) = Str$(nWrongGuesses)
    #g, "Discard; GetBmp HangWord 0 0 420 400"
    #g, "Drawbmp HangWord 0 0; Flush"
    GameMode = 1
    GameInfo$(5) = Str$(GameMode)
    #g, "When characterInput KeyPress"
    #g, "Setfocus"
End Sub

Sub KeyPress handle$, char$
    key$ = Upper$(Right$(char$, 2))
    key = Asc(key$)
    Select Case
        Case key = 27
            Call XbyTrap "#g"
        Case key < 65
            #g, "Setfocus"
            Exit Sub
        Case key > 90
            #g, "Setfocus"
            Exit Sub
    End Select
    HangWord$ = GameInfo$(1)
    GuessWord$ = GameInfo$(2)
    Alpha$ = GameInfo$(3)
    Alpha$ = Alphabet$(Alpha$, key$)
    nWrongGuesses = Val(GameInfo$(4))
    If Instr(HangWord$, Lower$(key$)) Then
        GuessWord$ = CorrectGuess$(HangWord$, GuessWord$, key$)
        GameInfo$(2) = GuessWord$
    Else
        nWrongGuesses = nWrongGuesses + 1
        GameInfo$(4) = Str$(nWrongGuesses)
    End If
    Select Case nWrongGuesses
        Case 1
            Call HangedMan1
        Case 2
            Call HangedMan2
        Case 3
            Call HangedMan3
        Case 4
            Call HangedMan4
        Case 5
            Call HangedMan5
        Case 6
            Call HangedMan6
    End Select
    Call Alphabet Alpha$
    GameInfo$(3) = Alpha$
    Call HangWord GuessWord$
    Unloadbmp "HangWord"
    #g, "Getbmp HangWord 0 0 420 400"
    #g, "Cls; Drawbmp HangWord 0 0; Flush"
    If Instr(GuessWord$, "_") = 0 Then
        Call GameWin HangWord$
    End If
    If nWrongGuesses = 7 Then
        Call HangedMan7
        Call GameLose HangWord$
    End If
End Sub

Sub GameWin HangWord$
    #g, "Place 30 170"
    #g, "Color Darkgray"
    #g, "\You guessed it!"
    #g, "Color Red"
    #g, "\";HangWord$
    Unloadbmp "HangWord"
    #g, "Getbmp HangWord 0 0 420 400"
    #g, "Cls; Drawbmp HangWord 0 0; Flush"
    GameMode = 2
    GameInfo$(5) = Str$(GameMode)
    #g, "When characterInput NewGame"
End Sub

Sub GameLose HangWord$
    #g, "Place 30 170"
    #g, "Color Darkgray"
    #g, "\You lose!"
    #g, "Color Red"
    #g, "\";HangWord$
    Unloadbmp "HangWord"
    #g, "Getbmp HangWord 0 0 420 400"
    #g, "Cls; Drawbmp HangWord 0 0; Flush"
    GameMode = 3
    GameInfo$(5) = Str$(GameMode)
    #g, "When characterInput NewGame"
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; Size 5"
    #g, "Line 150 110 150 100"
    #g, "Size 10"
    #g, "Line 150 100 250 100"
    #g, "Line 250 100 250 250"
    #g, "Line 275 250 125 250"
End Sub

Sub HangedMan1
    #g, "Color Blue; Size 4"
    #g, "Place 150 125"
    #g, "Circle 15"
End Sub

Sub HangedMan2
    #g, "Color Blue; Size 5"
    #g, "Line 150 140 150 190"
End Sub

Sub HangedMan3
    #g, "Color Blue; Size 5"
    #g, "Line 150 160 125 140"
End Sub

Sub HangedMan4
    #g, "Color Blue; Size 5"
    #g, "Line 150 160 175 140"
End Sub

Sub HangedMan5
    #g, "Color Blue; Size 5"
    #g, "Line 150 190 125 230"
End Sub

Sub HangedMan6
    #g, "Color Blue; Size 5"
    #g, "Line 150 190 175 230"
End Sub

Sub HangedMan7
    #g, "Color Darkgray; Size 7"
    #g, "Line 125 115 175 115"
    #g, "Line 140 110 160 110"
End Sub

Sub HangWord text$
    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$(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$, key$)
    Alphabet$ = ""
    For i = 65 to 90
        If Mid$(Alpha$, i - 64, 1) = Upper$(key$) Then
            Alphabet$ = Alphabet$;Chr$(0)
        Else
            Alphabet$ = Alphabet$;Mid$(Alpha$, i - 64, 1)
        End If
    Next i
End Function

Function HangWord$()
    list$ = "shoulder revenge grinder engraved larger garble calendar bravely delusion ultimate quality defect bruised toughest shampoo fumble removed multiply fixture gopher"
    HangWord = Int(Rnd(1) * 20) + 1
    HangWord$ = Word$(list$, HangWord)
End Function

The HangWord$() function could just as easily open up a text file and choose a random word from that list.