home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / INSTCHAR.ZIP / CHAR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-10-02  |  20.1 KB  |  880 lines
  1. (****************************************************************************)
  2. (***                                                                      ***)
  3. (*** First I must apologize for the sloppiness of this code.  :)  I did   ***)
  4. (*** it late one night when someone asked me for it in the AD&D echo.     ***)
  5. (*** I wouldn't have included the source code if it wasn't as small as it ***)
  6. (*** is.  I really hope this helps someone's game and make it faster.     ***)
  7. (*** That's the basic idea for all of my programs.  In this ZIP, you will ***)
  8. (*** find there are 2 files: CHAR.PAS (pascal source code), and CHAR.EXE  ***)
  9. (*** (basic executable program).                                          ***)
  10. (***    Since this is the first version of the program, I would appreciate***)
  11. (*** it if you would send me mail in the AD&D echo with all of your       ***)
  12. (*** comments, questions, suggestions, and bug reports.  I hope to inprove***)
  13. (*** this to YOUR tastes.  Happy gaming!                                  ***)
  14. (***                                                                      ***)
  15. (*** Dan Vanderboom                                                       ***)
  16. (***                                                                      ***)
  17. (****************************************************************************)
  18.  
  19. Program CharMaker;
  20.  
  21. Uses TpCrt,TpString,TpPick,DVRandom;
  22.  
  23. Var
  24.    Choice:Word;
  25.    Race,Class:Integer;
  26.    MinAttr:Array[1..6] Of Integer;
  27.    MaxAttr:Array[1..6] Of Integer;
  28.    Attr:Array[1..6] Of Integer;
  29.    Age:Integer;
  30.    T:Integer;
  31.    F:Text;
  32.    Cas:String[30];
  33.    Created:Boolean;
  34.  
  35. Const
  36.    WindowCol:PickColorArray = (15,12,0,13,15,15);
  37.  
  38. Procedure NewSpace;
  39. Var
  40.    I:Integer;
  41. Begin
  42.    GotoXy(1,6);
  43.    For I := 1 To 10 Do WriteLn;
  44. End;
  45.  
  46. Procedure Strength;
  47. Begin
  48.    Write(F,'Str: ',Attr[1]);
  49.    If Attr[1] < 10 Then Write(F,'  ') Else Write(F,' ');
  50.  
  51.    Write(F,'Hit Prob: ');
  52.    T := 0;
  53.    Case Attr[1] Of
  54.       2..3:T := -3;
  55.       4..5:T := -2;
  56.       6..7:T := -1;
  57.       17..18:T := 1;
  58.    End;
  59.    If T = 0 Then Write(F,'0');
  60.    If T > 0 Then Write(F,'+',T);
  61.    If T < 0 Then Write(F,T);
  62.  
  63.    Write(F,', Damage Adj: ');
  64.    T := 0;
  65.    Case Attr[1] Of
  66.       2:T := -2;
  67.       3..5:T := -1;
  68.       16..17:T := 1;
  69.       18:T := 3;
  70.    End;
  71.    If T = 0 Then Write(F,'0');
  72.    If T > 0 Then Write(F,'+',T);
  73.    If T < 0 Then Write(F,T);
  74.  
  75.    Write(F,', Open Doors: ');
  76.    T := 0;
  77.    Case Attr[1] Of
  78.       2:T := 1;
  79.       3:T := 2;
  80.       4..5:T := 3;
  81.       6..7:T := 4;
  82.       8..9:T := 5;
  83.       10..11:T := 6;
  84.       12..13:T := 7;
  85.       14..15:T := 8;
  86.       16:T := 9;
  87.       17:T := 10;
  88.       18:T := 11;
  89.    End;
  90.    Write(F,T);
  91.  
  92.    Write(F,', Bend Bars/LG: ');
  93.    T := 0;
  94.    Case Attr[1] Of
  95.       8..9:T := 1;
  96.       10..11:T := 2;
  97.       12..13:T := 4;
  98.       14..15:T := 7;
  99.       16:T := 10;
  100.       17:T := 13;
  101.       18:T := 16;
  102.    End;
  103.    WriteLn(F,T,'%');
  104. End;
  105.  
  106. Procedure Dexterity;
  107. Begin
  108.    Write(F,'Dex: ',Attr[2]);
  109.    If Attr[2] < 10 Then Write(F,'  ') Else Write(F,' ');
  110.  
  111.    Write(F,'Reaction Adj: ');
  112.    T := 0;
  113.    Case Attr[2] Of
  114.       3:T := -3;
  115.       4:T := -2;
  116.       5:T := -1;
  117.       16:T := 1;
  118.       17..18:T := 2;
  119.       19:T := 3;
  120.    End;
  121.    If T = 0 Then Write(F,'0');
  122.    If T > 0 Then Write(F,'+',T);
  123.    If T < 0 Then Write(F,T);
  124.  
  125.    Write(F,', Missile Attack Adj: ');
  126.    If T = 0 Then Write(F,'0');
  127.    If T > 0 Then Write(F,'+',T);
  128.    If T < 0 Then Write(F,T);
  129.  
  130.    Write(F,', Defensive Adj: ');
  131.    T := 0;
  132.    Case Attr[2] Of
  133.       3:T := 4;
  134.       4:T := 3;
  135.       5:T := 2;
  136.       6:T := 1;
  137.       15:T := -1;
  138.       16:T := -2;
  139.       17:T := -3;
  140.       18..19:T := -4;
  141.    End;
  142.    If T = 0 Then WriteLn(F,'0');
  143.    If T > 0 Then WriteLn(F,'+',T);
  144.    If T < 0 Then WriteLn(F,T);
  145. End;
  146.  
  147. Procedure Constitution;
  148. Begin
  149.    Write(F,'Con: ',Attr[3]);
  150.    If Attr[3] < 10 Then Write(F,'  ') Else Write(F,' ');
  151.  
  152.    Write(F,'HP Adj: ');
  153.    T := 2;
  154.    Case Attr[3] Of
  155.       2..3:T := -2;
  156.       4..6:T := -1;
  157.       7..14:T := 0;
  158.       15:T := 1;
  159.       16:T := 2;
  160.       17:If Class In [1..3] Then T := 3;
  161.       18:If Class In [1..3] Then T := 4;
  162.       19:If Class In [1..3] Then T := 5;
  163.    End;
  164.    If T >= 1 Then Write(F,'+',T) Else Write(F,T);
  165.    Write(F,', System Shock: ');
  166.    T := 0;
  167.    Case Attr[3] Of
  168.       2:T := 20;
  169.       3:T := 25;
  170.       4:T := 30;
  171.       5:T := 35;
  172.       6:T := 40;
  173.       7:T := 45;
  174.       8:T := 50;
  175.       9:T := 55;
  176.       10:T := 60;
  177.       11:T := 65;
  178.       12:T := 70;
  179.       13:T := 75;
  180.       14:T := 88;
  181.       15:T := 90;
  182.       16:T := 95;
  183.       17:T := 97;
  184.       18:T := 99;
  185.       19:T := 99;
  186.    End;
  187.    Write(F,T,'%');
  188.  
  189.    Write(F,', Resur Survival: ');
  190.    T := 0;
  191.    Case Attr[3] Of
  192.       2:T := 35;
  193.       3:T := 40;
  194.       4:T := 45;
  195.       5:T := 50;
  196.       6:T := 55;
  197.       7:T := 60;
  198.       8:T := 65;
  199.       9:T := 70;
  200.       10:T := 75;
  201.       11:T := 80;
  202.       12:T := 85;
  203.       13:T := 90;
  204.       14:T := 92;
  205.       15:T := 94;
  206.       16:T := 96;
  207.       17:T := 98;
  208.       18:T := 100;
  209.       19:T := 100;
  210.    End;
  211.    Write(F,T,'%');
  212.  
  213.    Write(F,', Poison Save: ');
  214.    T := 0;
  215.    Case Attr[3] Of
  216.       2:T := -1;
  217.       19:T := 1;
  218.    End;
  219.    If T >= 1 Then WriteLn(F,'+',T) Else WriteLn(F,T);
  220. End;
  221.  
  222. Procedure Intelligence;
  223. Begin
  224.    Write(F,'Int: ',Attr[4]);
  225.    If Attr[4] < 10 Then Write(F,'  ') Else Write(F,' ');
  226.  
  227.    Write(F,'Languages: ');
  228.    T := 0;
  229.    Case Attr[4] Of
  230.       3..8:T := 1;
  231.       9..11:T := 2;
  232.       12,13:T := 3;
  233.       14,15:T := 4;
  234.       16:T := 5;
  235.       17:T := 6;
  236.       18:T := 7;
  237.       19:T := 8;
  238.    End;
  239.    Write(F,T);
  240.  
  241.    Write(F,', Spell Level: ');
  242.    T := 0;
  243.    Case Attr[4] Of
  244.       9:T := 4;
  245.       10,11:T := 5;
  246.       12,13:T := 6;
  247.       14,15:T := 7;
  248.       16,17:T := 8;
  249.       18,19:T := 9;
  250.    End;
  251.    Write(F,T,'th');
  252.  
  253.    Write(F,', Learn Spell: ');
  254.    T := 0;
  255.    Case Attr[4] Of
  256.       9:T := 35;
  257.       10:T := 40;
  258.       11:T := 45;
  259.       12:T := 50;
  260.       13:T := 55;
  261.       14:T := 60;
  262.       15:T := 65;
  263.       16:T := 70;
  264.       17:T := 75;
  265.       18:T := 85;
  266.       19:T := 95;
  267.    End;
  268.    Write(F,T,'%');
  269.  
  270.    Write(F,', Max Spells/Level: ');
  271.    T := 0;
  272.    Case Attr[4] Of
  273.       9:T := 6;
  274.       10..12:T := 7;
  275.       13,14:T := 9;
  276.       15,16:T := 11;
  277.       17:T := 14;
  278.       18:T := 18;
  279.       19:T := -1;
  280.    End;
  281.    If T > 0 Then WriteLn(F,T) Else WriteLn(F,'All');
  282. End;
  283.  
  284. Procedure Wisdom;
  285. Begin
  286.    Write(F,'Wis: ',Attr[5]);
  287.    If Attr[5] < 10 Then Write(F,'  ') Else Write(F,' ');
  288.  
  289.    Write(F,'Magic Defense Adj: ');
  290.    T := 0;
  291.    Case Attr[5] Of
  292.       2:T := -4;
  293.       3:T := -3;
  294.       4:T := -2;
  295.       5..7:T := -1;
  296.       15:T := 1;
  297.       16:T := 2;
  298.       17:T := 3;
  299.       18:T := 4;
  300.    End;
  301.    If T >= 1 Then Write(F,'+',T) Else Write(F);
  302.  
  303.    Write(F,', Bonus Spells: ');
  304.    T := 0;
  305.    Case Attr[5] Of
  306.       13,14:T := 1;
  307.       15,16:T := 2;
  308.       17:T := 3;
  309.       18:T := 4;
  310.    End;
  311.    Write(F,T);
  312.    Case T Of
  313.       1:Write(F,'st');
  314.       2:Write(F,'nd');
  315.       3:Write(F,'rd');
  316.       4:Write(F,'th');
  317.    End;
  318.  
  319.    Write(F,', Spell Failure: ');
  320.    T := 0;
  321.    Case Attr[5] Of
  322.       2:T := 60;
  323.       3:T := 50;
  324.       4:T := 45;
  325.       5:T := 40;
  326.       6:T := 35;
  327.       7:T := 30;
  328.       8:T := 25;
  329.       9:T := 20;
  330.       10:T := 15;
  331.       11:T := 10;
  332.       12:T := 5;
  333.    End;
  334.    WriteLn(F,T,'%');
  335. End;
  336.  
  337. Procedure Charisma;
  338. Begin
  339.    Write(F,'Cha: ',Attr[6]);
  340.    If Attr[6] < 10 Then Write(F,'  ') Else Write(F,' ');
  341.  
  342.    Write(F,'Max # Henchmen: ');
  343.    T := 1;
  344.    Case Attr[6] Of
  345.       5,6:T := 2;
  346.       7,8:T := 3;
  347.       9..11:T := 4;
  348.       12,13:T := 5;
  349.       14:T := 6;
  350.       15:T := 7;
  351.       16:T := 8;
  352.       17:T := 10;
  353.       18:T := 15;
  354.    End;
  355.    Write(F,T);
  356.  
  357.    Write(F,', Loyalty Base: ');
  358.    T := 0;
  359.    Case Attr[6] Of
  360.       2:T := -7;
  361.       3:T := -6;
  362.       4:T := -5;
  363.       5:T := -4;
  364.       6:T := -3;
  365.       7:T := -2;
  366.       8:T := -1;
  367.       14:T := 1;
  368.       15:T := 3;
  369.       16:T := 4;
  370.       17:T := 6;
  371.       18:T := 8;
  372.    End;
  373.    If T >= 1 Then Write(F,'+',T) Else Write(F,T);
  374.  
  375.    Write(F,', Reaction Adj: ');
  376.    T := 0;
  377.    Case Attr[6] Of
  378.       2:T := -6;
  379.       3:T := -5;
  380.       4:T := -4;
  381.       5:T := -3;
  382.       6:T := -2;
  383.       7:T := -1;
  384.       13:T := 1;
  385.       14:T := 2;
  386.       15:T := 3;
  387.       16:T := 5;
  388.       17:T := 6;
  389.       18:T := 7;
  390.    End;
  391.    If T >= 1 Then Write(F,'+',T) Else Write(F,T);
  392. End;
  393.  
  394. Procedure SpecialAbilities;
  395. Begin
  396.    WriteLn(F);
  397.    WriteLn(F,Center('Special Abilities',78));
  398.    WriteLn(F,CharStr(#205,78));
  399.    WriteLn(F);
  400.    Case Race Of
  401.       2:; { Elf }                  (* Not done here yet... *)
  402.       3:; { Half-Elf }
  403.       4:; { Halfling }
  404.       5:; { Dwarf }
  405.       6:; { Gnome }
  406.    End;
  407. End;
  408.  
  409. Procedure Misc;
  410. Begin
  411.    WriteLn(F);
  412.    WriteLn(F,Center('Weapons',78));
  413.    WriteLn(F,'    Name             ROF    Weight      Damage      Range    Location');
  414.    WriteLn(F,CharStr(#205,78));
  415.    WriteLn(F);
  416.    WriteLn(F);
  417.    WriteLn(F,Center('Armor',78));
  418.    WriteLn(F,'    Name           AC       Weight');
  419.    WriteLn(F,CharStr(#205,78));
  420.    WriteLn(F);
  421.    WriteLn(F);
  422.    WriteLn(F,Center('Magical Items',78));
  423.    WriteLn(F,'    Name                 Damage/Charges     Location');
  424.    WriteLn(F,CharStr(#205,78));
  425.    WriteLn(F);
  426.    WriteLn(F);
  427.    WriteLn(F,Center('Micellaneous Equipment',78));
  428.    WriteLn(F,'    Item           Weight    Location         Other');
  429.    WriteLn(F,CharStr(#205,78));
  430.    WriteLn(F);
  431.    WriteLn(F);
  432.    WriteLn(F,Center('Clothing',78));
  433.    WriteLn(F,'    Item           Weight    Location         Description');
  434.    WriteLn(F,CharStr(#205,78));
  435.    WriteLn(F);
  436.    WriteLn(F);
  437.    WriteLn(F,Center('Livestock',78));
  438.    WriteLn(F,'    Name       Type           THAC0   AC   ATT    DMG     HP    Movement');
  439.    WriteLn(F,CharStr(#205,78));
  440.    WriteLn(F);
  441.    WriteLn(F);
  442.    WriteLn(F,Center('Food',78));
  443.    WriteLn(F,'    Item              Amount       Location');
  444.    WriteLn(F,CharStr(#205,78));
  445.    WriteLn(F);
  446.    WriteLn(F);
  447.    WriteLn(F,Center('Treasure',78));
  448.    WriteLn(F,'    Type      Amount      Weight       Location');
  449.    WriteLn(F,CharStr(#205,78));
  450.    WriteLn(F);
  451.    WriteLn(F);
  452. End;
  453.  
  454. Procedure Create;
  455. Var
  456.    I,H1,H2:Integer;
  457.    Per:Integer;
  458.    HP:Integer;
  459.    Height,Weight:Integer;
  460.    Male:Boolean;
  461.    MF:Char;
  462.    S,SL:Integer;
  463.    Filename:String[14];
  464. Begin
  465.    Created := True;
  466.    Write('(M)ale or (F)emale? ');
  467.    MF := UpCase(ReadKey);
  468.    If MF = 'F' Then Male := False Else Male := True;
  469.    WriteLn;
  470.    Write('Save as what filename? ');
  471.    ReadLn(Filename);
  472.    If Length(Filename) = 0 Then Halt;
  473.    Assign(F,Filename);
  474.    Rewrite(F);
  475.  
  476.    For I := 1 To 6 Do
  477.    Begin
  478.       MinAttr[I] := 3;
  479.       MaxAttr[I] := 18;
  480.    End;
  481.    Case Race Of
  482.       1:Begin
  483.            Age := 15 + RandNum(1,4);
  484.            Height := 60 + RandNum(2,20);
  485.            If Not Male Then Dec(Height);
  486.            If Male Then
  487.               Weight := 140 + RandNum(6,60)
  488.              Else
  489.               Weight := 100 + RandNum(6,60);
  490.         End;
  491.       2:Begin
  492.            MinAttr[2] := 6;
  493.            MinAttr[3] := 7;
  494.            MinAttr[4] := 8;
  495.            MinAttr[6] := 8;
  496.            Age := 100 + RandNum(5,30);
  497.            If Male Then
  498.            Begin
  499.               Height := 55 + RandNum(1,10);
  500.               Weight := 90 + RandNum(3,30);
  501.            End
  502.           Else
  503.            Begin
  504.               Height := 50 + RandNum(1,10);
  505.               Weight := 70 + RandNum(3,30);
  506.            End;
  507.         End;
  508.       3:Begin
  509.            MinAttr[2] := 6;
  510.            MinAttr[3] := 6;
  511.            MinAttr[4] := 4;
  512.            Age := 15 + RandNum(1,6);
  513.            If Male Then
  514.            Begin
  515.               Height := 60 + RandNum(2,12);
  516.               Weight := 110 + RandNum(3,39);
  517.            End
  518.           Else
  519.            Begin
  520.               Height := 58 + RandNum(2,12);
  521.               Weight := 85 + RandNum(3,36);
  522.            End;
  523.         End;
  524.       4:Begin
  525.            MinAttr[1] := 7;
  526.            MinAttr[2] := 7;
  527.            MinAttr[3] := 10;
  528.            MinAttr[4] := 6;
  529.            MaxAttr[5] := 17;
  530.            Age := 20 + RandNum(3,12);
  531.            If Male Then
  532.            Begin
  533.               Height := 32 + RandNum(2,16);
  534.               Weight := 52 + RandNum(5,20);
  535.            End
  536.           Else
  537.            Begin
  538.               Height := 30 + RandNum(2,16);
  539.               Weight := 48 + RandNum(5,20);
  540.            End;
  541.         End;
  542.       5:Begin
  543.            MinAttr[1] := 8;
  544.            MinAttr[3] := 11;
  545.            MaxAttr[2] := 17;
  546.            MaxAttr[6] := 17;
  547.            Age := 40 + RandNum(5,30);
  548.            If Male Then
  549.            Begin
  550.               Height := 43 + RandNum(1,10);
  551.               Weight := 130 + RandNum(4,40);
  552.            End
  553.           Else
  554.            Begin
  555.               Height := 41 + RandNum(1,10);
  556.               Weight := 105 + RandNum(4,40);
  557.            End;
  558.         End;
  559.       6:Begin
  560.            MinAttr[1] := 6;
  561.            MinAttr[3] := 8;
  562.            MinAttr[4] := 6;
  563.            Age := 60 + RandNum(3,36);
  564.            If Male Then
  565.            Begin
  566.               Height := 38 + RandNum(1,6);
  567.               Weight := 72 + RandNum(5,20);
  568.            End
  569.           Else
  570.            Begin
  571.               Height := 36 + RandNum(1,6);
  572.               Weight := 68 + RandNum(5,20);
  573.            End;
  574.         End;
  575.    End;
  576.    Case Class Of
  577.       1:Begin
  578.            MinAttr[1] := 9;
  579.            HP := RandNum(1,10);
  580.         End;
  581.       2:Begin
  582.            MinAttr[1] := 12;
  583.            If MinAttr[3] < 9 Then MinAttr[3] := 9;
  584.            MinAttr[5] := 13;
  585.            MinAttr[6] := 17;
  586.            HP := RandNum(1,10);
  587.         End;
  588.       3:Begin
  589.            MinAttr[1] := 13;
  590.            MinAttr[2] := 13;
  591.            If MinAttr[3] < 14 Then MinAttr[3] := 14;
  592.            MinAttr[5] := 14;
  593.            HP := RandNum(1,10);
  594.         End;
  595.       4,5:Begin
  596.              MinAttr[4] := 9;
  597.              HP := RandNum(1,4);
  598.           End;
  599.       6:Begin
  600.            MinAttr[5] := 9;
  601.            HP := RandNum(1,8);
  602.         End;
  603.       7:Begin
  604.            MinAttr[5] := 12;
  605.            MinAttr[6] := 15;
  606.            HP := RandNum(1,8);
  607.         End;
  608.       8:Begin
  609.            MinAttr[2] := 9;
  610.            HP := RandNum(1,6);
  611.         End;
  612.       9:Begin
  613.            MinAttr[2] := 12;
  614.            MinAttr[4] := 13;
  615.            MinAttr[6] := 15;
  616.            HP := RandNum(1,6);
  617.         End;
  618.    End;
  619.    For I := 1 To 6 Do Attr[I] := RandNum(MinAttr[I],MaxAttr[I]);
  620.    Per := 0;
  621.    For I := 1 To 6 Do Per := Per + Attr[I];
  622.    Per := (Round(Per / 6) - 9);
  623.    Cas := '';
  624.    Case Per Of
  625.       -9..-7:Cas := 'Must Be Dead!!!';
  626.       -6..-5:Cas := 'Terrible!!';
  627.       -4..-3:Cas := 'Pitiful!';
  628.       -2..-1:Cas := 'Below Average';
  629.       0:Cas := 'Average';
  630.       1..2:Cas := 'Above Average';
  631.       3..4:Cas := 'Excellent!';
  632.       5..6:Cas := 'Superior!!';
  633.       7..9:Cas := 'God-like!!!';
  634.    End;
  635.    H1 := Height Div 12;
  636.    H2 := 12 - (Height Div 12);
  637.  
  638.    ClrScr;
  639.    GotoXy(1,2);
  640.    TextColor(15);
  641.    WriteLn(F,'Player Name:                                Age: ',Age);
  642.    WriteLn(F,'Character Name:                             Hair/Eye Color: ');
  643.    WriteLn(F,'Social Status: Adventurer                   Height: ',H1,'''',H2,'"');
  644.    Write(F,'Race/Class: ');
  645.    SL := 0;
  646.    Case Race Of
  647.       1:Begin
  648.            Write(F,'Human ');
  649.            SL := 6;
  650.         End;
  651.       2:Begin
  652.            Write(F,'Elven ');
  653.            SL := 6;
  654.         End;
  655.       3:Begin
  656.            Write(F,'Half-Elven ');
  657.            SL := 11;
  658.         End;
  659.       4:Begin
  660.            Write(F,'Halfling ');
  661.            SL := 9;
  662.         End;
  663.       5:Begin
  664.            Write(F,'Dwarven ');
  665.            SL := 8;
  666.         End;
  667.       6:Begin
  668.            Write(F,'Gnome ');
  669.            SL := 6;
  670.         End;
  671.    End;
  672.    Case Class Of
  673.       1:Begin
  674.            Write(F,'Fighter');
  675.            Inc(SL,7);
  676.         End;
  677.       2:Begin
  678.            Write(F,'Ranger');
  679.            Inc(SL,6);
  680.         End;
  681.       3:Begin
  682.            Write(F,'Paladin');
  683.            Inc(SL,7);
  684.         End;
  685.       4:Begin
  686.            Write(F,'Mage');
  687.            Inc(SL,4);
  688.         End;
  689.       5:Begin
  690.            Write(F,'Specialist');
  691.            Inc(SL,10);
  692.         End;
  693.       6:Begin
  694.            Write(F,'Cleric');
  695.            Inc(SL,6);
  696.         End;
  697.       7:Begin
  698.            Write(F,'Druid');
  699.            Inc(SL,5);
  700.         End;
  701.       8:Begin
  702.            Write(F,'Thief');
  703.            Inc(SL,5);
  704.         End;
  705.       9:Begin
  706.            Write(F,'Bard');
  707.            Inc(SL,5);
  708.         End;
  709.    End;
  710.    S := 33 - SL;
  711.    For I := 1 To S-1 Do Write(F,' ');
  712.    WriteLn(F,'Weight: ',Weight,' lbs.');
  713.  
  714.    WriteLn(F,'Level: 1');
  715.    WriteLn(F,'Alignment: ');
  716.    WriteLn(F);
  717.    T := 2;
  718.    Case Attr[3] Of
  719.       2..3:T := -2;
  720.       4..6:T := -1;
  721.       7..14:T := 0;
  722.       15:T := 1;
  723.       16:T := 2;
  724.       17:If Class In [1..3] Then T := 3;
  725.       18:If Class In [1..3] Then T := 4;
  726.       19:If Class In [1..3] Then T := 5;
  727.    End;
  728.    Write(F,'HP   : ',HP,'(',HP+T,')');
  729.    If T <> 0 Then WriteLn(F,' (Constitution Bonus)') Else WriteLn(F);
  730.  
  731.    T := 0;
  732.    Case Attr[1] Of
  733.       2,3:T := -3;
  734.       4..5:T := -2;
  735.       6..7:T := -1;
  736.       17..18:T := 1;
  737.    End;
  738.    If T <> 0 Then
  739.       WriteLn(F,'THAC0: 20','(',20-T,') ','(Strength Bonus)')
  740.      Else
  741.       WriteLn(F,'THAC0: 20');
  742.  
  743.    S := 10;
  744.    T := S;
  745.    Case Attr[2] Of
  746.       15:Dec(T);
  747.       16:Dec(T,2);
  748.       17:Dec(T,3);
  749.       18..19:Dec(T,4);
  750.    End;
  751.    Write(F,'AC   : ',S);
  752.    If T <> S Then WriteLn(F,'(',T,') (Dex Bonus)') Else WriteLn(F);
  753.    WriteLn(F,'XP   : 0');
  754.  
  755.    WriteLn(F,'Attacks: 1');
  756.    WriteLn(F);
  757.  
  758.    Strength;
  759.    Dexterity;
  760.    Constitution;
  761.    Intelligence;
  762.    Wisdom;
  763.    Charisma;
  764.    WriteLn(F);
  765.    WriteLn(F);
  766.    Write(F,'Languages: Common');
  767.    Case Race Of
  768.       1:WriteLn(F,'.');
  769.       2:WriteLn(F,' and Elven.');
  770.       3:WriteLn(F,' and Half-Elven.');
  771.       4:WriteLn(F,' and Halfling.');
  772.       5:WriteLn(F,' and Dwarven.');
  773.       6:WriteLn(F,' and Gnome.');
  774.    End;
  775.    SpecialAbilities;
  776.    Misc;
  777.    Close(F);
  778. End;
  779.  
  780. Function ClassOp(Item:Word):String; Far;
  781. Var
  782.    A:Array[1..10] Of String[30];
  783. Begin
  784.    A[1] := 'Fighter';
  785.    A[2] := 'Ranger';
  786.    A[3] := 'Paladin';
  787.    A[4] := 'Mage';
  788.    A[5] := 'Specialist';
  789.    A[6] := 'Cleric';
  790.    A[7] := 'Druid';
  791.    A[8] := 'Thief';
  792.    A[9] := 'Bard';
  793.    ClassOp := A[Item];
  794. End;
  795.  
  796. Procedure ChooseClass;
  797. Begin
  798.    NewSpace;
  799.    GotoXy(1,4);
  800.    TextColor(11);
  801.    Write(Center('Choose Class',80));
  802.    Repeat
  803.       If Not PickWindow(@ClassOp,9,35,6,46,16,True,WindowCol,'',Choice) Then Halt;
  804.    Until Choice In [1..9];
  805.    Class := Choice;
  806.    Choice := 0;
  807. End;
  808.  
  809. Function RaceOp(Item:Word):String; Far;
  810. Var
  811.    A:Array[1..6] Of String[8];
  812. Begin
  813.    A[1] := 'Human';
  814.    A[2] := 'Elf';
  815.    A[3] := 'Half-Elf';
  816.    A[4] := 'Halfling';
  817.    A[5] := 'Dwarf';
  818.    A[6] := 'Gnome';
  819.    RaceOp := A[Item];
  820. End;
  821.  
  822. Procedure ChooseRace;
  823. Begin
  824.    NewSpace;
  825.    GotoXy(1,4);
  826.    TextColor(11);
  827.    Write(Center('Choose Race',80));
  828.    Repeat
  829.       If Not PickWindow(@RaceOp,5,35,6,45,13,True,WindowCol,'',Choice) Then
  830.          Halt;
  831.    Until Choice In [1..6];
  832.    Race := Choice;
  833.    Choice := 0;
  834. End;
  835.  
  836. Function MenuOp(Item:Word):String; Far;
  837. Var
  838.    A:Array[1..5] Of String[16];
  839. Begin
  840.    A[1] := 'Choose Race';
  841.    A[2] := 'Choose Class';
  842.    A[3] := 'Create Character';
  843.    A[4] := 'Quit';
  844.    MenuOp := A[Item];
  845. End;
  846.  
  847. Procedure MainMenu;
  848. Var
  849.    Tmp:Word;
  850. Begin
  851.    Repeat
  852.       NewSpace;
  853.       If Not PickWindow(@MenuOp,4,31,6,49,11,True,WindowCol,'',Choice) Then Halt;
  854.       Tmp := Choice;
  855.       Choice := 0;
  856.       Case Tmp Of
  857.          1:ChooseRace;
  858.          2:ChooseClass;
  859.          3:Create;
  860.       End;
  861.    Until Tmp = 4;
  862. End;
  863.  
  864. Begin
  865.    ClrScr;
  866.    WriteLn;
  867.    TextColor(15);
  868.    WriteLn(Center('Instant Character Creator',80));
  869.    Created := False;
  870.    MainMenu;
  871.    WriteLn;
  872.    TextColor(11);
  873.    If Created Then
  874.       WriteLn(Center('The character generated was rated as follows: '+Cas,80));
  875.    WriteLn;
  876.    TextColor(15);
  877.    WriteLn(Center('Thank you for using Instant Character Creator',80));
  878.    WriteLn(Center('by Dan Vanderboom!',80));
  879. End.
  880.