'                               H A N G M A N
'                               �������������
'
'                    By Keith Koshman (AKA Guardian Bob)
'
'                       (c) 1997, 1998 KeiProductions
'        That means NO copying my code and putting your name on it!     
'
'  Well, this is my Hangman game. Nothing that fancy, but hey, it's one of
'   my first games. I took my very, very first version I made in 1997 and
'  updated it with text effects and SUB's, and an easier-to-use interface.
'
'                                 *   *   *
'
'                        This was made in QBasic 1.1
'
'                 NOW PRESS SHIFT - F5 TO START IT ALREADY!
'
'�����������������������������������������������������������������������������

DEFINT A-Z  'Well, speed up the game..I mean, who needs decimal places?!

DECLARE SUB centertype (row!, text$)
DECLARE SUB colorandom ()
DECLARE SUB drawhang ()
DECLARE SUB pause (Seconds!)
DECLARE SUB typeit (text$)
DECLARE SUB wipe ()

SCREEN 12  'Hmmm...this was the hard part. I didn't choose SCREEN 13 because
           'the text was only 40 columns wide, only allowing 20 characters in
           'a phrase. SCREEN 0 was a good choice, but had no graphics. Since
           'I had started out in SCREEN 12 in my original, I stuck with it.

snd = 1  'Sound - 1/On, 2/Off, change this to what you want to start out with,
         'although you can always change it using the option menu.

pi# = 22 / 7  'For making half-circles

mainmenu:
used$ = ""     'The used letters, cleared because of previous games
phrase$ = ""   'The phrase, also cleared because of previous games
triesleft = 6  'Number of tries left before you lose - DON'T CHANGE THIS!

CLS

pause .5  'Pause shortly because SCREEN 12 takes a moment to load

drawhang  'See the SUB drawhang, basically it draws the hangman stand.

menu$(1) = "1) Egy r�sztvev�s j�t�k ind�t�sa"
menu$(2) = "2) K�t r�sztvev�s j�t�k ind�t�sa"
menu$(3) = "3) Opci�k megjelen�t�se/megv�ltoztat�sa"
menu$(4) = "4) Kil�p�s a Hangman-b�l"

LOCATE 28, 10: COLOR 7: PRINT "Magyarra ford�totta Baranyi P�ter 2004-ben";
LOCATE 29, 10: COLOR 7: PRINT "Hangman (C) 1998 KeiProductions";

'Hey, are you still reading this code? I doubt if it will help you; I wrote
'it in a pretty messy manner, however if it teaches you something, great!  :)

ttext$ = "H  A  N  G  M  A  N": n = 9
colorandom  'See colorandom SUB - gets a random bright color

FOR letters = 1 TO LEN(ttext$) STEP 3                       'Drop
 FOR drop = 1 TO 8                                          '
 LOCATE drop, n + letters: PRINT MID$(ttext$, letters, 1);  'the
 FOR p = 1 TO 10000: NEXT p                                 '
 LOCATE drop, n + letters: PRINT " ";                       'Hangman
 NEXT drop                                                  '
 LOCATE drop, n + letters: PRINT MID$(ttext$, letters, 1);  'text
NEXT letters                                                '

z = 9: ON TIMER(1) GOSUB colorchange  'The color-changing border!!!
TIMER ON

COLOR 15
FOR sm = 1 TO 4
 FOR typet = 1 TO LEN(menu$(sm))
 LOCATE sm + 10, 9 + typet: COLOR 7: PRINT MID$(menu$(sm), typet, 1);
 FOR p = 1 TO 10000: NEXT p
 LOCATE sm + 10, 9 + typet: COLOR 15: PRINT MID$(menu$(sm), typet, 1);
 FOR p = 1 TO 5000: NEXT p
 NEXT typet
NEXT sm

getmainchoice:
board$ = INKEY$
IF board$ = "" THEN GOTO getmainchoice         'Loop until a key is pressed.
IF board$ = "1" THEN GOTO oneplay              'If it's the 1 key...
IF board$ = "2" THEN GOTO twoplay              'If it's the 2 key...
IF board$ = "3" THEN GOTO options              'If it's the 3 key...
IF board$ = "4" THEN TIMER OFF: GOTO finished  'If it's the 4 key...
GOTO getmainchoice                             'If it's none of them...

options:                                       'OPTIONS
                                               'branch...
colorandom

ttext$ = "O  P  C  I  O  K": n = 9

FOR a = 1 TO LEN(ttext$)                       'Make the OPTIONS text
LOCATE 17, 2: PRINT RIGHT$(ttext$, a)          '"move in" from behind
FOR p = 1 TO 8000: NEXT p                      'the border...
NEXT a

FOR m = 2 TO 9                                 'Then move it
LOCATE 17, m: PRINT ttext$;                    'across so it
FOR p = 1 TO 8000: NEXT p                      'lines up with
LOCATE 17, m: PRINT STRING$(LEN(ttext$), 255)  'the HANGMAN
NEXT m                                         'text...
LOCATE 17, m: PRINT ttext$;

redrawit:
IF snd = 1 THEN snd$ = "BE" ELSE snd$ = "KI"
LOCATE 19, 10: COLOR 15: PRINT "1) Hang/Zene: "; snd$; " "
LOCATE 21, 10: PRINT "Nyomd meg az 1-es gombot a hang/zene be/kikapcsol�s�hoz"
LOCATE 22, 10: PRINT "Nyomd meg az ESC gombot, hogy visszat�rj a f�men�be"

geto:
z$ = INKEY$
IF z$ = "" THEN GOTO geto
IF z$ = "1" THEN                        'If 1 is pressed...
 IF snd = 1 THEN snd = 0 ELSE snd = 1   'Switch between sound off/on
 GOTO redrawit
END IF
IF z$ = CHR$(27) THEN                   'If Esc is pressed...
 FOR down = 250 TO 350                  '
  LINE (2, down)-(400, down), 0         'Erase options text
  FOR p = 1 TO 4000: NEXT p             '
 NEXT down                              '
 GOTO getmainchoice                     'Return to Main Menu
END IF
GOTO geto

oneplay:                                'ONE PLAYER branch...

'You can make your own phrases easy. Just add on to the DATA statements and
'make sure you change the NumberOfPhrases variable to include the new phrases.
'And the phrases can only be 38 characters long or less.

NumberOfPhrases = 25 'Change this if you add new phrases

DATA "A QBasic egy nagyszer� programoz�si nyelv."
DATA "Hozz�m besz�lsz?"
DATA "Id� van!"
DATA "Viszl�t k�s�bb!"
DATA "H�t nem ez a legjobb program?"
DATA "Kital�ltad a feladv�nyt. Nagyszer�!"
DATA "Ez Keith els� programja."
DATA "Egyszer volt, hol nem volt..."
DATA "Ne n�zz engem!"
DATA "Mi vagyok �n, egy bolond?"
DATA "Az�rt, mert azt mondtam."
DATA "Ha biztos vagy benne..."
DATA "Mi a fene!?"
DATA "Amire sz�ks�g�nk van, az egy terv."
DATA "AZ vitte el a tort�t. AZ VOLT!"
DATA "Mintha a dolgot nem voln�nak el�g rosszak..."
DATA "A Nagy �sszeoml�s 2000."
DATA "QBasic 4.5-�t akarok!!!"
DATA "Ez QBasic 1.1-el k�sz�lt."
DATA "Engedd szabadon a fant�zi�dat, �s �rj saj�t feladv�nyokat."
DATA "�dv�z�lj�k utasainkat! Az els� meg�ll� a Tas vez�r utca."
DATA "K�rem sz�veskedjenek elhagyni a vonatot!"
DATA "K�rj�k, hogy az �llom�s ter�let�n ne gy�jtsanak r�! K�sz�nj�k."
DATA "Albertfalva, kit�r�, v�g�llom�s. Viszontl�t�sra."
DATA "A magyar sz�vegeket k�sz�tette Baranyi P�ter."

rp = INT(RND * NumberOfPhrases) + 1

RESTORE

FOR gt = 1 TO rp - 1
READ nonsense$
NEXT gt

READ phrase$

copyofphrase$ = LEFT$(phrase$, LEN(phrase$))

GOTO mainloop

twoplay:                                'TWO PLAYER branch...

TIMER OFF                               'Stop the border, then
wipe                                    'wipe the screen (see wipe SUB)

z = 9: ON TIMER(1) GOSUB colorchange
TIMER ON

LINE (0, 0)-(639, 479), 9, B
GOTO gettphrase

colorchange:                            'The colorchange branch...
z = z + 1: IF z = 15 THEN z = 9         'changes the border
LINE (0, 0)-(639, 479), z, B            'every second if TIMER ON
LINE (1, 1)-(638, 478), z, B
RETURN

gettphrase:
COLOR 15: centertype 2, "1. j�t�kos, g�peld be a feladv�nyt"
ps = 2
chars$ = "abcdefghijklmnopqrstuvwxyz�������ABCDEFGHIJKLMNOPQRSTUVWXYZ����.,!?':;-1234567890 "

DO
LOCATE 4, ps: PRINT "�";
loopk:
z$ = INKEY$: IF z$ = "" THEN GOTO loopk
IF z$ = CHR$(13) AND phrase$ <> "" THEN EXIT DO
IF z$ = CHR$(8) AND ps > 2 THEN
 LOCATE 4, ps - 1: PRINT "  "; : LOCATE 4, ps - 1: ps = ps - 1
 phrase$ = LEFT$(phrase$, (LEN(phrase$) - 1))
END IF
 IF INSTR(chars$, z$) THEN
 IF ps = 80 THEN GOTO loopk
 phrase$ = phrase$ + z$: LOCATE 4, ps: PRINT z$; : ps = ps + 1
END IF
LOOP

'Above isn't that complicated, basically like a controlled INPUT sub

LOCATE 4, ps: PRINT " ";

copyofphrase$ = LEFT$(phrase$, LEN(phrase$))  'Phrase copy, needed if you lose

COLOR 15
centertype 6, "Most a 2. j�t�kosnak ki kell tal�lnia"
colorandom
centertype 8, "Nyomj meg egy gombot a kezd�shez"

WHILE INKEY$ = "": WEND  'Wait for a press from the user

mainloop:

TIMER OFF                'Stop the border...
wipe                     'Wipe the screen...
COLOR 15

LINE (0, 0)-(639, 479), 12, B   'Red and
LINE (1, 1)-(638, 478), 6, B    'Bright Red
LINE (2, 2)-(637, 477), 6, B    'Border

ps = INT(41 - LEN(phrase$) / 2)        'Co-ordinates to
LOCATE 2, ps                           'center the blanks

letters$ = "abcdefghijklmnopqrstuvwxyz�������ABCDEFGHIJKLMNOPQRSTUVWXYZ����" 'Put
FOR a = 1 TO LEN(phrase$)                                         'the
 sc$ = MID$(phrase$, a, 1)                                        'blanks
 IF INSTR(letters$, sc$) THEN PRINT "�";  ELSE PRINT ""; sc$; 'in
NEXT a

drawhang

LOCATE 25, 5: COLOR 9: PRINT "FELHASZN�LT BET�K"

startagain:

LOCATE 15, 5: COLOR 9: PRINT "MARAD�K PROB�LKOZ�S:"; : COLOR 15: PRINT triesleft;
LOCATE 26, 5: COLOR 15: PRINT used$
LOCATE 8, 5: COLOR 15: PRINT "G�pelj be egy bet�t: �"; :

getletter:

z$ = INKEY$
IF z$ = "" THEN GOTO getletter              'If no key is pressed
IF z$ = CHR$(27) THEN wipe: GOTO mainmenu   'If Esc is pressed, quit
IF INSTR(letters$, z$) THEN                 'If a letter is pressed...
 IF INSTR(used$, z$) THEN GOTO getletter    'forget it if it's used,
 LOCATE , POS(0) - 1: PRINT z$;             'otherwise print it...
 GOTO checkforit                            'and goto the checkforit branch
END IF
GOTO getletter                              'If none of above, return to top

checkforit:                                 'Get a lowercase and uppercase
c1$ = z$                                    '\/  sample of the letter
IF UCASE$(c1$) = c1$ THEN c2$ = LCASE$(c1$) ELSE c2$ = UCASE$(c1$)
                     
used$ = used$ + LCASE$(z$)                  'Add to the USED string

flag = 0
FOR c = 1 TO LEN(phrase$)
sctn$ = MID$(phrase$, c, 1)
IF sctn$ = c1$ THEN                         'If it's found, then...
 LOCATE 2, ps - 1 + c                       'print it in it's right spot
 PRINT c1$                                  'and set the flag to 1
 flag = 1                                   'to indicate a match was found
 ELSEIF sctn$ = c2$ THEN
 LOCATE 2, ps - 1 + c
 PRINT c2$;
 flag = 1
END IF
NEXT c

IF flag THEN GOTO seeifyouwon               'If flag is 1, goto checkifyouwon

IF snd THEN PLAY "o0 c"                     'Otherwise you must of guessed a
                                            'wrong letter, so if sound is on,
triesleft = triesleft - 1                   'play a low tone; decrease your
                                            'tries you have left
SELECT CASE triesleft
CASE 5                                              'The head,
 CIRCLE (400, 165), 30, 15                          'face
 CIRCLE (390, 158), 3, 15: PAINT (390, 158), 9, 15  'eyes
 CIRCLE (410, 158), 3, 15: PAINT (410, 158), 9, 15  'and
 CIRCLE (400, 185), 15, 15, 0, pi#                  'frown
CASE 4
 LINE (400, 195)-(400, 200), 15                     'The
 LINE (400, 200)-(380, 210), 15                     'person's
 LINE (400, 200)-(420, 210), 15                     'green
 PSET (380, 210), 15: DRAW "c15 d100 r40 u100"      'shirt
 PAINT (381, 211), 10, 15
CASE 3
 LINE (380, 210)-(350, 270), 15                     'His right arm
CASE 2
 LINE (420, 210)-(450, 270), 15                     'His left arm
CASE 1
 PSET (380, 310): DRAW "c15 d100 r20 u100"          'One of his legs
 PAINT (381, 311), 9, 15
CASE 0
 PSET (420, 310): DRAW "c15 d100 l20 u100"          'The other of his legs --
 PAINT (419, 311), 9, 15                            'now he's complete, so
 GOTO youlose                                       'you lose! Branch to
END SELECT                                          'youlose.

GOTO startagain                                     'If the triesleft was more
                                                    'than 0, go back up
seeifyouwon:
FOR a = 1 TO 80                                     'Check if you won. This
IF SCREEN(2, a) = ASC("�") THEN GOTO startagain     'checks the top line and
NEXT a                                              'if no blanks are found
                                                    'you won, otherwise go
                                                    'back up.

IF snd THEN PLAY "mb o2 t240 cc1" ELSE pause .4     'If you got here, well,
                                                    'you won!
pause 1

FOR a = 1 TO 8000
colorandom
z = INT(RND * 30) + 1                         'Print "YOU WIN"s
y = INT(RND * 71) + 1                         'all over
LOCATE z, y: PRINT " NYERT�L! ";              'the screen...
IF INKEY$ <> "" THEN wipe: GOTO mainmenu      'until a key is pressed...
FOR p = 1 TO 100: NEXT p
NEXT a

wipe                                          'Or until it's done it
GOTO mainmenu                                 '8000 times.
                        
finished:
FOR b = 0 TO 480                              'Wipe the
LINE (0, b)-(640, b), 0                       'screen from
pause 1D-27                                   'top to bottom,
NEXT                                          'then exit.
SYSTEM

youlose:
IF snd THEN PLAY "mf o2 t240 c2 < g. g a-2 g2... b2 > c2" ELSE pause 1
CLS : COLOR 9: centertype 1, "VESZTETT�L"
COLOR 15: centertype 3, "A helyes megfejt�s: "
COLOR 15: centertype 4, copyofphrase$
COLOR 14: centertype 6, "Nyomj meg egy gombot, hogy visszat�rj a f�men�be"

'Above - you lost. If sound is on play a tune. Show the right phrase.

WHILE INKEY$ = "": WEND

wipe
GOTO mainmenu

'�����������������������������������������������������������������������������
'                     Well, th..th..that's all, folks!
'                              - Keith Koshman
'�����������������������������������������������������������������������������


SUB centertype (row!, text$)
'�����������������������������������������������������������������������������
'CENTERTYPE SUB
'
'Function: Types a specified string centered on the screen.
'
'Parameters: Row!  = The row, from 1 to 30, where the text will be
'            Text$ = The text to type
'�����������������������������������������������������������������������������
col = INT(41 - LEN(text$) / 2)
LOCATE row!, col
FOR tp = 1 TO LEN(text$)
 PRINT MID$(text$, tp, 1);
 FOR p = 1 TO 8000: NEXT p
NEXT tp
END SUB

SUB colorandom
'�����������������������������������������������������������������������������
'COLORANDOM SUB
'
'Function: Gets a random color between 9 and 14, and changes to that color.
'
'Parameters: None
'�����������������������������������������������������������������������������
RANDOMIZE TIMER
r% = INT(RND * 6) + 9
COLOR r%
END SUB

SUB drawhang
'�����������������������������������������������������������������������������
'DRAWHANG SUB
'
'Function: Draws the Hangman stand on the right side of the screen.
'
'Parameters: None
'�����������������������������������������������������������������������������
PSET (500, 460)
DRAW "c15r100"
PSET (550, 460)
DRAW "c15u400l150d75"
END SUB

DEFSNG A-Z
'
SUB pause (Seconds)
'�����������������������������������������������������������������������������
'PAUSE SUB
'
'Function: Pauses everything for a specified amount of seconds
'
'Parameters: Seconds = The amount to pause, can include decimals
'�����������������������������������������������������������������������������
waitforit = TIMER
DO WHILE TIMER < waitforit + Seconds: LOOP
END SUB

DEFINT A-Z
SUB wipe
'�����������������������������������������������������������������������������
'WIPE SUB
'
'Function: Clears the screen in one of three cool ways, looks way better
'          then CLS.
'
'Parameters: None
'�����������������������������������������������������������������������������
RANDOMIZE TIMER
z = INT(RND * 3) + 1

IF z = 1 THEN
 LINE (0, 479)-(100, 479), 0
 u = 480
 FOR d = 0 TO 480
  LINE (0, 0)-(640, d), 0
  LINE (640, 480)-(0, u), 0
  u = u - 1
 NEXT d

 CLS : LOCATE 1, 1
 pause .1
 EXIT SUB

ELSEIF z = 2 THEN

 FOR a = 240 TO 0 STEP -1
 LINE (320, 240)-(640, a), 0
 FOR p = 1 TO 50: NEXT p
 NEXT a

 FOR a = 640 TO 0 STEP -1
 LINE (320, 240)-(a, 0), 0
 FOR p = 1 TO 50: NEXT p
 NEXT a

 FOR a = 0 TO 480
 LINE (320, 240)-(0, a), 0
 FOR p = 1 TO 50: NEXT p
 NEXT a

 FOR a = 0 TO 640
 LINE (320, 240)-(a, 480), 0
 FOR p = 1 TO 50: NEXT p
 NEXT a

 FOR a = 480 TO 240 STEP -1
 LINE (320, 240)-(640, a), 0
 FOR p = 1 TO 50: NEXT p
 NEXT a

EXIT SUB

ELSEIF z = 3 THEN

 z = 640
 FOR a = 0 TO 640

 LINE (a, 0)-(a, 240), 0
 LINE (z, 241)-(z, 480), 0
 z = z - 1
 FOR p = 1 TO 100: NEXT p
 NEXT a
 FOR p = 1 TO 1000: NEXT p

END IF

END SUB