'===========================================================================
' Subject: HANG PERSON                        Date: 04-24-96 (00:00)       
'  Author: Steven Hanov                       Code: QB, QBasic, PDS        
'  Origin: hanov@wchat.on.ca                Packet: GAMES.ABC
'===========================================================================
DECLARE SUB centre (lc!, t$)
DECLARE SUB DrawGuy (parts!)
DECLARE SUB IntroScreen ()
DECLARE SUB BigPrint (t$, x!, y!, colour!, sc!)
'****************************************************************************
'*                          IDENTIFICATION                                  *
'*                                                                          *
'*                NAME:       Steven Hanov                                  *
'*                PROGRAM:    a:\progC.bas                                  *            *
'*                SCHOOL:     Cardinal Newman C. S. S.                      *
'*                TEACHER:    Miss Gotovac                                  *
'*                COMPUTER:   IBM/MS-DOS                                    *
'*                LANGUAGE:   QBASIC                                        *
'*                PERIOD:     LATE 20th CENTURY (Julian Calender)           *
'*                CLASS:      DPT 3A1 Period 2                              *
'*                DATE:       96/04/26                                      *
'*                                                                          *
'****************************************************************************

'****************************************************************************
'*                       PROGRAM ANALYSIS                                   *
'*                                                                          *
'* This program will simulate the game of HANG PERSON. The user may select  *
'* from multiple catagories. The hanging of the person will be shown in     *
'* steps.                                                                   *
'****************************************************************************

'****************************************************************************
'*                       VARIABLE DICTIONARY                                *
'****************************************************************************
DIM p$(22)
DIM words(5, 25) AS STRING, Cats(5) AS STRING, wcount(5), ccount
DIM hints(5, 25) AS STRING
DIM SHARED char(32 TO 126, 8, 16), m$(12)

'p$ contains the lines of music
'word$ contains the words in each catagory (cat,word#)
'Cats contains the names of the catagories
'wcount contains the number of words in each catagory
'ccount counts the number of catagories
'hints is like words but has the hints.
'char contains the character information for each pixel (0=OFF,15=ON)
'm$ contains the possible exit messages

'****************************************************************************
'*                              MAIN                                        *
'****************************************************************************
RANDOMIZE TIMER
ON PLAY(3) GOSUB music

SCREEN 12
CLS
LOCATE 2, 1
PRINT "Please wait..."
COLOR 15
FOR s = 32 TO 126
   LOCATE 1, 1: PRINT CHR$(s)                 'Scans all characters into
   FOR y = 1 TO 16                            'array CHAR().
      FOR x = 1 TO 8
         char(s, x, y) = POINT(x - 1, y - 1)
      NEXT
   NEXT
   IF s = 95 THEN char(s, 8, 14) = 0         'Makes "_" shorter
NEXT                                         'so underline is separated

GOSUB music                        'Starts music
PLAY ON



CALL IntroScreen
DO
   READ c$
   IF c$ = "ENDDATA" THEN EXIT DO
   ccount = ccount + 1
   Cats(ccount) = c$
   DO
      READ w$                                'Reads in all the
      IF w$ = "ENDCAT" THEN EXIT DO          'data
      wcount(ccount) = wcount(ccount) + 1
      words(ccount, wcount(ccount)) = w$
      READ h$
      hints(ccount, wcount(ccount)) = h$
   LOOP
LOOP

ReStart:

LINE (190, 120)-(440, 340), 0, BF                'clears a portion if the
COLOR 14                                                      'screen
FOR s = 1 TO ccount
   LOCATE 100 \ 16 + 1 + s * 2, 200 \ 8 + 1      'Prints menu of catagories
   PRINT Cats(s)
NEXT
item = 1
pitem = 1
DO
   LINE (200, 100 + (item * 2) * 16 - 8)-(430, 100 + (item * 2) * 16 + 20 - 8), 4, B
   DO
      a$ = INKEY$                         'Filters out unacceptable keypresses
   LOOP UNTIL (a$ = CHR$(0) + CHR$(80)) OR (a$ = CHR$(0) + CHR$(72)) OR a$ = CHR$(13)
   IF a$ = (CHR$(0) + CHR$(80)) AND (item < ccount) THEN
      item = item + 1                      'user pressed down
   ELSEIF (a$ = CHR$(0) + CHR$(72)) AND (item > 1) THEN
      item = item - 1                      'user pressed up
   END IF
   LINE (200, 100 + (pitem * 2) * 16 - 8)-(430, 100 + (pitem * 2) * 16 + 20 - 8), 0, B
   pitem = item                         'Clears previous box,draws new
LOOP UNTIL a$ = CHR$(13)         'Loop until ENTER pressed

LINE (100, 120)-(540, 400), 0, BF
sofar$ = ""                              'What user has so far ("Th_s w_rd")
alpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"    'What they can choose from
cw = INT(RND * wcount(item) + 1)          'Pick random word
word$ = words(item, cw)
h$ = hints(item, cw)                    'The hint
ToBeFound = LEN(word$)                  'Howmany letters they have to find
FOR s = 1 TO LEN(word$)
   a$ = "_"                             'Puts in punctuation - don't have
   b = ASC(MID$(LCASE$(word$), s, 1))            'to guess /-*: etc.
   IF b < 97 OR b > 122 OR b = 32 THEN a$ = CHR$(b): ToBeFound = ToBeFound - 1
   sofar$ = sofar$ + a$
NEXT
      
LINE (500, 170)-(520, 390), 6, BF
LINE (400, 170)-(520, 190), 6, BF

CALL BigPrint(sofar$, 108, 128, 3, 2)
LOCATE 24, 16: COLOR 14: PRINT "Letters to choose from:"
tries = 1
lettersfound = 0
DO
   LOCATE 25, 16: COLOR 4: PRINT alpha$   'Prints letters to choose from
   CALL DrawGuy(tries)                   'Draws guy
   ok = 0                                'Flag-user picked valid letter
   DO
      DO
         b = 0                                 'Filters out all but alphabet
         a$ = INKEY$
         IF a$ <> "" THEN b = ASC(LCASE$(a$))
      LOOP UNTIL b > 96 AND b < 123
      b = b - 96                      'Gets number of alphabet (a=1, z=26)
      IF MID$(alpha$, b, 1) <> "-" THEN ok = 1   'Checks if its already picked
   LOOP UNTIL ok = 1          'Loops out when user picks new letter
   MID$(alpha$, b, 1) = "-"    'Makes it a "-"
   found = 0
   FOR s = 1 TO LEN(word$)
      letter = ASC(MID$(LCASE$(word$), s, 1))
      IF letter = b + 96 THEN              'If found,
         found = 1                         'replaces letters in word
         lettersfound = lettersfound + 1
         c$ = CHR$(letter)
         IF ASC(MID$(word$, s, 1)) < 96 THEN c$ = UCASE$(c$)
         MID$(sofar$, s, 1) = c$
         CALL BigPrint(c$, 108 + (s - 1) * 16, 128, 3, 2)
      END IF
   NEXT
   IF found = 0 THEN tries = tries + 1
   IF tries = 6 THEN
      LOCATE 21, 16: PRINT "HINT:"
      LOCATE 22, 16: PRINT h$
   END IF
LOOP UNTIL lettersfound = ToBeFound OR tries = 7

IF tries = 7 THEN
   CALL DrawGuy(7)
   LOCATE 15, 16: COLOR 14: PRINT "You LOSE!"
   LOCATE 16, 16: PRINT "The parts of your body"
   LOCATE 17, 16: PRINT "have all decomposed."
   CALL BigPrint(word$, 108, 128, 3, 2)
ELSE
   LOCATE 15, 17: COLOR 14: PRINT "You WIN!"
END IF

LOCATE 19, 16: PRINT "Play again (Y/N)?"
DO
   a$ = INKEY$
   IF a$ <> "" THEN a$ = UCASE$(a$)
LOOP UNTIL a$ = "Y" OR a$ = "N"
   LINE (100, 120)-(540, 400), 0, BF
   DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"
   DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"
   PAINT (110, 130), 4, 6
   PAINT (530, 390), 6, 4
IF a$ = "Y" THEN GOTO ReStart
LINE (130, 170)-(510, 230), 0, BF
COLOR 3
m$(1) = "Press enter to activate the electric chair."
m$(2) = "Press enter to release the chlorine gas."
m$(2) = "Press enter to release the flying baracudas."
m$(3) = "There's a demon around the next corner!"
m$(4) = "Press enter to raise the GST by 18%!"
m$(5) = "Press enter to launch the nuclear warheads."
m$(6) = "Press enter to format hard disk."
m$(7) = "Press enter to nullify all your credit cards."
LOCATE 13, 18: PRINT m$(FIX(RND * 6) + 1)




DO WHILE INKEY$ = "": LOOP
END
DATA TV Shows
DATA Seinfeld,Don't you wish you had a sein?,X-Files,Check your files for this one.
DATA "Star Trek: Voyager",Take a trek to the stars, Friends,The opposite of enemies
DATA Masterpiece Theater,A theater of works of art
DATA Mr. Rogers Neighborhood,Everyone wants this neighbor
DATA Sesame Street,Do you live on this street?
DATA Polka Dot Door,Open the door to dots!
DATA Animaniacs,These guys are animated maniacs.
DATA Barney and Friends,"I love you, you love me..."
DATA Traders,These don't deal in the fur trade...
DATA Cosby Show,Bill stars here..., Road to Avonlea, Think PEI.
DATA Home Improvement,Better your abode.
DATA The Red Green Show,Christmas Colours
DATA Reboot,Don't press reset.
DATA Earth 2,A sequel to the planet
DATA SeaQuest DSV,Searching the ocean
DATA Cheers,A bar, ER,Think hospitals, Sliders,Banana peel!, ENDCAT

DATA Computers
DATA Hard Disk,This one too HARD for you?
DATA Monitor,Its staring you in the face!
DATA RAM,Memory,ROM,Memory
DATA System Unit,The BRAIN
DATA Floppy Disk,Media,Keyboard,You're using it now,Modem,Telephones
DATA Mouse,Look out for the cat!
DATA Microsoft,These guys play monopoly.
DATA Binary Numbers,"01010101010"
DATA Hacker,"Not with an axe, but a mouse!"
DATA Uninterruptable Power Supply,When lightning strikes...UPS
DATA QBasic,Programming Language
DATA ENDCAT
DATA Internet Lingo
DATA Hypertext Markup Language,HTML,Universal Resource Locator,URL
DATA Home Page,You can't go home now,USENET,Do you use it?
DATA article,read 'em or write 'em.
DATA e-mail,have you send any lately?
DATA Surf the Web,Water metaphor
DATA Gopher,Small animal
DATA Wais,Oh let me count the ways!
DATA Archie,Think comics.
DATA Jughead,Eats a lot.
DATA Veronica,The rich one.
DATA Netscape,A browser
DATA Mosaic,A old browser
DATA File Transfer Protocol,FTP
DATA Point-To-Point Protocol,PPP
DATA SLIP Connection,Don't fall on the banana!
DATA World Wide Web,WWW
DATA ENDCAT
DATA ENDDATA



'****************************************************************************
'*                           SUBROUTINES                                    *
'****************************************************************************


music:
IF l = 0 THEN
   p$(1) = "O1T128L16MBee p16 eee e8 ee p16 e8 a#8 e"
   p$(2) = "e8 eee e8 ee p16 e8 b p16 ee"
   p$(3) = "p16 eee e8 ee p16 e8 >c8< eee"
   p$(4) = "e p16 ee p16 e e8 >c#< p17 b p16 ee p16 e8"
   p$(5) = "ee p16 ee p16 e8 a# e e8 e e8"
   p$(6) = "ee p16 ee p16 e8 b p16 eee e8 e"
   p$(7) = "e p16 ee p16 e8 >c<e e8 ee p16 ee"
   p$(8) = "p16 e e8 >c# c <b16 >e"
   p$(9) = "o2 ML b b2 b4. >c8 c2 c4 c c#8 c# c#2"
   p$(10) = "c#4 d2 d8. c p16 <b p16 b MN"
   p$(11) = "O1" + p$(5)
   p$(12) = p$(6)
   p$(13) = p$(7)
   p$(14) = p$(8)
   p$(15) = "O3 bgegb>c<bge<bg>e"
   p$(16) = "gf#ecegage>c<gege>c<b"
   p$(17) = "ag<bgegb>egbgf#ebag"
   p$(18) = "be<gab>e<b>g>dc#<bgcp16<bp16"
   p$(19) = "gbage<b>gb>c<babge<b>>e"
   p$(20) = "gf#eage<bgb>egbageg<b"
   p$(21) = "ge<gb>egb>egbgeg<bge"
   p$(22) = "g<b>egbgb>dcp16<bp16"
END IF

l = l + 1: IF l = 23 THEN l = 1
PLAY p$(l)
RETURN

SUB BigPrint (t$, x, y, colour, sc)

FOR c = 1 TO LEN(t$)
FOR yp = 1 TO 16
   FOR xx = 1 TO 8
      xp = (c - 1) * 8 + xx
      IF char(ASC(MID$(t$, c, 1)), xx, yp) = 15 THEN
         LINE (x + (xp * sc), y + (yp * sc))-(x + (xp * sc) + sc, y + (yp * sc) + sc), colour, BF
      END IF
   NEXT
NEXT
NEXT


END SUB

SUB centre (lc, t$)
LOCATE lc, 40 - LEN(t$) \ 2
PRINT t$
END SUB

SUB DrawGuy (parts)
LINE (385, 302)-(407, 390), 0, BF
LINE (435, 302)-(412, 390), 0, BF
LINE (385, 245)-(435, 300), 0, BF
LINE (382, 245)-(370, 310), 0, BF
LINE (437, 245)-(448, 310), 0, BF
PAINT (410, 220), 0
IF parts = 7 THEN EXIT SUB
ON parts GOTO Leg1, Leg2, Body, Arm1, Arm2, Head

Leg1:
LINE (385, 302)-(407, 390), 1, BF
Leg2:
LINE (435, 302)-(412, 390), 1, BF

Body:
LINE (385, 245)-(435, 300), 4, BF

Arm1:
LINE (382, 245)-(370, 310), 4, BF

Arm2:
LINE (437, 245)-(448, 310), 4, BF

Head:
CIRCLE (410, 220), 20, 14
PAINT (410, 220), 14



END SUB

SUB IntroScreen
PAINT (1, 1), 4
DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50 ta5 r70"
DRAW "ta-40 r100 ta30 r90 ta70 r100 ta20 r200"
PAINT (10, 360), 6
CALL BigPrint("H", 100, 20, 14, 6)
CALL BigPrint("ang Perso", 150, 20, 14, 4.5)
CALL BigPrint("N", 480, 20, 14, 6)
LINE (100, 120)-(540, 400), 0, BF

COLOR 5
centre 10, "Written by Steven Hanov (hanovs@wchat.on.ca)"
COLOR 7
centre 12, "For computer class at"
centre 13, "Cardinal Newman High School"
COLOR 1
centre 16, "The object of the game is to guess what a"
centre 17, "word is by picking the letters. This must"
centre 18, "done before the person's body is fully"
centre 19, "decomposed. If you can do it, the body can"
centre 20, " possibly be reanimated."
COLOR 14
centre 23, "Press any key to start."


DO WHILE INKEY$ = "": LOOP
   LINE (100, 120)-(540, 400), 0, BF
   DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"
   DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"
   PAINT (110, 130), 4, 6
   PAINT (530, 390), 6, 4
END SUB