Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ******************************************************************
- * Author: krusader74
- * Date: 2015-12-15
- * Purpose: D&D character sheet, original 1974 edition
- * Tectonics: cobc
- ******************************************************************
- IDENTIFICATION DIVISION.
- *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
- PROGRAM-ID. ODDSHEET.
- ENVIRONMENT DIVISION.
- *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
- CONFIGURATION SECTION.
- *-----------------------
- INPUT-OUTPUT SECTION.
- *-----------------------
- DATA DIVISION.
- *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
- FILE SECTION.
- *-----------------------
- WORKING-STORAGE SECTION.
- *-----------------------
- 01 SPLASH-SCREEN.
- 02 SPLASH-SCREEN-DETAILS PIC X(80) OCCURS 24 TIMES.
- 01 PLAYER-NAME PIC X(20) VALUE SPACES.
- 01 CHAR-NAME PIC X(20) VALUE SPACES.
- 01 RACE PIC X(6) VALUE SPACES.
- 88 IS-HUMAN VALUES "HUMAN", "Human", "HU", "Hu", "H",
- "human", "hu", "h".
- 88 IS-ELF VALUES "ELF", "Elf", "elf", "E", "e".
- 88 IS-DWARF VALUES "DWARF", "Dwarf", "dwarf", "D", "d".
- 88 IS-HOBBIT VALUES "HOBBIT", "Hobbit", "hobbit",
- "HO", "Ho", "ho".
- 01 CLS PIC X(12) VALUE SPACES.
- 88 IS-F-M VALUES "FIGHTER", "Fighter", "fighter",
- "FIGHTING-MAN", "Fighting-Man", "fighting-man",
- "FIGHTING MAN", "Fighting Man", "fighting man",
- "FM", "F", "f".
- 88 IS-M-U VALUES "MAGIC-USER", "Magic-User", "magic-user",
- "MAGIC USER", "Magic User", "magic user",
- "MU", "M", "m".
- 88 IS-CLERIC VALUES "CLERIC", "Cleric", "cleric", "C", "c".
- 01 ALIGN PIC X(10) VALUE SPACES.
- 88 IS-LAW VALUES "LAW", "Law", "law", "L", "l".
- 88 IS-NEUTRALITY VALUES "NEUTRALITY", "Neutrality",
- "Neutral", "neutral", "neutrality", "N", "n".
- 88 IS-CHAOS VALUES "CHAOS", "Chaos", "chaos", "C", "c".
- 01 LVL PIC 9 VALUE ZEROES.
- 01 ABILITIES.
- 05 STRENGTH PIC Z9.
- 05 INTELLIGENCE PIC Z9.
- 05 WISDOM PIC Z9.
- 05 CONSTITUTION PIC Z9.
- 05 DEXTERITY PIC Z9.
- 05 CHARISMA PIC Z9.
- 01 GOLD PIC ZZ9 VALUE ZEROES.
- 01 HP PIC 999 VALUE ZEROES.
- 01 OUTPUT-HP PIC ZZ9.
- 01 AC PIC 9.
- 01 WEAPON PIC X(20).
- 01 SV PIC Z9.
- 01 SP PIC Z.
- 01 OUTPUT-XP PIC ZZZ,ZZ9.
- 01 LEVELS.
- 02 LEVEL-DETAILS OCCURS 11 TIMES.
- 03 LEVEL-NO PIC 99.
- 03 LEVEL-NAME PIC X(14).
- 03 XP PIC 999999.
- 03 HD PIC 99.
- 03 HD-PLUSSES PIC 9.
- 03 SPELLS-PER-DAY PIC 9 OCCURS 6 TIMES.
- 03 SAVING-THROWS PIC 99 OCCURS 5 TIMES.
- 01 SAVES.
- 02 SAVE-NAME PIC X(26) OCCURS 5 TIMES.
- 01 ARMOR.
- 02 ARMOR-NAME PIC X(20) OCCURS 8 TIMES.
- 01 THAC0.
- 02 THAC0-DETAILS OCCURS 8 TIMES.
- 03 TARGET-AC PIC 9.
- 03 TO-HIT PIC 99 OCCURS 6 TIMES.
- 01 TURNING.
- 02 TURNING-DETAILS OCCURS 8 TIMES.
- 03 UNDEAD PIC X(8).
- 03 TO-TURN PIC X(2) OCCURS 8 TIMES.
- 01 RANDOM-SEED PIC 9V999999999.
- 01 ROLL-COUNT PIC 99 VALUE ZEROES.
- 01 N PIC 99 VALUE ZEROES.
- 01 P PIC 9 VALUE ZEROES.
- 01 Q PIC 9 VALUE ZEROES.
- 01 DICE.
- 05 D6 PIC 9.
- 05 THREE-D6 PIC 99.
- 05 ND6 PIC 999.
- 01 VAR-ROW PIC 99 VALUE ZEROES.
- 01 VAR-COL PIC 99 VALUE ZEROES.
- 01 CLS-OK PIC 9 VALUE ZERO.
- 88 IS-CLS-OK VALUES 1.
- 01 CMD-KEY PIC X VALUE SPACE.
- PROCEDURE DIVISION.
- *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
- MAIN-PROCEDURE.
- **
- * Get the player name, character name, race, class,
- * alignment, level, ac, and weapon.
- *
- * Randomly roll the abilities, gold, and hp.
- *
- * Use lookup tables to fill-in the xp, saves, spells, thac0 and
- * turn undead. Additionally, canonicalize and redisplay names of
- * the race, class, alignment, level, and armor.
- **
- PERFORM SEED-PRNG.
- PERFORM DISPLAY-SPLASH-SCREEN.
- PERFORM UNTIL CMD-KEY = 'Q' OR 'q'
- PERFORM DISPLAY-TITLE
- PERFORM GET-PLAYER-NAME
- PERFORM ROLL-ABILITIES
- PERFORM ROLL-GOLD
- PERFORM GET-CHAR-NAME
- PERFORM GET-RACE
- PERFORM GET-CLS
- PERFORM GET-ALIGN
- PERFORM GET-LEVEL
- PERFORM DISPLAY-XP
- PERFORM ROLL-HP
- PERFORM GET-AC
- PERFORM GET-WEAPON
- PERFORM DISPLAY-SAVING-THROWS
- PERFORM DISPLAY-THAC0
- PERFORM DISPLAY-SPELLS-PER-DAY
- PERFORM DISPLAY-CLERICS-VERSUS-UNDEAD
- PERFORM QUIT-OR-CONTINUE
- END-PERFORM.
- STOP RUN.
- **
- * Subroutines.
- **
- SEED-PRNG.
- ** Seed the PRNG with the current time.
- MOVE FUNCTION RANDOM(FUNCTION SECONDS-PAST-MIDNIGHT)
- TO RANDOM-SEED.
- ROLL-D6.
- MOVE ZERO TO D6.
- COMPUTE D6 = FUNCTION RANDOM() * 6 + 1.
- ROLL-ND6.
- MOVE ZEROES TO ND6.
- PERFORM VARYING ROLL-COUNT FROM 0 BY 1 UNTIL ROLL-COUNT = N
- PERFORM ROLL-D6
- ADD D6 TO ND6
- END-PERFORM.
- ROLL-3D6.
- MOVE 3 TO N.
- PERFORM ROLL-ND6.
- MOVE ND6 TO THREE-D6.
- ROLL-ABILITIES.
- DISPLAY "Strength:" LINE 5 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO STRENGTH.
- DISPLAY STRENGTH LINE 5 COL 15.
- DISPLAY "Intelligence:" LINE 6 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO INTELLIGENCE.
- DISPLAY INTELLIGENCE LINE 6 COL 15.
- DISPLAY "Wisdom:" LINE 7 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO WISDOM.
- DISPLAY WISDOM LINE 7 COL 15.
- DISPLAY "Constitution:" LINE 8 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO CONSTITUTION.
- DISPLAY CONSTITUTION LINE 8 COL 15.
- DISPLAY "Dexterity:" LINE 9 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO DEXTERITY.
- DISPLAY DEXTERITY LINE 9 COL 15.
- DISPLAY "Charisma:" LINE 10 COL 1.
- PERFORM ROLL-3D6.
- MOVE THREE-D6 TO CHARISMA.
- DISPLAY CHARISMA LINE 10 COL 15.
- ROLL-GOLD.
- DISPLAY "Gold:" LINE 12 COL 1.
- PERFORM ROLL-3D6.
- MULTIPLY THREE-D6 BY 10 GIVING GOLD.
- DISPLAY GOLD LINE 12 COL 15.
- ** Initialize Fighting-Man class data.
- INIT-F-M.
- STRING "01Veteran 0000000110000001213141516"
- "02Warrior 0020000200000001213141516"
- "03Swordsman 0040000300000001213141516"
- "04Hero 0080000400000001011121314"
- "05Swashbuckler 0160000510000001011121314"
- "06Myrmidon 0320000600000001011121314"
- "07Champion 0640000710000000809101012"
- "08Superhero 1200000820000000809101012"
- "09Lord 2400000930000000809101012"
- "10 0000001010000000607080810"
- "11 0000000000000000000000000"
- INTO LEVELS.
- MOVE "Fighting-Man" TO CLS.
- ** Initialize Magic-User class data.
- INIT-M-U.
- STRING "01Medium 0000000101000001314131615"
- "02Seer 0025000112000001314131615"
- "03Conjurer 0050000203100001314131615"
- "04Theurgist 0100000214200001314131615"
- "05Thaumaturgist 0200000304210001314131615"
- "06Magician 0350000314220001112111412"
- "07Enchanter 0500000404321001112111412"
- "08Warlock 0750000504332001112111412"
- "09Sorcerer 1000000614332101112111412"
- "10Necromancer 2000000704433201112111412"
- "11Wizard 3000000814443300809081108"
- INTO LEVELS.
- MOVE "Magic-User " TO CLS.
- ** Initialize Cleric class data.
- INIT-CLERIC.
- STRING "01Acolyte 0000000100000001112141615"
- "02Adept 0015000201000001112141615"
- "03Village Priest0030000302000001112141615"
- "04Vicar 0060000402100001112141615"
- "05Curate 0120000412200000910121412"
- "06Bishop 0250000502211000910121412"
- "07Lama 0500000602221100910121412"
- "08Patriarch 1000000702222200910121412"
- "09 0000000713332200607091109"
- "10 0000000723333300607091109"
- "11 0000000000000000000000000"
- INTO LEVELS.
- MOVE "Cleric " TO CLS.
- INIT-THAC0.
- STRING "9100805030101"
- "8110906040201"
- "7121007050301"
- "6131108060401"
- "5141209070502"
- "4151310080603"
- "3161411090704"
- "2171512100805"
- INTO THAC0.
- INIT-TURNING.
- STRING "Skeleton 7 T T D D D D D"
- "Zombie 9 7 T T D D D D"
- "Ghoul 11 9 7 T T D D D"
- "Wight N11 9 7 T T D D"
- "Wraith N N11 9 7 T T D"
- "Mummy N N N11 9 7 T T"
- "Spectre N N N N11 9 7 T"
- "Vampire N N N N N11 9 7"
- INTO TURNING.
- INIT-SAVES.
- STRING "Death Ray or Poison "
- "All Wands "
- "Stone "
- "Dragon Breath "
- "Staves & Spells "
- INTO SAVES.
- INIT-ARMOR.
- STRING "No Armor or Shield "
- "Shield Only "
- "Leather Armor "
- "Leather & Shield "
- "Chain Mail "
- "Chain Mail & Shield "
- "Plate Armor "
- "Plate Armor & Shield"
- INTO ARMOR.
- INIT-SPLASH-SCREEN.
- STRING " __________________________________ "
- " "
- "/ DUNGEONS & DRAGONS(TM) character \ "
- " "
- "\ generator, original 1974 ed. / "
- " "
- " ---------------------------------- "
- " "
- " \ / \ //\ "
- " "
- " \ |\___/| / \// \\ "
- " "
- " /0 0 \__ / // | \ \ "
- " "
- " / / \/_/ // | \ \"
- " "
- " @_^_@'/ \/_ // | \ "
- " \ "
- " //_^_/ \/_ // | \ "
- " \ "
- " ( //) | \/// | \"
- " \ "
- " ( / /) _|_ / ) // | "
- "\ _\ "
- " ( // /) '/,_ _ _/ ( ; -. | _ "
- "_\.-~ .-~~~^-. "
- " (( / / )) ,-{ _ `-.|.-~-. "
- " .~ `. "
- " (( // / )) '/\ / "
- "~-. _ .-~ .-~^-. \ "
- " (( /// )) `. { } "
- " / \ \ "
- " (( / )) .----~-.\ \-' "
- " .~ \ `. \^-. "
- " ///.----..> \ "
- " _ -~ `. ^-` ^-_ "
- " ///-._ _ _ _ _ _ _}^ - - "
- "span class="sy0"> - - ~ ~-- ,.-~ "
- " DUNGEONS & DRAGONS(TM) and D&D(TM) are"
- " trademarks of Wizards of the Coast. "
- " And D&D(TM) core rules, game mechanics"
- ", characters and their distinctive "
- " likenesses are the property of the Wiz"
- "ards of the Coast. For more information "
- " about Wizards of the Coast or any of W"
- "izards' trademarks or other "
- " intellectual property, please visit th"
- "eir website at (www.wizards.com). "
- INTO SPLASH-SCREEN.
- DISPLAY-SPLASH-SCREEN.
- PERFORM INIT-SPLASH-SCREEN.
- DISPLAY SPACE WITH BLANK SCREEN.
- PERFORM VARYING VAR-ROW FROM 1 BY 1 UNTIL VAR-ROW = 25
- DISPLAY SPLASH-SCREEN-DETAILS(VAR-ROW) LINE VAR-ROW COL 1
- END-PERFORM.
- DISPLAY "PRESS ANY KEY TO CONTINUE!" LINE 5 COL 50
- WITH BLINK REVERSE-VIDEO.
- ACCEPT CMD-KEY LINE 5 COL 76.
- MOVE SPACE TO CMD-KEY.
- DISPLAY-TITLE.
- DISPLAY SPACE WITH BLANK SCREEN.
- DISPLAY "DUNGEONS & DRAGONS(TM)" LINE 1 COL 31.
- GET-PLAYER-NAME.
- DISPLAY "Player's Name:" LINE 3 COL 1.
- ACCEPT PLAYER-NAME LINE 3 COL 16.
- GET-CHAR-NAME.
- DISPLAY "Character's Name:" LINE 3 COL 40.
- ACCEPT CHAR-NAME LINE 3 COL 58.
- GET-RACE.
- DISPLAY "Race:" LINE 5 COL 40.
- ACCEPT RACE LINE 5 COL 50.
- ** Canonicalize race.
- EVALUATE TRUE
- WHEN IS-HUMAN MOVE "Human " TO RACE
- WHEN IS-ELF MOVE "Elf " TO RACE
- WHEN IS-DWARF MOVE "Dwarf " TO RACE
- WHEN IS-HOBBIT MOVE "Hobbit" TO RACE
- END-EVALUATE.
- DISPLAY RACE LINE 5 COL 50.
- GET-CLS.
- ** Make sure class allowed for given race.
- ** Human: any class. Elf: F-M or M-U. Dwarf/Hobbit: F-M only.
- DISPLAY "Class:" LINE 6 COL 40.
- IF IS-DWARF OR IS-HOBBIT THEN
- PERFORM INIT-F-M
- ELSE
- ACCEPT CLS LINE 6 COL 50
- PERFORM UNTIL IS-CLS-OK
- IF IS-ELF AND IS-CLERIC THEN
- DISPLAY "An elf must be a fighting-man"
- LINE 6 COL 50
- DISPLAY "or magic-user. Press any key "
- LINE 7 COL 50
- DISPLAY "to continue. "
- LINE 8 COL 50
- ACCEPT CMD-KEY LINE 8 COL 64
- PERFORM VARYING VAR-ROW FROM 6 BY 1 UNTIL VAR-ROW = 9
- DISPLAY " "
- LINE VAR-ROW COL 50
- END-PERFORM
- DISPLAY "Class:" LINE 6 COL 40
- ACCEPT CLS LINE 6 COL 50
- ELSE
- MOVE 1 TO CLS-OK
- END-IF
- END-PERFORM
- EVALUATE TRUE
- WHEN IS-F-M PERFORM INIT-F-M
- WHEN IS-M-U PERFORM INIT-M-U
- WHEN IS-CLERIC PERFORM INIT-CLERIC
- END-EVALUATE
- END-IF.
- DISPLAY CLS LINE 6 COL 50.
- GET-ALIGN.
- DISPLAY "Align:" LINE 7 COL 40.
- ACCEPT ALIGN LINE 7 COL 50.
- ** Canonicalize alignment.
- EVALUATE TRUE
- WHEN IS-LAW MOVE "Law " TO ALIGN
- WHEN IS-NEUTRALITY MOVE "Neutrality" TO ALIGN
- WHEN IS-CHAOS MOVE "Chaos " TO ALIGN
- END-EVALUATE.
- DISPLAY ALIGN LINE 7 COL 50.
- GET-LEVEL.
- DISPLAY "Level:" LINE 8 COL 40.
- ACCEPT LVL LINE 8 COL 50.
- DISPLAY LEVEL-NAME OF LEVEL-DETAILS(LVL) LINE 8 COL 52.
- DISPLAY-XP.
- DISPLAY "XP:" LINE 9 COL 40.
- ** Left-justify XP
- IF XP(LVL) < 10000 THEN
- MOVE 48 TO VAR-COL
- ELSE
- IF XP(LVL) < 100000 THEN
- MOVE 49 TO VAR-COL
- ELSE
- MOVE 50 TO VAR-COL
- END-IF
- END-IF.
- MOVE XP(LVL) TO OUTPUT-XP.
- DISPLAY OUTPUT-XP LINE 9 COL VAR-COL.
- ROLL-HP.
- MOVE HD OF LEVEL-DETAILS(LVL) TO N.
- MOVE HD-PLUSSES OF LEVEL-DETAILS(LVL) TO P.
- PERFORM ROLL-ND6.
- COMPUTE HP = ND6 + P.
- ** Left-justify HP by determining how many digits it has.
- IF HP LESS THAN 10 THEN
- MOVE 48 TO VAR-COL
- ELSE
- IF HP LESS THAN 100 THEN
- MOVE 49 TO VAR-COL
- ELSE
- MOVE 50 TO VAR-COL
- END-IF
- END-IF.
- DISPLAY "HP:" LINE 10 COL 40.
- MOVE HP TO OUTPUT-HP.
- DISPLAY OUTPUT-HP LINE 10 COL VAR-COL.
- GET-AC.
- DISPLAY "AC:" LINE 11 COL 40.
- ACCEPT AC LINE 11 COL 50.
- PERFORM INIT-ARMOR.
- COMPUTE P = 10 - AC.
- DISPLAY ARMOR-NAME(P) LINE 11 COL 52.
- GET-WEAPON.
- DISPLAY "Weapon:" LINE 12 COL 40.
- ACCEPT WEAPON LINE 12 COL 50.
- DISPLAY-SAVING-THROWS.
- PERFORM INIT-SAVES.
- DISPLAY "====Saving Throws============" LINE 14 COL 1.
- MOVE 15 TO VAR-ROW.
- PERFORM VARYING N FROM 1 BY 1 UNTIL N = 6
- MOVE SAVING-THROWS(LVL,N) TO SV
- DISPLAY SV LINE VAR-ROW COL 1
- DISPLAY SAVE-NAME(N) LINE VAR-ROW COL 4
- ADD 1 TO VAR-ROW
- END-PERFORM.
- DISPLAY-SPELLS-PER-DAY.
- IF IS-M-U OR IS-CLERIC THEN
- DISPLAY "====Spells Per Day=========" LINE 18 COL 40
- DISPLAY "Lvl 1 2 3 4 5 6" LINE 19 COL 40
- DISPLAY "#Sp" LINE 20 COL 40
- PERFORM VARYING N FROM 1 BY 1 UNTIL N = 7
- MOVE SPELLS-PER-DAY(LVL, N) TO SP
- COMPUTE VAR-COL = 4 * N + 42
- DISPLAY SP LINE 20 COL VAR-COL
- END-PERFORM
- END-IF.
- DISPLAY-THAC0.
- PERFORM INIT-THAC0.
- DISPLAY "====THAC0==========================" LINE 14 COl 40.
- DISPLAY "AC 9 8 7 6 5 4 3 2" LINE 15 COL 40.
- EVALUATE TRUE
- WHEN IS-F-M MOVE 3 TO P
- WHEN IS-M-U MOVE 5 TO P
- WHEN IS-CLERIC MOVE 4 TO P
- END-EVALUATE.
- SUBTRACT 1 FROM LVL.
- DIVIDE LVL BY P GIVING Q.
- ADD 1 TO Q.
- ADD 1 TO LVL.
- MOVE 45 TO VAR-COL.
- PERFORM VARYING N FROM 1 BY 1 UNTIL N = 9
- MOVE TO-HIT(N, Q) TO SV
- DISPLAY SV LINE 16 COL VAR-COL
- ADD 4 TO VAR-COL
- END-PERFORM.
- DISPLAY-CLERICS-VERSUS-UNDEAD.
- IF IS-CLERIC THEN
- PERFORM INIT-TURNING
- DISPLAY "====Clerics vs Undead================="
- LINE 21 COl 1
- MOVE 22 TO VAR-ROW
- MOVE 1 TO VAR-COL
- PERFORM VARYING P FROM 1 BY 1 UNTIL P = 9
- IF P = 5 THEN
- MOVE 23 TO VAR-ROW
- MOVE 1 TO VAR-COL
- END-IF
- DISPLAY TO-TURN(P,LVL) LINE VAR-ROW COL VAR-COL
- ADD 3 TO VAR-COL
- DISPLAY UNDEAD(P) LINE VAR-ROW COL VAR-COL
- ADD 9 TO VAR-COL
- END-PERFORM
- END-IF.
- QUIT-OR-CONTINUE.
- DISPLAY "Quit = Q" LINE 22 COL 65.
- DISPLAY "Re-roll = R" LINE 23 COL 65.
- DISPLAY "===> Enter key" LINE 24 COL 60.
- ACCEPT CMD-KEY LINE 24 COL 75.
- END PROGRAM ODDSHEET.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement