'===========================================================================
' Subject: HANGMAN GAME                      Date: 10/16/95 (00:00)       
' Author:  Unknown Author(s)                 Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: GAMES.ABC
'===========================================================================
DEFINT A-Z

DECLARE FUNCTION GetKey% ()
DECLARE FUNCTION Enput$ (FieldLength)
DECLARE SUB XLocate (Column)
    
  
   CONST Esc = 27, Enter = 13, BackSpace = 8
   CONST NumWords = 18

   SCREEN 0
   WIDTH 80
   COLOR 13
   CLS
   LOCATE , , 0
  
   RANDOMIZE TIMER

    PRINT "This is a game of hangman.  You may play aginst the computer or another person."
    PRINT "      You will get a body part added to the man if you get a letter wrong."
    PRINT "           If you get the letter correct you will get another guess."
    PRINT "                 You will have the possibility of six errors."
    PRINT "           You must get the word correct before your man gets hanged."
    PRINT
    PRINT "   BEWARE:  There maybe hyphens, periods, numbers, and you must guess spaces. "
    PRINT "                               Good luck!"
    LOCATE 23
    PRINT "                        Press a key to continue..."
   
    KeyCode = GetKey%
    
Top:
    SCREEN 0
    CLS
    COLOR 9
    LOCATE 9

    PRINT TAB(20); "1) YO! G U WON'T PLAY DIS 1!!!!"
    PRINT
    COLOR 10
    PRINT TAB(20); "2) HA!HA!  PLAY DIS MODE!!! HA!HA!"
    PRINT
    COLOR 15
    PRINT TAB(20); "3) C'YA! OUTTY 5000 G!!"
    PRINT
    COLOR 4
    PRINT TAB(20); "   WHICH 1 U BE WANNIN!!"
230
    KeyCode = GetKey%
    
    SELECT CASE KeyCode
        CASE 49     '1
            '
            ' **** WORD INPUT BY COMPUTER ****
            '
            RESTORE WordList:
            FOR Temp = 0 TO INT(RND * NumWords)
                READ Word$
            NEXT Temp
            Word$ = UCASE$(Word$)

        CASE 50     '2
            '
            ' **** WORD ENTERED BY PLAYER ONE ****
            '
          
            PRINT "TYPE IN A WORD, AND THE PRESS THE ENTER KEY."
          
            Word$ = UCASE$(Enput$(50))
        CASE 51     '3
            GOSUB 970
        CASE Esc    'ESC
            END
        CASE ELSE
            GOTO 230
    END SELECT
    'GOTO 180

490
    '
    ' **** GUESS ROUTINE ****
    '
    SCREEN 2
    CLS : LOCATE 6, 10
    GOSUB 1070
    Mistakes = 0: WordLen = LEN(Word$)
    PRINT "THA WORD HAZ"; WordLen; "LETTERS"
    LOCATE 10, 10
    S = 5
    Guess$ = STRING$(WordLen, 221)
    PRINT Guess$
   
    DO
        LOCATE 18, 10: PRINT "U HAVE "; Mistakes; " MIZTAKEZ!"
        LOCATE 19, 10: PRINT "GUEZZ DA LETTER:  ";
        Letter$ = UCASE$(Enput$(1))
       
        IF KeyCode = Esc THEN
            GOTO Top:
        END IF
       
        LOCATE 21, 5: PRINT "U HAVE PICKED THEZE LETTERS...."
        S = S + 2
        LOCATE 23, S
        PRINT Letter$

        FOR J = 1 TO WordLen
            IF MID$(Word$, J, 1) = Letter$ THEN
                GG = 1
                MID$(Guess$, J, 1) = Letter$
            END IF
        NEXT J
        LOCATE 10, 10: PRINT Guess$
       
        IF GG <> 1 THEN
            Mistakes = Mistakes + 1
            ON Mistakes GOSUB 1190, 1280, 1320, 1400, 1480
        ELSE
            GG = 0
            IF Guess$ = Word$ THEN EXIT DO
        END IF
        
    LOOP WHILE Mistakes < 6
   
    LOCATE 18, 10: PRINT "U HAVE "; Mistakes; " MIZTAKEZ!"
    GOSUB 1190
    GOSUB 1280
    GOSUB 1320
    GOSUB 1400
    GOSUB 1480
    GOSUB 1520

    LOCATE 14, 10
    IF Guess$ = Word$ THEN
        PRINT " ' B O U T  T I M E ! !"
        GOSUB 1590
    ELSE
        PRINT "HA HA ! !... THA WORD WUZ "; Word$
        GOSUB 1560
    END IF
   
    GOTO Top:

970
    '
    ' **** PROGRAM EXIT ROUTINE ****
    '
    
    SCREEN 0
    END

1070
     ' **** GALLOWS ****
      LINE (260, 170)-(350, 199), 1, BF
      LINE (600, 0)-(590, 199), 1, BF
      LINE (500, 170)-(600, 199), 1, BF
      LINE (355, 170)-(495, 170), 1, BF
      LINE (422, 0)-(600, 3), 1, BF
      LINE (515, 0)-(600, 43)
      LINE (500, 0)-(600, 50)
      LINE (422, 0)-(426, 50), 1, BF
      CIRCLE (424, 64), 10, 1, , , .9
      LINE (420, 50)-(428, 55), 1, BF
      RETURN

1190
     ' **** HEAD ****
      CIRCLE (424, 64), 10, 0, , , .9       'Erase noose
      CIRCLE (424, 50), 30, 1
      CIRCLE (424, 50), 28, 0
      PAINT (424, 50), 0                    'Erase rope
      CIRCLE (415, 47), 2, 1
      CIRCLE (433, 47), 2, 1
      CIRCLE (424, 56), 9, 1, , , .2
      CIRCLE (424, 50), 1, 1
      RETURN
   
1280
     ' **** BODY ****
      LINE (421, 64)-(427, 70), 1, BF
      CIRCLE (424, 92), 25, 1, , , .9
      RETURN

1320
     ' **** ARM 1 ****
      LINE (401, 83)-(350, 95)
      LINE (409, 73)-(350, 95)
      LINE (350, 95)-(340, 93)
      LINE (350, 95)-(338, 96)
      LINE (350, 95)-(336, 100)
      LINE (350, 95)-(348, 103)
      RETURN

1400
     ' **** ARM 2 ****
      LINE (448, 83)-(500, 95)
      LINE (432, 70)-(500, 95)
      LINE (500, 95)-(515, 90)
      LINE (500, 95)-(518, 95)
      LINE (500, 95)-(513, 99)
      LINE (500, 95)-(510, 102)
      RETURN

1480
     ' **** LEG 1 ****
      LINE (417, 115)-(410, 163)
      CIRCLE (402, 165), 10, 1, , , .3
      RETURN
    
1520
     ' **** LEG 2 ****
      LINE (433, 115)-(440, 163)
      CIRCLE (446, 165), 10, 1, , , .3
      RETURN

1560
     ' **** LOSE ****
      'CIRCLE (415, 47), 2, 0
      'CIRCLE (433, 47), 2, 0
      'PSET (415, 47)
      'PSET (433, 47)
     
      LINE (355, 170)-(495, 170), 0, BF     'Erase floorboard
      KeyCode = GetKey%
      RETURN

1590
     ' **** WIN ****
      CIRCLE (424, 64), 10, 0, , , .9
      LINE (420, 50)-(428, 55), 0, BF
      LINE (422, 0)-(426, 50), 0, BF
      CIRCLE (424, 50), 30, 1
      CIRCLE (424, 50), 28, 1
      PAINT (424, 50), 0
      CIRCLE (415, 47), 2, 1
      CIRCLE (433, 47), 2, 1
      CIRCLE (424, 56), 9, 1, , , .2
      CIRCLE (424, 50), 1, 1
     
      KeyCode = GetKey%

      RETURN


WordList:

DATA "JUJU BEE"
DATA "R.T."
DATA "NICE BUTT"
DATA "B.B."
DATA "CHAD BECK"
  
DATA "KIETHERS"
DATA "PARIS"
DATA "PRINCE"
DATA "9-MILLIMETER"
DATA "TECH-9"

DATA "SYSTEM"
DATA "ICE-T"
DATA "BUSH KILLA"
DATA "GUERRILLAS IN THE MIST"
DATA "DEATHPOOL"

DATA "MARK SALASBALLS"
DATA "LIVIN' IN THA SESTPOOL"
DATA "I HATE KRISTA REALLY WITH A PASSION!!!!!!!"

FUNCTION Enput$ (FieldLength) STATIC
    SHARED KeyCode, KeyStroke$
  
    'Define internal defaults
    ReturnVar$ = ""     'Used to hold output
    Col = POS(0)
    CharsCollected = 0
    EmptySpaceChar$ = "Ý"
   
    ' Supply usable keys
    AllowCharsMask$ = CHR$(34) + " !#$%&'()*+,-./0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[\]_"
  
  
    ' begin main loop
    DO
        IF CharsCollected THEN
            'Column = Col + CharsCollected
            CALL XLocate(Col + CharsCollected)
        ELSE
            CALL XLocate(Col)           'On
            PRINT STRING$(FieldLength, EmptySpaceChar$);
            CALL XLocate(Col)           'On
        END IF
    
        KeyCode = GetKey%
       
        SELECT CASE KeyCode
            CASE Esc            'Abort program
                EXIT DO
            CASE BackSpace      'Back up
                IF CharsCollected THEN
                    CharsCollected = CharsCollected - 1
                    'Column = Col + CharsCollected
                    CALL XLocate(Col + CharsCollected)
                    PRINT EmptySpaceChar$;
                    ReturnVar$ = LEFT$(ReturnVar$, CharsCollected)
                END IF
            CASE Enter          'Accept
                EXIT DO
            CASE 1 TO 255       'Normal key
                KeyStroke$ = CHR$(KeyCode)
                IF INSTR(AllowCharsMask$, KeyStroke$) THEN  'see if it's printable
                    IF CharsCollected < FieldLength THEN
                        ReturnVar$ = ReturnVar$ + KeyStroke$
                        CharsCollected = CharsCollected + 1
                        PRINT KeyStroke$;
                    END IF
                END IF
        END SELECT
    LOOP
    Enput$ = ReturnVar$
    PRINT
  
END FUNCTION

FUNCTION GetKey% STATIC
   
    DO
        Ky$ = INKEY$
        KeyCode = 0
        SELECT CASE LEN(Ky$)
            CASE 1
                KeyCode = ASC(Ky$)
            CASE <> 0
                KeyCode = -ASC(RIGHT$(Ky$, 1))
        END SELECT
    LOOP UNTIL KeyCode

    GetKey% = KeyCode

END FUNCTION

SUB XLocate (Column) STATIC
    LOCATE , Column, 1
END SUB