Sorry your browser is not supported!

GLOBAL word$
RANDOMIZE TIMER()

FOR a = 1 TO 10
    RESTORE
    ThinkOfWord()
    PRINT word$
NEXT a

WAIT KEY
END

FUNCTION ThinkOfWord()
    DATA "london","amsterdam","deventer","twello"
    DATA "almere","rotterdam","sydney","liverpool"
    DATA "singapore","maastricht","amersfoort","bogota"
    DATA "tunis","cairo","berlijn","copenhagen"
    DATA "bonn","praag","lissabon","ankara"
    
    num = RND(19)+1
    FOR c = 1 TO num
        READ word$
    NEXT c
ENDFUNCTION

`Game: HangMan, Entry By: HeavyAmp for The Little Book of Source Code Game Competition

`Set the Games Screen Resolution
Set Display Mode 800,600,32

`Create a User Defined Type For Our Letters Array
Type Character
   Letter as String
   Found  as Boolean
EndType


GetListofWords()
PickWord()
SeparateWordtoLetters()

`Create an Array to hold all the letters the player has already picked
Dim GuessedLetters(0) as String

`Stores the letter the player wishes to guess
Global aLetter as String

`Stores the Word the player wishes to guess
Global aWord   as String

`Stores the amount of wrong guesses the player has made
Global Mistake as Integer : Mistake=0

`Stores which menu the player is viewing
Global Menu as Integer : Menu=1

Do
   cls

   ShowCurrentWord()
   DrawHangMan()
   ShowGuessedLetters()
   CheckforWin()

   If Menu=1 then MenuChoice()
   If Menu=2 then GuessLetter()
   If Menu=3 then GuessWord()
   If Menu=4 then Win()
   If Menu=5 then Loose()

   `If the player has made more than 10 mistakes then switch to the loose menu
   If Mistake=10 then Menu=5

Loop



Function GetListofWords()

   `Create an Array to hold all the words used by our game
   Dim GameWords(-1) as String

   `Read In Our Words for Our Game from the Data Statement
   `and store them in the GameWords array
   Local aWord     as String
   Local ArraySize as Integer

   Do

      Read aWord
      If aWord<>"STOP"
         Array Insert at Bottom GameWords()
         ArraySize = Array Count(GameWords())
         GameWords(ArraySize) = aWord
      Else
         Exit
      EndIf

   Loop

EndFunction


Function PickWord()

   `Choose a Random Word from our GameWords Array
   Global ChoosenWord as String
   Local  ArraySize   as Integer

   Randomize Timer()

   ArraySize=Array Count(GameWords())
   ChoosenWord = GameWords(Rnd(ArraySize))

EndFunction


Function SeparateWordtoLetters()

   `Get the Length of Our Choosen Word
   Global WordLength as Integer
   WordLength=Len(ChoosenWord)

   `Create an Array to hold all the letters of Our choosen word
   Dim Letters(WordLength) as Character

   `Insert the Words Letters into the array and Set them to Not found
   For CharNumber=1 to WordLength

      Letters(CharNumber).Letter = MID$(ChoosenWord,CharNumber)
      Letters(CharNumber).Found  = 0

   Next CharNumber

EndFunction

Function ShowCurrentWord()


   `Loop through the array that holds all the letters in our word and
   `if the letter has not been found print a Underscore If the letter
   `Has been found then print the letter

   Ink RGB(255,255,255),1

   For CharNumber=1 to WordLength

      Set Cursor 0,Screen Height()-120 : Print "Word:"

      If Letters(CharNumber).Found=0
         Set Cursor (CharNumber*20)+30,Screen Height()-120 : Print "_"
      EndIf

      If Letters(CharNumber).Found=1
         Set Cursor (CharNumber*20)+30,Screen Height()-120 : Print Letters(CharNumber).Letter
      EndIf

   Next CharNumber

EndFunction

Function MenuChoice()

    `Create a border for the menu
   Ink RGB(255,255,255),1 : Box 400,50,750,200 : Ink RGB(0,0,0),1 : Box 401,51,749,199

   `Show the player the options in the menu
   Ink RGB(255,255,255),1
   Set Cursor 500,60 : Print "Make a Guess:"
   Set Cursor 450,100 : Print "(1) Guess a Letter"
   Set Cursor 450,120 : Print "(2) Guess the Word"

   `Change the menu acording to which number the player has pressed
   If Scancode()=2 then Menu=2 : CLEAR ENTRY BUFFER
   If Scancode()=3 then Menu=3 : CLEAR ENTRY BUFFER

EndFunction


Function GuessLetter()

    `Create Border for Instructions
   Ink RGB(255,255,255),1 : Box 400,50,750,200 : Ink RGB(0,0,0),1 : Box 401,51,749,199

   Ink RGB(255,255,255),1
   Set Cursor 425,60 : Print "Guess a Letter then Press Enter"

   `Make Sure that our letter variable wont read the  Enter,tab or Space key as a Letter
   If len(aLetter)<1
      If ReturnKey()=1 or SpaceKey()=1 or ScanCode()=15 then CLEAR ENTRY BUFFER
   EndIf

   `Make sure only one character is in our string
   If len(aLetter)<1 then aLetter=ENTRY$(1)

   `Make sure we can use the backspace key to delete
   If Scancode()=14 then CLEAR ENTRY BUFFER : aLetter=ENTRY$(1)

   `Make Sure no numbers are entered since we use numbers to change from each menu system
   If val(aLetter)>0 and val(aLetter)=<9 then CLEAR ENTRY BUFFER : aLetter=ENTRY$(1)

   `Make Sure Our Letter is in Capitals
   aLetter=Upper$(aLetter)

   `Show What letter we have entered
   Set Cursor 450,100 : Print "Letter: " , aLetter

   `If player presses enter they subit their Letter
   If Len(aLetter)=1 and ReturnKey()=1

      Local AlreadyGuessed as Integer

      `Add to guess letters and make sure it hasn't been guessed before
      AlreadyGuessed=AddtoGuessedLetters(aLetter)

      `If the letter hasnt been guessed then check if the letter is in the word and change the menu
      `and clear our input buffer for the next guess
      If AlreadyGuessed=0
         CheckForLetters(aLetter)
         Menu=1
         CLEAR ENTRY BUFFER : aLetter=ENTRY$(1)
      EndIf

   EndIf

EndFunction


Function GuessWord()

    `Create a border for the Menu
   Ink RGB(255,255,255),1 : Box 400,50,750,200 : Ink RGB(0,0,0),1 : Box 401,51,749,199

   Ink RGB(255,255,255),1
   Set Cursor 425,60 : Print "Guess the Word then Press Enter"

   `Make Sure that our Word variable wont read the  Enter,tab or Space key as a Letter
   `For the first character
   If len(aWord)<1
      If ReturnKey()=1 or SpaceKey()=1 or ScanCode()=15 then CLEAR ENTRY BUFFER
   EndIf

   `Give the word a limit of 25 characters long
   If len(aWord)<25 then aWord=ENTRY$(1)

   `Make sure we can use the backspace key to delete the word
   If Scancode()=14 then CLEAR ENTRY BUFFER : aWord=ENTRY$(1)

   `Make Sure no numbers are entered since we use numbers to change from each menu system
   If val(aWord)>0 and val(aWord)=<9 then CLEAR ENTRY BUFFER : aWord=ENTRY$(1)

   `Show What letter we have entered
   Set Cursor 450,100 : Print "Letter: " , Upper$(aWord)

   `Make Sure the Word is in Capitals
   aWord=Upper$(aWord)

   `If player presses enter and they have at least one letter they subit their Word.
   If Len(aWord)>1 and ReturnKey()=1

      Local Correct as Boolean
      Correct=CheckWord(aWord)

      If Correct=0 then Menu=1
      If Correct=1 then  ShowCurrentWord() : Menu=4

   EndIf

EndFunction


Function AddtoGuessedLetters(NewLetter as String)

   Local ArrayPosition as Integer
   Local AlreadyGuessed as Integer

   `Check If we have already Guessed that Letter
   For CharNumber=1 to Array Count(GuessedLetters())

      If GuessedLetters(CharNumber) = NewLetter then AlreadyGuessed=1

   Next CharNumber


   `Add our New Letter to the GuessedLetters array if it hasn't been guessed already
   If AlreadyGuessed=0
      Array Insert at Bottom GuessedLetters()
      ArrayPosition=Array Count(GuessedLetters())
      GuessedLetters(ArrayPosition)=NewLetter
   EndIf

EndFunction AlreadyGuessed

Function CheckForLetters(NewLetter as String)

   `Search Through the letters in our Word and When one of the letters is the
   `same as the one we have choosen change the letter to revealed
   Local LetterinWord as Boolean : LetterinWord=0

   For CharNumber=1 to WordLength

      If Letters(CharNumber).Letter=NewLetter then Letters(CharNumber).Found=1 : LetterinWord=1

   Next CharNumber

   `If the letter that the player has guessed is not in the word then add it to the mistakes the
   `that the player has made
   If LetterinWord=0 then Mistake=Mistake+1

EndFunction

Function ShowGuessedLetters()

   `Scroll through the array of all the letters the player has guessed
   `and then print them on the screen for the player to see

   Ink RGB(255,255,255),1
   Set Cursor 0,Screen Height()-60 : Print "Guessed Letters:"

   For CharNumber=1 to Array Count(GuessedLetters())

      Set Cursor 120+(CharNumber*20),Screen Height()-60
      Print GuessedLetters(CharNumber), ","

   Next CharNumber

EndFunction


Function CheckWord(NewWord as String)

   `Check if the Players Guessed word equals the Correct Word if so
   `Then reveal all the letters to the player

   Local Correct as Boolean

   If ChoosenWord<>NewWord then Correct=0 : Mistake=Mistake+1

   If ChoosenWord=NewWord

      For CharNumber=1 to WordLength
         Letters(CharNumber).Found=1
      Next CharNumber

      Correct=1

   EndIf

EndFunction Correct

Function CheckforWin()

   `Check if the player has guessed all the letters correctly

  Local UnGuessed as Boolean

   For CharNumber=1 to WordLength
      If Letters(CharNumber).Found=0 then UnGuessed=1
   Next CharNumber

   If UnGuessed=0 then Menu=4

EndFunction


Function Win()

    `Create Border for Menu
   Ink RGB(255,255,255),1 : Box 400,50,750,200 : Ink RGB(0,0,0),1 : Box 401,51,749,199

   Ink RGB(255,255,255),1
   Set Cursor 450,90 : Print "Congratulations You Win!"
   Wait 2000
   Wait Key
   End

EndFunction


Function Loose()

    `Create Border for Menu
   Ink RGB(255,255,255),1 : Box 400,50,750,200 : Ink RGB(0,0,0),1 : Box 401,51,749,199

   Ink RGB(255,255,255),1
   Set Cursor 425,120 : Print "Sorry You Loose :("

   Wait 2000
   Wait Key
   End

EndFunction

Function DrawHangMan()

   `Create Border for Hangman
   Ink RGB(255,255,255),1 : Box 50,50,300,300 : Ink RGB(0,0,0),1 : Box 51,51,299,299
   Ink RGB(255,255,255),1
   If Mistake =<9 then Set Cursor 150,60 : Print "HangMan"
   If Mistake >9  then Set Cursor 150,60 : Print "YOU LOOSE!"

   `Keep on drawing the HangMan as the amount of mistakes increases
   If Mistake>0 then Line 100,280,200,280
   If Mistake>1 then Line 150,280,150,120
   If Mistake>2 then Line 150,120,230,120
   If Mistake>3 then Line 230,120,230,180
   If Mistake>4 then Circle 230,185,6
   If Mistake>5 then Line 230,191,230,220
   If Mistake>6 then Line 230,200,210,200
   If Mistake>7 then Line 230,200,250,200
   If Mistake>8 then Line 230,220,215,240
   If Mistake>9 then Line 230,220,245,240

EndFunction

RemStart
This Is all our the Words our hangman game can choose from, Simply Enter more words to
give the game a greater selection. Note: The Word STOP at the End of the data statement
Wont be Used, It tells the game to stop reading data so make sure you have all your new
words before the word STOP. Also make sure your words are equal to or less than 25
characters in length.
RemEnd

Data "ELEPHANT" ,"HOUSE" , "DINOSAUR" , "CODE" , "COMPUTER" , "PEDIATRICIAN", "STOP"

RESTORE _CAPITALS `skip down to data items 4-6

for y = 1 to 3
   read capital$
   set cursor 0,(y*20)
   print capital$
next y

RESTORE _COUNTRIES `jump back up to data items 1-3.  

for y = 1 to 3
   read country$
   set cursor 60,(y*20)
   print country$
next y

wait key


_COUNTRIES:

data "Brazil", "Japan", "Greece"

_CAPITALS:

data "Brasília", "Tokyo", "Athens"