'=========================================================================== ' 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