Hangman

[TonyMUK]

Just thought I would share this with anyone who wants it. It's very basic but it is only my fourth ebasic program and is the first with any kind of graphics.
Any comments welcome.

[aurelCB]

Hi Tony your program dont want restart?

[TonyMUK]

There is a problem with it losing focus and then not wanting to play that I am looking at. I'll post the new version when I have fixed it. I only wrote it for my Daughter to play around with so it is not perfect.

[Copex]

Hi

Hope you don't mined, i have made a small change to the code :-)

Code Select Expand


/*
* Program Hangman
* Written by Tony Moran
* Date written 17th October 2008
* Description Just fancied having a go at writing a simple game
* for the kids to try out.
*/

$MAIN

'*************************************************************************
' Field definitions
'*************************************************************************

String NewWord,a$, Lines
IString CheckWord[20]
Int EndProgram, Length, Count, NextBit, Record, NoOfrecs, WonGame
Window w1

'*************************************************************************
' File definitions
'*************************************************************************

File Words

'*************************************************************************
' Start of program
'*************************************************************************

' Open window, center it and add Menu

OpenWindow w1,0,0,370,395,@MINBOX,NULL,"Hangman",&w1_handler

CENTERWINDOW w1

BEGINMENU w1
MenuTitle "&File"
MenuItem "&Restart",0,2
MenuItem "&Close",0,1
ENDMENU

' Attach screen for graphics

AttachScreen(w1,370,395,1)

Flip 1

' Open File

Error = OpenFile(Words,"words.txt","R")

' Read through file to count number of words available

NoOfrecs = 0

While EOF(Words) = 0
Error = READ(Words,NewWord)
If Error = 0 THEN
NoOfRecs ++
ENDIF
EndWhile

' Close File

CloseFile Words

' Get random word

ChooseWord(NewWord)

' Set man to not displayed

NextBit = 0

' Display text

MOVE w1,130,0

PRINT w1,"Guess the word"
alphabet()
' Create number of underlines for letters in word

DrawLines(NewWord)

' Draw any parts of the man that should be shown

DrawMan()

' Run forever

run=1
WAITUNTIL run = 0

END

'*************************************************************************
' Restart routine
'*************************************************************************

SUB Restart()

' Choose new word

ChooseWord(NewWord)

' Attach screen for graphics

AttachScreen(w1,370,395,1)

' Clear man from screen

ClearMan()

' Clear any text from screen

ClearText()

' Reset man parts

NextBit = 0

' Display text

MOVE w1,130,0

PRINT w1,"Guess the word"

' Create number of lines for number of letters in the word

DrawLines(NewWord)

' Draw any parts of the man

DrawMan()

ENDSUB

'*************************************************************************
' Choose a new word
'*************************************************************************

SUB ChooseWord(NewWord as String)

' Open the File

Error = OpenFile(Words,"words.txt","R")

' Select a random record

Record = RAND(NoOfRecs) + 1

' Read up to the record chosen

For Count = 1 to Record
Error =  Read(Words,NewWord)
Next Count

' Clear word check field

For Count = 1 to 20

CheckWord[Count] = " "
Next Count

' Close the File

CloseFile Words

WonGame = 0

Return

ENDSUB

'*************************************************************************
' Display the correct number of underlines for the length of the word
'*************************************************************************

SUB DrawLines(WordToGuess as String)

' Get length of word

Length = Len(NewWord)

' Clear field

Lines = ""

' Set correct count to 0

Count2 = 0

' Loop through the word and display the appropriate character

For Count = 1 to Length
If CheckWord[Count] = " " Then
Lines = Lines + "_ "
ELSE
Lines = Lines + CheckWord[Count] + " "
Count2 ++
Endif
Next Count

' If correct count is same as word length then whole word correct

If Count2 = Length
YouWin()
ENDIF

' Display underlines

Move w1,130,20

Print w1,Lines

ENDSUB

'*************************************************************************
' Check letter pressed
'*************************************************************************

SUB CheckEntry()

' Get length of word

Length = LEN(NewWord)

' Set found flag off

Found = 0

' Loop through word checking for letter pressed

For Count = 1 to Length
If Ucase$(Mid$(NewWord,Count,1)) = a$
CheckWord[Count] = a$
Found = 1
ENDIF
Next Count

' If not found then add a body part

If Found = 0 THEN
NextBit ++
Endif

' Close the screen and re-attach it

CLOSESCREEN

AttachScreen(w1,370,395,1)

' Display the text

MOVE w1,130,0

PRINT w1,"Guess the word"

' Draw the underlines

DrawLines(NewWord)

' Draw the man

DrawMan()

Return

ENDSUB

Sub DrawMan()

' Set to solid drawing

DrawMode(w1,@OPAQUE)

' Draw Floor

If NextBit >= 1 THEN
Line w1,140,180,200,180,RGB(255,0,0)
Endif

' Draw upright

If NextBit >= 2 THEN
Line w1,160,180,160,80,RGB(255,0,0)
ENDIF

' Draw brace

If NextBit >= 3 THEN
Line w1,160,100,180,80,RGB(255,0,0)
ENDIF

' Draw horizontal

If NextBit >= 4 THEN
Line w1,160,80,200,80,rgb(255,0,0)
ENDIF

' Draw rope

If NextBit >= 5 THEN
Line w1,200,80,200,100,RGB(255,0,0)
ENDIF

' Draw head

If NextBit >= 6 THEN
Circle w1,200,110,10,RGB(255,0,0)
ENDIF

' Draw body

If NextBit >= 7 THEN
Line w1,200,120,200,140,RGB(255,0,0)
ENDIF

' Draw left arm

If NextBit >= 8 THEN
Line w1,200,130,190,125,RGB(255,0,0)
ENDIF

' Draw right arm

If NextBit >= 9 THEN
Line w1,200,130,210,125,RGB(255,0,0)
ENDIF

' Draw left leg

If NextBit >= 10 THEN
Line w1,200,140,190,160,RGB(255,0,0)
ENDIF

' Draw right leg

If NextBit >= 11 THEN
Line w1,200,140,210,160,RGB(255,0,0)
ENDIF

' If all body parts displayed then lose

If NextBit >= 11 THEN
YouLose()
Endif

ENDSUB

'*************************************************************************
' Word correct
'*************************************************************************

Sub YouWin()

' Display winning text

Move w1,100,200
Print w1,"CONGRATULATIONS!! YOU WIN"
Move w1,100,220
Print w1,"Select File, Restart for another go"

WonGame = 1

EndSub

'*************************************************************************
' Clear man from screen by drawing him again in white
'*************************************************************************

Sub ClearMan()

DrawMode(w1,@OPAQUE)

Line w1,140,180,200,180,RGB(255,255,255)
Line w1,160,180,160,80,RGB(255,255,255)
Line w1,160,100,180,80,RGB(255,255,255)
Line w1,160,80,200,80,rgb(255,255,255)
Line w1,200,80,200,100,RGB(255,255,255)
Circle w1,200,110,10,RGB(255,255,255)
Line w1,200,120,200,140,RGB(255,255,255)
Line w1,200,130,190,125,RGB(255,255,255)
Line w1,200,130,210,125,RGB(255,255,255)
Line w1,200,140,190,160,RGB(255,255,255)
Line w1,200,140,210,160,RGB(255,255,255)

ENDSUB

'*************************************************************************
' Clear text by printing blanks over it
'*************************************************************************

Sub ClearText()

Move w1,100,200
Print w1,"                                                            "
Move w1,100,220
Print w1,"                                                            "
Move w1,130,20
Print w1,"                                                            "
Move w1,40,270
Print w1,"                                                                "


EndSub

'*************************************************************************
' Lost
'*************************************************************************

Sub YouLose()

' Display losing text

Move w1,100,200
Print w1,"OH DEAR!! You Lost"
Move w1,100,220
Print w1,"Select File, Restart for another go"

EndSub

'*************************************************************************
' Window handler
'*************************************************************************

' addeded by Copex shows alphabet

sub alphabet()
int xpoz,ypox
xpoz = 40
ypoz = 250

for a = 65 to 90
move w1,xpoz,ypoz
print w1,chr$(a)
xpoz = xpoz + 10

next a
ENDSUB

' addeded by Copex shows what letter have been guessed.
SUB hguess(a$ as string)
int xxpoz,yypoz
xxpoz = (asc(a$)-65)*10+40
yypoz = 270

move w1,xxpoz,yypoz
print w1,chr$(asc(a$)+32)

RETURN
ENDSUB



SUB w1_handler

' Select messages

SELECT @MESSAGE

' If window closed then end program

CASE @IDCLOSEWINDOW
CLOSEDIALOG w1,@IDOK
END

' no controls used so nothing here

CASE @IDCONTROL
SELECT @CONTROLID
ENDSELECT

' Menu handler

CASE @IDMENUPICK
Select @MENUNUM

' Option 1 is close program so End

CASE 1
END

' Option 2 is restart so call restart routine

CASE 2
Restart()
EndSelect

' Character pressed

CASE @IDCHAR

' Convert pressed character to upper case

a$=Ucase$(GetKey)

' If alphabetic character then check character pressed

If a$ >= "A" And a$ <= "Z" And NextBit < 11 And WonGame = 0 Then
hguess(a$)
CheckEntry()
Endif

ENDSELECT
RETURN
ENDSUB



[TonyMUK]

Don't mind at all. It's all about sharing and learning.

[pistol350]

Just a few suggestions in case you would plan on rewriting your code.

First is that you did not really need to use 2D in this program (=> Attachscreeen, flip,...) as you only do basic primitive drawings (only line drawing).
2D would be useful if for instance you used sprites or if your program did fast drawing operations.

Second would be for a future version of your program 
To try to use a dictionary.txt file as words container to cut the limit of the number of words that may be picked. we will be glad to provide help if you ever got stuck.
You can find this file all over the internet.

or just take this one attached here.

Hope my suggestions helped.

[TonyMUK]

Thanks for that. Didn't realise I didn't need to attach a screen. Thanks for the dictionary.txt file. Saves me having to type a load of word in. This is one of the reasons I love ebasic. Everyone is so helpful and willing to make suggestions to make things better.

[Rock Ridge Farm (Larry)]

The dictionary file only goes to the letter 'u'.

[pistol350]

Hi Larry.

Indeed i got the same result as you.
Quite strange as at home i was sure to have a complete dictionary file.
I'll have another look when i'm back home tonight.

By the way, for those who want that file you'll just have to google "dictionary.txt" and you'll find it from many different places in the internet.

[pistol350]

The File i have at home is complete as expected.
It seems that something happened to the text file when uploaded.
I zipped it and attached it to that post