IDENTIFICATION DIVISION. PROGRAM-ID. hangman. DATA DIVISION. WORKING-STORAGE SECTION. 01 banner-line pic x(78) value " Press PF1 to quit Press PF3 to skip this word". 01 HAD-ERRMSG PIC X. 01 ERRMSG PIC X(27) VALUE SPACE. 01 NULL-CHAR PIC X VALUE X"00". 01 BELL-CHAR PIC X VALUE X"07". 01 B-S PIC X VALUE X"08". 01 L-FEED PIC X VALUE X"0A". 01 ESC PIC X VALUE X"1B". 01 CONTROL-KEY. 03 FIRST-CHAR PIC X. 03 REMAINING-CHAR PIC XXXX. 88 UP-ARROW VALUE "A". 88 DOWN-ARROW VALUE "B". 88 RIGHT-ARROW VALUE "C". 88 LEFT-ARROW VALUE "D". 88 PF1 VALUE "P". 88 PF2 VALUE "Q". 88 PF3 VALUE "R". 88 PF4 VALUE "S". ** *********************************************************** 01 word-guess pic x(20). 01 wk-word. 02 wk-word-array occurs 20 times pic x. 01 ANS PIC X. 01 LR-LEN PIC 99 value 1. 01 ERR-CODE PIC S9(4) USAGE COMP. 01 PTR1 PIC 99 USAGE COMP. 01 PTR2 PIC 99 USAGE COMP. 01 wk-time. 02 pic 9999. 02 seconds pic 9999. 01 whole-word-list. 02 pic x(20) value "AXE". 02 pic x(20) value "DAY". 02 pic x(20) value "FART". 02 pic x(20) value "LIE". 02 pic x(20) value "DOG". 02 pic x(20) value "LEAP". 02 pic x(20) value "PENNY". 02 pic x(20) value "ROOM". 02 pic x(20) value "WARM". 02 pic x(20) value "WISHBONE". 02 pic x(20) value "TOURNAMENT". 02 pic x(20) value "PIGMY". 02 pic x(20) value "SOMERSAULT". 02 pic x(20) value "TACKLE". 02 pic x(20) value "OPOSSUM". 02 pic x(20) value "ZOOM". 02 pic x(20) value "TRANSIENT". 02 pic x(20) value "AWKWARD". 02 pic x(20) value "SOLILOQUY". 02 pic x(20) value "DISCHARGE". 02 pic x(20) value "INSTANT". 02 pic x(20) value "CELABRATE". 02 pic x(20) value "GREAT". 02 pic x(20) value "BONNY". 02 pic x(20) value "BOMB". 02 pic x(20) value "BOOM". 02 pic x(20) value "HALF". 02 pic x(20) value "LAYER". 02 pic x(20) value "LEAD". 02 pic x(20) value "DEBT". 02 pic x(20) value "SOAP". 02 pic x(20) value "STEW". 02 pic x(20) value "THICK". 02 pic x(20) value "PRIDE". 02 pic x(20) value "SMOG". 02 pic x(20) value "SMOKE". 02 pic x(20) value "STOCK". 02 pic x(20) value "STINKY". 02 pic x(20) value "VAMPIRE". 02 pic x(20) value "FAN". 02 pic x(20) value "VISIT". 02 pic x(20) value "WEATHER". 02 pic x(20) value "WHITTLE". 02 pic x(20) value "ZERO". 02 pic x(20) value "ZANY". 02 pic x(20) value "ZONE". 02 pic x(20) value "ZOMBIE". 02 pic x(20) value "ZUCCHINI". 02 pic x(20) value "YEOMAN". 02 pic x(20) value "WORMY". 02 pic x(20) value "XYLOPHONE". 02 pic x(20) value "YAWN". 02 pic x(20) value "SQUAT". 02 pic x(20) value "RUGGED". 02 pic x(20) value "CURDLE". 02 pic x(20) value "CUSHION". 02 pic x(20) value "CUSTOMARY". 02 pic x(20) value "CRANIUM". 02 pic x(20) value "BESPANGLED". 02 pic x(20) value "TINDERBOX". 02 pic x(20) value "CALABOOSE". 02 pic x(20) value "FREAK". 02 pic x(20) value "INDIGO". 02 pic x(20) value "INSTANT". 02 pic x(20) value "LABOR". 02 pic x(20) value "LADYBUG". 02 pic x(20) value "DETERMINATION". 02 pic x(20) value "CRATER". 02 pic x(20) value "COWPUNCHER". 02 pic x(20) value "CRACKERBARREL". 02 pic x(20) value "FLAGSHIP". 02 pic x(20) value "DIABETES". 02 pic x(20) value "CRAPPIE". 02 pic x(20) value "CRANKSHAFT". 02 pic x(20) value "CORPUSCLE". 02 pic x(20) value "CORNFLOWER". 02 pic x(20) value "CORDIALITY". 02 pic x(20) value "CONVALESCENCE". 02 pic x(20) value "CONTRACLOCKWISE". 02 pic x(20) value "CONSERVATIVE". 02 pic x(20) value "CONGRESSMAN". 02 pic x(20) value "CONFIRMATION". 02 pic x(20) value "COMPLIMENTARY". 02 pic x(20) value "COMPASSIONATE". 02 pic x(20) value "COBRA". 02 pic x(20) value "COBWEB". 02 pic x(20) value "CLAM". 02 pic x(20) value "CITIZENSHIP". 02 pic x(20) value "GENERALIZED". 02 pic x(20) value "CAUTION". 02 pic x(20) value "CATAPULT". 02 pic x(20) value "UMBER". 02 pic x(20) value "OCHER". 02 pic x(20) value "BUILD". 02 pic x(20) value "BUDGET". 02 pic x(20) value "BREATHE". 02 pic x(20) value "BOTULISM". 02 pic x(20) value "BOTTLENECK". 02 pic x(20) value "BOOTLEG". 02 pic x(20) value "BLUNDERBUSS". 02 pic x(20) value "BLUEPRINT". 02 pic x(20) value "BLOWOUT". 02 pic x(20) value "BLIMP". 02 pic x(20) value "BLINK". 02 pic x(20) value "BLINDFOLD". 02 pic x(20) value "BIRTHMARK". 02 pic x(20) value "BIODEGRADABLE". 02 pic x(20) value "BILLABONG". 02 pic x(20) value "BLIGHT". 02 pic x(20) value "BIGWIG". 02 pic x(20) value "BENIGN". 02 pic x(20) value "BELLYBUTTON". 02 pic x(20) value "BAUXITE". 02 pic x(20) value "BAROQUE". 02 pic x(20) value "BADLANDS". 02 pic x(20) value "BACKHANDED". 02 pic x(20) value "ASYMMETRY". 02 pic x(20) value "ARGIL". 02 pic x(20) value "APTERYX". 02 pic x(20) value "ANTIPARTICLE". 02 pic x(20) value "ANXIOUS". 02 pic x(20) value "ANXIETY". 02 pic x(20) value "ANYONE". 02 pic x(20) value "ANTIQUE". 02 pic x(20) value "ANESTHESIA". 02 pic x(20) value "ALDER". 02 pic x(20) value "AJAR". 02 pic x(20) value "ADVERB". 02 pic x(20) value "ADENOIDS". 02 pic x(20) value "ADEPT". 02 pic x(20) value "ACRID". 02 pic x(20) value "ACCREDITATION". 02 pic x(20) value "ZIGZAG". 02 pic x(20) value "YUK". 02 pic x(20) value "YET". 02 pic x(20) value "XEROGRAPHY". 02 pic x(20) value "WRONGFUL". 02 pic x(20) value "WRITING". 02 pic x(20) value "WORST". 02 pic x(20) value "WORD". 02 pic x(20) value "WITH". 02 pic x(20) value "WISTFUL". 02 pic x(20) value "WINGSPREAD". 02 pic x(20) value "WINDMILL". 02 pic x(20) value "WHITTLE". 02 pic x(20) value "WHITEN". 02 pic x(20) value "WEDGE". 02 pic x(20) value "WATERSKI". 02 pic x(20) value "WASTEFUL". 02 pic x(20) value "WARBLER". 02 pic x(20) value "WALRUS". 02 pic x(20) value "WAGON". 02 pic x(20) value "VOW". 02 pic x(20) value "VOYAGE". 02 pic x(20) value "VOLTMETER". 02 pic x(20) value "VOCABULARY". 02 pic x(20) value "VIOLET". 02 pic x(20) value "VIRUS". 02 pic x(20) value "VIGIL". 02 pic x(20) value "VANISH". 02 pic x(20) value "USHER". 02 pic x(20) value "UNTO". 02 pic x(20) value "UNEQUAL". 02 pic x(20) value "UNDERPASS". 02 pic x(20) value "UNDERGROUND". 02 pic x(20) value "UMBRELLA". 02 pic x(20) value "UGLY". 02 pic x(20) value "TYPE". 02 pic x(20) value "TWILL". 02 pic x(20) value "TURNOVER". 02 pic x(20) value "TRUMPET". 02 pic x(20) value "TRICUSPID". 02 pic x(20) value "TRAPEZIOD". 02 pic x(20) value "TRADEMARK". 02 pic x(20) value "TINGLE". 02 pic x(20) value "THERMOMETER". 02 pic x(20) value "TACTICAL". 02 pic x(20) value "SWITCHMAN". 02 pic x(20) value "SUSPENSION". 02 pic x(20) value "SUGAR". 02 pic x(20) value "FECES". 02 pic x(20) value "MUFTI". 02 pic x(20) value "CYGNET". 02 pic x(20) value "FERRET". 02 pic x(20) value "PLEBISCITE". 02 pic x(20) value "PLAIT". 02 pic x(20) value "PERCH". 02 pic x(20) value "DEXTRIN". 02 pic x(20) value "BUCKET". 02 pic x(20) value "BATHE". 02 pic x(20) value "BASIC". 02 pic x(20) value "BASIL". 02 pic x(20) value "SKEP". 02 pic x(20) value "SKEW". 02 pic x(20) value "SUP". 02 pic x(20) value "THROB". 02 pic x(20) value "TINCTURE". 02 pic x(20) value "TOMB". 02 pic x(20) value "VAPID". 02 pic x(20) value "ENMITY". 02 pic x(20) value "VOLE". 02 pic x(20) value "VOLT". 02 pic x(20) value "VOMIT". 02 pic x(20) value "WARP". 02 pic x(20) value "WAG". 02 pic x(20) value "WALK". 02 pic x(20) value "WHIZ". 02 pic x(20) value "WIDTH". 02 pic x(20) value "WIMBLE". 02 pic x(20) value "WILDEBEEST". 02 pic x(20) value "WHORL". 02 pic x(20) value "WHOP". 02 pic x(20) value "LIGNEOUS". 02 pic x(20) value "XYLOID". 02 pic x(20) value "ZEBEC". 02 pic x(20) value "XEBEC". 02 pic x(20) value "ZYMURGY". 02 pic x(20) value "CYST". 02 pic x(20) value "BOWL". 02 pic x(20) value "KINETIC". * when adding words also change the MAX-WORDS value below 01 redefines whole-word-list. 02 word-list occurs 220 times. 03 WORD-LIST-ARRAY occurs 20 times pic x. 01 MAX-WORDS PIC 999 VALUE 220. 01 guessed-letters-ptr pic 99. 01 guessed-letters. 02 gl-array occurs 26 times pic x. 01 BODY-PARTS-PTR PIC 99. 01 NOVICE-EXPERT PIC 9. 01 NOVICE-EXPERT-TEST PIC 99. 01 NOVICE-EXPERT-REMAIN-TEST PIC 99. PROCEDURE DIVISION. INIT-NOVICE-EXPERT. PERFORM SET-ANSI-MODE. DISPLAY "HANG MAN" LINE 1 COLUMN 30 bold ERASE SCREEN. GET-NOVICE-EXPERT. DISPLAY "Are you a NOVICE or EXPERT? " LINE 3 COLUMN 1 accept ANS protected. if ans = "N" or "n" move 1 to NOVICE-EXPERT else if ans = "E" or "e" move 2 to NOVICE-EXPERT else display bell-char no advancing go to GET-NOVICE-EXPERT. ST-RT. PERFORM SHOW-SKEL. move space to guessed-letters. move 01 to guessed-letters-ptr. MOVE ZERO TO BODY-PARTS-PTR. KEY-ENTRY1. perform get-letter. IF PF1 GO TO E-O-P. IF PF3 go to st-rt. move zero to lr-len. move 1 to ptr2. perform ck-for-valid-letter. if lr-len = 0 PERFORM DRAW-BODY-PARTS IF BODY-PARTS-PTR = 99 perform clear-error DISPLAY "The word was " line 24 column 30 bold bell word-list (seconds) BOLD no advancing go to MARK-WORD-AS-USED else go to key-entry1. IF WK-WORD = word-list (seconds) GO TO THEY-GUESSED-IT. perform get-word. IF word-guess = word-list (seconds) GO TO THEY-GUESSED-IT. go to key-entry1. THEY-GUESSED-IT. MOVE word-list (seconds) TO wk-word perform show-word. DISPLAY "YOU GUESSED IT!" line 24 column 30 BOLD BLINKING ERASE LINE BELL. MARK-WORD-AS-USED. move space to word-list (seconds). ANOTHER-WORD. DISPLAY "Do you want another word? Y" line 22 column 2 erase line B-S NO ADVANCING accept ans control key in control-key protected no blank. if ans = "Y" or "y" or space go to st-rt. if pf1 or ans = "N" or "n" go to e-o-p. display bell-char no advancing. go to another-word. E-O-P. PERFORM CLEAR-SCREEN. STOP RUN. /*---------------------------------------------------------------* ** Subroutine Section **---------------------------------------------------------------* **---------------------------------------------------------------* ** beep and display message on line 24 BEEP. MOVE "Y" TO HAD-ERRMSG. DISPLAY ERRMSG REVERSED LINE 24 COLUMN 25 BELL. MOVE SPACE TO ERRMSG. **---------------------------------------------------------------* ** clear error line CLEAR-ERROR. IF HAD-ERRMSG = "Y" MOVE "N" TO HAD-ERRMSG DISPLAY NULL-CHAR LINE 24 COLUMN 1 ERASE END LINE. **---------------------------------------------------------------* ** home cursor and clear screen CLEAR-SCREEN. MOVE "N" TO HAD-ERRMSG DISPLAY NULL-CHAR LINE 1 COLUMN 1 ERASE END SCREEN. **---------------------------------------------------------------* ** SET-ANSI-MODE. MOVE "N" TO HAD-ERRMSG DISPLAY ESC "<". **---------------------------------------------------------------* ** display the fixed fields on the screen SHOW-SKEL. PERFORM SET-ANSI-MODE. DISPLAY "HANG MAN" LINE 1 COLUMN 30 bold ERASE SCREEN "._________________________." line 3 column 20 l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" "___________________________________|__" line 21 column 11 "| \" line 4 column 20 l-feed "\" l-feed "\" l-feed "\" l-feed "\" l-feed "\" l-feed "\" l-feed "\" "=====================" line 19 column 10 "|" line 20 column 12 "|" line 20 column 28 " Word " line 6 column 50 reversed " Guessed letters " line 10 column 50 reversed banner-line line 23 column 2 reversed "Letter?" line 22 column 10. perform pick-and-show-word. get-letter. accept ans line 22 column 18 erase end line control key in control-key protected. perform clear-error. if not pf1 and not PF3 move 1 to lr-len CALL "LOTOUP" USING ans, lr-LEN if ans = space or ans NOT ALPHABETIC display bell-char no advancing go to get-letter end-if move zero to ptr1 inspect guessed-letters tallying ptr1 for all ans if ptr1 not = zero string " " ans " was previously guessed" DELIMITED BY SIZE into errmsg perform beep go to get-letter end-if add 11 guessed-letters-ptr giving ptr1 move 49 to ptr2 perform show-guessed-letters move ans to gl-array (guessed-letters-ptr) add 01 to guessed-letters-ptr. show-guessed-letters. if ptr1 > 20 subtract 9 from ptr1 add 8 to ptr2 go to show-guessed-letters. display guessed-letters-ptr conversion line ptr1 column ptr2 ". " ans no advancing. ck-for-valid-letter. IF WORD-LIST-ARRAY (seconds,PTR2) = ANS move ans to wk-word-array (ptr2) move 1 to lr-len. IF PTR2 < 20 ADD 1 to ptr2 go to ck-for-valid-letter. if lr-len not = zero perform show-word. get-word. display "Word? " line 22 column 30. accept word-guess control key in control-key protected. move 20 to lr-len. CALL "LOTOUP" USING word-guess, lr-LEN. pick-and-show-word. accept wk-time from time. perform scale-seconds. perform get-word-from-list. move word-list (seconds) to wk-word. inspect wk-word replacing characters by "_" before initial space. perform show-word. SCALE-SECONDS. if seconds > max-words divide 2 into seconds go to scale-seconds. if seconds = 0 move 1 to seconds. show-word. display wk-word line 8 column 50. get-word-from-list. if whole-word-list = SPACE perform clear-screen move " All words have been tried" to errmsg perform beep display " " stop run. if word-list (seconds) = space add 1 to seconds if seconds > MAX-WORDS move 1 to seconds end-if go to get-word-from-list. DRAW-BODY-PARTS. add 1 to BODY-PARTS-PTR. ** head IF BODY-PARTS-PTR = 1 DISPLAY "o88888o" line 5 column 17 "88/ \88" line 6 column 16 "8\ /8" line 7 column 17. ** eyes IF BODY-PARTS-PTR = 2 DISPLAY ". ." line 6 column 19. ** mouth IF BODY-PARTS-PTR = 3 DISPLAY " _ " line 7 column 19. ** body IF BODY-PARTS-PTR = 4 DISPLAY "/---\" line 8 column 18 l-feed b-s "|" l-feed b-s "|" l-feed b-s "|" "|" line 9 column 18 l-feed b-s "|" l-feed b-s "|" l-feed b-s "|___|" no advancing. ** right arm IF BODY-PARTS-PTR = 5 DISPLAY "_" line 8 column 17 B-S B-S L-FEED "//" b-s b-s b-s l-feed "//" b-s b-s b-s l-feed "//" no advancing. ** right hand IF BODY-PARTS-PTR = 6 DISPLAY "__" line 11 column 12 b-s b-s b-s l-feed "[[[/" no advancing. ** left arm IF BODY-PARTS-PTR = 7 DISPLAY "_" line 8 column 23 B-S L-FEED "\\" b-s l-feed "\\" b-s l-feed "\\" no advancing. ** left hand IF BODY-PARTS-PTR = 8 DISPLAY "__" line 11 column 27 b-s b-s b-s l-feed "\]]]" no advancing. ** right leg IF BODY-PARTS-PTR = 9 DISPLAY "//" line 13 column 18 b-s b-s b-s l-feed "//" b-s b-s b-s l-feed "//" b-s b-s l-feed "||" b-s b-s l-feed "||" no advancing. ** right foot IF BODY-PARTS-PTR = 10 DISPLAY "_" line 17 column 15 b-s b-s b-s b-s l-feed "[[[___)" no advancing. ** left leg IF BODY-PARTS-PTR = 11 DISPLAY "\\" line 13 column 21 b-s l-feed "\\" b-s l-feed "\\" b-s b-s l-feed "||" b-s b-s l-feed "||" no advancing. ** left foot IF BODY-PARTS-PTR = 12 DISPLAY "_" line 17 column 25 b-s b-s b-s b-s l-feed "(___]]]" no advancing. ** remove platform & change some body features IF BODY-PARTS-PTR = 13 move 99 to body-parts-ptr DISPLAY " " line 19 column 10 bell " " line 20 column 12 " " line 20 column 28 "x x" line 6 column 19 b-s b-s l-feed "o" "||" line 10 column 15 b-s b-s b-s b-s b-s l-feed " __||" b-s b-s b-s b-s b-s b-s l-feed " [[[|" b-s l-feed "||" line 10 column 24 b-s b-s l-feed "||__ " b-s b-s b-s b-s b-s l-feed "|]]] " "| |" line 13 column 18 B-S B-S B-S B-S L-FEED " | |" B-S B-S B-S B-S B-S L-FEED " | |" B-S B-S B-S B-S B-S L-FEED " | |" B-S B-S B-S B-S B-S B-S L-FEED " _| |" B-S B-S B-S B-S B-S B-S B-S B-S B-S L-FEED " [[[___)" bell " |" line 13 column 21 B-S B-S L-FEED " | " B-S B-S B-S L-FEED " | " B-S B-S B-S B-S L-FEED " | " B-S B-S B-S B-S L-FEED " |_ " B-S B-S B-S B-S B-S B-S L-FEED "T___]]] " bell NO ADVANCING. ** test EXPERT status IF BODY-PARTS-PTR NOT = 99 divide BODY-PARTS-PTR by NOVICE-EXPERT giving NOVICE-EXPERT-TEST remainder NOVICE-EXPERT-REMAIN-TEST if NOVICE-EXPERT-REMAIN-TEST not = zero go to DRAW-BODY-PARTS.