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.
Hi Tony your program dont want restart? ???
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.
Hi
Hope you don't mined, i have made a small change to the code :-)
/*
* 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
Don't mind at all. It's all about sharing and learning.
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.
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.
The dictionary file only goes to the letter 'u'.
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.
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