<%
'*******************************************************
'* Obs! Max 20 tecken får plats på bredden *
'*******************************************************
%>
<%' Begin functions declarations
'**********
' GetNewWord()
' Generates a random number from 1 to 212 which it uses to
' select a line from a textfile with 212 lines of words in it.
' It then retrieves the word, converts in to uppercase, and
' returns it as its return value.
'**********
Function GetNewWord()
Dim objFSO, objFile
Dim I
Dim iRandom
Dim strTemp
' Get a random number between 1 and 212 inclusive
Randomize()
iRandom = Int(212 * Rnd + 1)
'iRandom = 42 ' A word with a space = 3, with a - = 42
' Open file and get the line equal to the number generated
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Server.MapPath("hangman.txt"))
' Loop till line before the one we want
For I = 1 to iRandom - 1
objFile.SkipLine
Next
strTemp = UCase(objFile.ReadLine)
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
GetNewWord = strTemp
End Function ' GetNewWord()
'**********
' CalculateGuess(strWord)
' Takes the secret word as input. It checks to see if the
' word contains any spaces or dashes to include them in the
' guess since you can't guess space or dash. Returns a
' properly adjusted guess based upon the secret word.
'**********
Function CalculateGuess(strWord)
Dim strGuess
Dim I
strGuess = ""
If InStr(1, strWord, Chr(32), 1) Or InStr(1, strWord, Chr(45), 1) Then
For I = 1 to Len(strWord)
Select Case Asc(Mid(strWord, I, 1))
Case 32
strGuess = strGuess & " "
Case 45
strGuess = strGuess & "-"
Case Else
strGuess = strGuess & "_"
End Select
Next
Else
strGuess = String(Len(strWord), "_")
End If
CalculateGuess = strGuess
End Function ' CalculateGuess()
'**********
' CalculateGuess(strWord, strGuess, strLetter)
' Takes the secret word, the current state of the guess, and
' the guessed letter as input. It updates the guess to
' include all occurances of the guessed letter. It returns
' the guess containing the new letter. Only needs to be
' called when the letter is in the secret word.
'**********
Function UpdateGuess(strWord, strGuess, strLetter)
Dim strTemp
strTemp = ""
For I = 1 to Len(strWord)
If Mid(strWord, I, 1) = strLetter Then
strTemp = strTemp & strLetter
Else
strTemp = strTemp & Mid(strGuess, I, 1)
End If
Next
UpdateGuess = strTemp
End Function ' UpdateGuess()
' End functions declarations
%>
<%' Begin run-time code
Dim iDeath
Dim strWord, strGuess
Dim aLetters
Dim strLetter
Dim strTemp
Dim I
'Get all values from Session and QueryString for processing speed
iDeath = Session("Death")
strWord = Session("Word")
strGuess = Session("Guess")
aLetters = Session("LettersArray")
strLetter = Request.QueryString("letter")
' Get a new word and init variables if no guess or dead
' otherwise check letter submitted against array and secret word
If strLetter = "" or iDeath > 6 Then
strWord = GetNewWord()
strGuess = CalculateGuess(strWord)
iDeath = 0
aLetters = Array(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
Else
' Set Letter in array to checked
If 65 <= Asc(strLetter) AND Asc(strLetter) <= 90 Then
aLetters(Asc(strLetter) - 65) = 1
End If
' If letter guessed is in the secret word then update guess
' otherwise increase death amount by 1
If InStr(1, strWord, strLetter, 1) Then
strGuess = UpdateGuess(strWord, strGuess, strLetter)
Else
iDeath = iDeath + 1
End If
End If
' Display Gallows Image based on death amount
Response.Write "![]()
" & vbCrLf
' Debugging Outputs
'Response.Write "Word:" & strWord & vbCrLf & "
"
'Response.Write "Guess:" & strGuess & vbCrLf & "
"
'Output Guess using black letter images
For I = 1 to Len(strGuess)
If LCase(Mid(strGuess, I, 1)) = " " Then
Response.Write "![]() "
Else
Response.Write "![]() "
End If
Next
Response.Write "
" & vbCrLf
' Check to see if Dead. If so output sorry and display word.
' If not then check to see if the word is right. If so then
' output congrats. In both of these cases, set to dead so
' nothing weird happens if the come back or try and continue
' guessing manually.
' If neither of the above then output the alphabet letters
' so the player can continue guessing, but only letters they
' haven't yet clicked should be clickable, others are red.
If iDeath >= 6 Then
Response.Write "
Det rätta ordet var: " & LCase(strWord) & "
"
Response.Write "
Vill du spela igen? Ja Nej
"
Response.Write "
Vill du pröva ett annat Lundell-spel? Fortsätt till Uffememory, Lundellfrågesport eller Möblera om
"
iDeath = 7
Else
If strGuess = strWord Then
Response.Write "
"
Response.Write "
Vill du spela igen? Ja Nej
"
Response.Write "
Vill du pröva ett annat Lundell-spel? Fortsätt till Uffememory, Lundellfrågesport eller Möblera om
"
iDeath = 7
Else
' Loop through alphabet Chr(65) = A and Chr(90)=Z
For I = 65 to 77
If aLetters(I - 65) = 0 Then
Response.Write "![]() "
Else
Response.Write "![]() "
End If
Next
Response.Write "
" & vbCrLf
For I = 78 to 90
If aLetters(I - 65) = 0 Then
Response.Write "![]() "
Else
Response.Write "![]() "
End If
Next
Response.Write "
" & vbCrLf
End If
End If
' Put all values back into Session for storage
Session("Death") = iDeath
Session("Word") = strWord
Session("Guess") = strGuess
Session("LettersArray") = aLetters
%>
|
|