Hangman

Hangman
1169392055

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.

code format="vbnet" ' 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 code

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