UNIT GetMagic;

interface

Procedure GetCharacterMagic;



implementation

uses

  crt,

  rolldice;

type

  NumItemsArray = array[1..13, 1..4] of integer;

  ClassGroup = (WARRIOR, WIZARD, PRIEST, ROGUE);

var

  level: 1..13;

  class: 1..4;

  table: 1..4;

const

  ClassGroupString: array[1..4] of string =

    ('WARRIOR', 'WIZARD', 'PRIEST', 'ROGUE');

  NumMagicInTable: array[1..4] of integer = (20, 16, 16, 12);

  NumItems: NumItemsArray = (

    (1, 0, 0, 0),

    (2, 0, 0, 0),

    (2, 1, 0, 0),

    (2, 1, 0, 0),

    (2, 1, 0, 0),

    (3, 2, 0, 0),

    (3, 2, 1, 0),

    (3, 2, 1, 0),

    (3, 2, 1, 0),

    (3, 2, 1, 0),

    (3, 2, 1, 1),

    (3, 2, 1, 1),

    (3, 2, 1, 1));



  ChanceItem: array[1..13, 1..4] of integer = (

    (10, 0, 0, 0),

    (20, 0, 0, 0),

    (30, 10, 0, 0),  {3rd}

    (40, 20, 0, 0),

    (50, 30, 0, 0),

    (60, 40, 0, 0),  {6th}

    (70, 50, 10, 0),

    (80, 60, 20, 0),

    (90, 70, 30, 0),  {9th}

    (100, 80, 40, 0),

    (100, 90, 50, 10),

    (100, 100, 60, 20),

    (100, 100, 100, 60));



  Magic: array[1..4, 1..20] of string = (

    {Table 1}

    ('1 spell: level 1-6',

     '2 spells: level 1-4',

     '2 potions: climbing and flying',

     '2 potions: extra-healing and polymorph self',

     '2 potions: fire resistance and speed',

     '2 potions: healing and giant strength',

     '2 potions: heroism and invulnerability',

     '2 potions: human control and levitation',

     '2 potions: super-heroism and animal control',

     'scroll: protection from magic',

     'ring of mammal control',

     'ring of protection +1',

     '10 arrows +1',

     'shield +1',

     'sword +1 (no special abilities)',

     'leather armor +1',

     '4 bolts +2',

     'dagger +1',

     'javelin +2',

     'mace +1'),



    {Table 2}

    ('scroll of 3 spells levels 2-9 or 2-7',

     '2 rings: fire resistance and invisibility',

     'ring of protection +3',

     'staff of striking',

     'wand of illusion',

     'wand of negation',

     'bracers of defense, armor class 4',

     'brooch of shielding',

     'cloak of elvenkind',

     'dust of appearance',

     'Figurine of Wondrous Power:  serpentine owl',

     '3 javelins of lightning',

     'chainmail +1 and shield +2',

     'splint mail +4',

     'sword +3 (no special abilities)',

     'crossbow of speed and +2 hammer',

     '*',

     '*',

     '*',

     '*'),



    {Table 3}

    ('ring of spell storing',

     'Rod of Cancellation',

     'staff of the serpent, python or adder',

     'Bag of Tricks',

     'Boots of Speed',

     'Boots of Striding and Leaping',

     'Cloak of Displacement',

     'Gauntlets of Ogre Power',

     'Pipe of the Sewers',

     'Robe of Blending',

     '2 ropes:  climbing, entanglement',

     'plate mail +3 and shield +2',

     'shield +5',

     'sword: +4 defender',

     'mace +3',

     'spear +3',

     '*',

     '*',

     '*',

     '*'),



    {Table 4}

    ('Ring of Djinni Summoning',

     'Ring of Spell Turning',

     'Rod of Smiting',

     'Wand of Fire',

     'cube of force',

     'eyes of charming',

     'Horn of Valhalla',

     'Robe of Scintillating Colors',

     'Talisman of either Ultimate Evil or Pure Good',

     'Plate mail +4 and shield +3',

     'sword of wounding',

     'arrow of slaying (select character type)',

     '*',

     '*',

     '*',

     '*',

     '*',

     '*',

     '*',

     '*'));



  allowed: array[1..4, 1..4, 1..20] of char = (

    {array[classgroup, table, item}

    ({Warrior Table 1}

    ('n','n','y','y','y',

     'y','y','y','y','y',

     'y','y','y','y','y',

     'y','y','y','y','y'),

    {Warrior Table 2}

    ('n','y','y','n','n',

     'y','n','n','y','y',

     'y','y','y','y','y',

     'y','*','*','*','*'),

    {Warrior Table 3}

    ('y','y','n','y','y',

     'y','y','y','n','y',

     'y','y','y','y','y',

     'y','*','*','*','*'),

    {Warrior Table 4}

    ('y','y','n','n','y',

     'n','y','n','n','y',

     'y','y','*','*','*',

     '*','*','*','*','*')),

    ({Wizard Table 1}

    ('y','y','y','y','y',

     'n','n','y','n','y',

     'y','y','n','n','n',

     'n','n','n','n','n'),

    {Wizard Table 2}

    ('y','y','y','y','y',

     'y','y','y','y','y',

     'y','n','n','n','n',

     'n','*','*','*','*'),

    {Wizard Table 3}

    ('y','y','n','y','y',

     'y','y','n','y','y',

     'y','n','n','n','n',

     'n','*','*','*','*'),

    {Wizard Table 4}

    ('y','y','y','y','y',

     'y','y','y','n','n',

     'n','n','*','*','*',

     '*','*','*','*','*')),

    ({Priest Table 1}

    ('y','y','y','y','y',

     'n','n','y','n','y',

     'y','y','n','y','n',

     'y','n','n','n','y'),

    {Priest Table 2}

    ('y','y','y','y','n',

     'y','y','y','y','y',

     'y','n','y','y','n',

     'n','*','*','*','*'),

    {Priest Table 3}

    ('y','y','y','y','y',

     'y','y','y','y','y',

     'y','y','y','n','y',

     'n','*','*','*','*'),

    {Priest Table 4}

    ('y','y','y','n','y',

     'n','y','y','y','y',

     'n','n','*','*','*',

     '*','*','*','*','*')),

    ({Rogue Table 1}

    ('n','n','y','y','y',

     'n','n','y','n','y',

     'y','y','n','y','y',

     'y','y','y','n','n'),

    {Rogue Table 2}

    ('n','y','y','n','n',

     'y','y','y','y','y',

     'y','n','n','n','n',

     'n','*','*','*','*'),

    {Rogue Table 3}

    ('y','y','n','y','y',

     'y','y','y','y','y',

     'y','n','n','y','n',

     'n','*','*','*','*'),

    {Rogue Table 4}

    ('y','y','n','n','y',

     'n','y','n','n','n',

     'y','n','*','*','*',

     '*','*','*','*','*')));



{***************************************************************************}

procedure PickMagic;

{***************************************************************************}

const

  BlankLine: string[79] = '                                                                               ';

var

  Checker: char;

  RollofDice: integer;

begin

  repeat

    repeat

      RollofDice := Roll(1, NumMagicInTable[table], 0);

    until allowed[class, table, RollofDice] = 'y';

    writeln(magic[table, RollofDice]);

    write('Reroll (due to repeats, two sets of armor, etc.) (y/<n>)?:  ');

    checker := UpCase(ReadKey);

    if not(checker in ['Y','N']) then

      checker := 'N';

    if checker = 'Y' then

      begin

        gotoXY(1, WhereY - 1);

        writeln(BlankLine);

        writeln(BlankLine);

        GotoXY(1, WhereY - 2);

      end {if}

    else

      begin

        gotoXY(1, WhereY);

        writeln(BlankLine);

        gotoXY(1, WhereY - 1);

      end;

  until checker = 'N';

end;



{***************************************************************************}

procedure RollMagic;

{***************************************************************************}

var

  a: integer;

  RollofDice: integer;

begin

  for table := 4 downto 1 do

    for a := 1 to NumItems[level, table] do

      begin

        RollofDice := Roll(1,100,0);

        if RollofDice <= ChanceItem[level, table] then

          PickMagic;

      end;

end;



{***************************************************************************}

Procedure GetStats;

{***************************************************************************}

var

  a: integer;

begin

  clrscr;

  repeat

    write('Level (1 - 13):  ');

    readln(level);

  until level in [1..13];

  for a := 1 to 4 do

    writeln(a,') ',ClassGroupString[a]);

  repeat

    write('Class Group:  ');

    readln(class);

  until class in [1..4];

  writeln;

end;



{***************************************************************************}

procedure Intro;

{***************************************************************************}

begin

  clrscr;

  writeln('This program generates magic items for character encounters');

  writeln('as per the Fiend Folio.  You should write the magic items down');

  writeln('as they are not stored anywhere once you leave the screen.');

  writeln;

  writeln('Hit any key to begin . . .');

  repeat

  until ReadKey <> '';

end;



{***************************************************************************}

Procedure GetCharacterMagic;

{***************************************************************************}

var

  quitter: char;

begin

  Intro;

  repeat

    GetStats;

    RollMagic;

    writeln;

    writeln('Enter "Q" to quit, anything else to continue . . .');

    quitter := upcase(ReadKey);

  until quitter = 'Q';

end; {procedure}



END. {unit}