-+-+-+-+-+-+-+-+ START OF PART 8 -+-+-+-+-+-+-+-+
X`09inkey_flush(s);
X`09case s of
X`09  'f' : begin
X`09`09  py.misc.sex := 'Female';
X`09`09  prt(py.misc.sex,5,15);
X`09`09  exit_flag := true;
X`09`09  get_sex := true;
X`09`09end;
X`09  'm' : begin
X`09`09  py.misc.sex := 'Male';
X`09`09  prt(py.misc.sex,5,15);
X`09`09  exit_flag := true;
X`09`09  get_sex := true;
X`09`09end;
X`09  '?' : begin
X`09`09  moria_help('Character Sex');
X`09`09  exit_flag := true;
X`09`09  get_sex := false;
X`09`09end;
X`09  otherwise ;
X`09 end;
X      until (exit_flag);
X      end;
X    end;
X
X
X`09`7B Computes character's age, height, and weight`09`09-JWT-`09`7D
X  procedure get_ahw;
X    var
X`09i1 `09: integer;
X    begin
X      i1 := py.misc.prace;
X      py.misc.age := race`5Bi1`5D.b_age + randint(race`5Bi1`5D.m_age);
X      with py.misc.birth do
X`09begin
X`09  year := 500 + randint(50);
X`09  month := randint(13);
X`09  day := randint(28);
X`09  hour := randint(24)-1;
X`09  secs := randint(400)-1;
X`09end;
X      with py.misc.cur_age do
X`09begin
X`09  year := py.misc.age + py.misc.birth.year;
X`09  month := py.misc.birth.month;
X`09  day := py.misc.birth.day + 1;
X`09  if ((day mod 7) = 0) then
X`09    add_days(py.misc.cur_age,2);
X`09  if ((day mod 7) = 1) then
X`09    add_days(py.misc.cur_age,1);
X`09  hour := 7;
X`09  secs := 300 + randint(99);
X`09end;
X      case characters_sex of
X`09female :
X`09  begin
X`09    py.misc.ht := randnor(race`5Bi1`5D.f_b_ht,race`5Bi1`5D.f_m_ht);
X`09    py.misc.wt := randnor(race`5Bi1`5D.f_b_wt,race`5Bi1`5D.f_m_wt)
X`09  end;
X`09male :
X`09  begin
X`09    py.misc.ht := randnor(race`5Bi1`5D.m_b_ht,race`5Bi1`5D.m_m_ht);
X`09    py.misc.wt := randnor(race`5Bi1`5D.m_b_wt,race`5Bi1`5D.m_m_wt)
X`09  end
X      end;
X      py.misc.disarm := race`5Bi1`5D.b_dis + todis_adj;
X    end;
X
X
X`09`7B Gets a character class`09`09`09`09-JWT-`09`7D
X  function get_class : boolean;
X    var
X`09i1,i2,i3,i4,i5`09`09: integer;
X`09cl`09`09`09: array `5B0..max_class`5D of integer;
X`09s`09`09`09: char;
X`09exit_flag`09`09: boolean;
X`09tstat`09`09`09: stat_set;
X    begin
X      for i2 := 1 to max_class do cl`5Bi2`5D := 0;
X      i1 := py.misc.prace;
X      i2 := 1;
X      i3 := 0;
X      i4 := 3;
X      i5 := 22;
X      clear(21,1);
X      prt('Choose a class (? for Help):',21,3);
X      repeat
X`09if (uand(race`5Bi1`5D.tclass,bit_array`5Bi2`5D) <> 0) then
X`09  begin
X`09    i3 := i3 + 1;
X`09    put_buffer (chr(i3+96)+') '+class`5Bi2`5D.title,i5,i4);
X`09    cl`5Bi3`5D := i2;
X`09    i4 := i4 + 15;
X`09    if (i4 > 70) then
X`09      begin
X`09`09i4 := 3;
X`09`09i5 := i5 + 1
X`09      end;
X`09  end;
X`09i2 := i2 + 1;
X      until (i2 > max_class);
X      py.misc.pclass := 0;
X      put_buffer('',21,31);
X      exit_flag := false;
X      repeat
X`09inkey_flush(s);
X`09i2 := index('abcdefghijklmnopqrstuvwxyz',s);
X`09if ((i2 <= i3) and (i2 >= 1)) then
X`09  begin
X`09    py.misc.tclass := class`5Bcl`5Bi2`5D`5D.title;
X`09    py.misc.pclass := cl`5Bi2`5D;
X`09    exit_flag := true;
X`09    get_class := true;
X`09    clear(21,1);
X`09    put_buffer(py.misc.tclass,6,15);
X`09    with py.misc do
X`09      begin
X`09        hitdie := hitdie + class`5Bpclass`5D.adj_hd;
X                mhp    := con_adj + hitdie;
X`09        chp`09 := mhp;
X                bth    := bth     + class`5Bpclass`5D.mbth * 5 + 20;
X`09        bthb   := bthb    + class`5Bpclass`5D.mbthb * 5 + 20;`20
X                srh    := srh     + class`5Bpclass`5D.msrh;
X                disarm := disarm  + class`5Bpclass`5D.mdis;
X                fos    := fos     + class`5Bpclass`5D.mfos;
X                stl    := stl     + class`5Bpclass`5D.mstl;
X`09        save   := save    + class`5Bpclass`5D.msav;
X                title  := player_title`5Bpclass,1`5D;
X`09        expfact:= expfact + class`5Bpclass`5D.m_exp;
X`09`09case pclass of
X`09`09  1`09: mr := -10;
X`09`09  2,3`09: mr := 0;
X`09`09otherwise mr := -5;
X`09`09end;
X`09      end;
X`09`7B Adjust the stats for the class adjustment`09`09-RAK-`09`7D
X            with py do
X`09      begin
X`09`09for tstat := sr to ca do
X`09`09  begin
X`09`09    stat.p`5Btstat`5D := change_stat(stat.p`5Btstat`5D,
X`09`09`09`09class`5Bmisc.pclass`5D.madj`5Btstat`5D);
X`09`09    stat.c`5Btstat`5D := stat.p`5Btstat`5D;
X`09`09  end;
X`09        misc.ptodam := todam_adj;`09`7B Real values`09`09`7D
X`09        misc.ptohit := tohit_adj;
X`09        misc.ptoac  := toac_adj;
X`09        misc.pac    := 0;
X`09`09misc.dis_td := misc.ptodam;`09`7B Displayed values`09`7D
X`09`09misc.dis_th := misc.ptohit;
X`09`09misc.dis_tac:= misc.ptoac;
X`09`09misc.dis_ac := misc.pac;
X`09      end;
X`09  end
X`09else if (s = '?') then
X`09  begin
X`09    moria_help('Character Classes');
X`09    exit_flag := true;
X`09    get_class := false;
X`09  end;
X      until(exit_flag);
X    end;
X
X
X  procedure get_money;
X    var
X`09tmp,i1`09`09`09: integer;
X`09tstat`09`09`09: stat_set;
X    begin
X`09with py.stat do
X`09 begin
X`09  tmp := 0;
X`09  for tstat := sr to ca do
X`09    tmp := tmp + old_stat(c`5Btstat`5D);
X`09 end;
X`09i1 := py.misc.sc*6 + randint(25) + 325;`7B Social Class adj`09`7D
X`09i1 := i1 - tmp;`09`09`09`7B Stat adj`09`09`7D
X`09i1 := i1 + old_stat(py.stat.c`5Bca`5D);`09`7B Charisma adj`09`7D
X`09if (i1 < 80) then i1 := 80;`09`09`7B Minimum`09`09`7D
X`09i1 := i1 * gold$value + randint(gold$value);
X`09add_money(i1);
X    end;
X
X`09`7B Get social security number`09`09`09`09-KRC-`09`7D
X`5Bglobal,psect(create$code)`5D procedure get_ssn;
X
X    `5Bexternal`5D procedure lib$date_time`09(
X`09`09`09%DESCR time : vtype
X`09`09`09`09`09); external;
X
X    var
X
X`09account`09`09`09`09: packed array `5B1..8`5D of char;
X`09time`09`09`09`09: vtype;
X
X    begin
X
X      lib$date_time( time );
X      get_account( account );
X      py.misc.ssn := '$ < ' + account + ' > - # ' + time + ' # ' + py.misc.n
Vame;
X
X    end;
X
X`09`7B ---------- M A I N  for Character Creation Routine ---------- `7D
X`09`7B`09`09`09`09`09`09`09-JWT-`09`7D
X
X  begin
X    with py do
X      begin
X`09`7B This delay may be reduced, but is recomended to keep players`09`7D
X`09`7B from continuously rolling up characters, which can be VERY`09`7D
X`09`7B expensive CPU wise.`09`09`09`09`09`09`7D
X`09for tstat := sr to ca do
X`09`09best`5Btstat`5D := 3;
X`09best_min := 999999999;
X`09minning := false;
X`09try_count := 0;
X`09repeat
X`09  put_character;
X`09until(choose_race);
X`09while (not(get_sex)) do put_character;
X`09printed_once := false;
X`09with race`5Bpy.misc.prace`5D do
X`09  for tstat := sr to ca do
X`09    max_r`5Btstat`5D := max_stat(140,adj`5Btstat`5D);
X`09get_minimums;
X`09repeat
X`09  get_stats;
X`09  get_history;
X`09  get_ahw;
X`09until satisfied;
X`09print_history;
X`09while (not(get_class)) do
X`09  begin
X`09    put_character;
X`09    print_history;
X`09    put_misc1;
X`09    put_stats;
X`09  end;
X`09get_money;
X`09put_stats;
X`09put_misc2;
X`09put_misc3;
X`09get_name;
X`09get_ssn;
X`09pause_exit(24,player_exit_pause);
X      end
X  end;
X
X
X`5Bglobal,psect(create$code)`5D procedure set_gem_values;
X
Xvar
X`09count`09`09: integer;
X
Xbegin
Xfor count := 1 to max_objects do`20
X begin
X   with object_list`5Bcount`5D do
X     if ((index(name,'Finely cut') <> 0) and (index(name,'of') <> 0)) then
X      begin
X`09if (index(name,'Amber') <> 0) then cost := cost + 1000;
X`09if (index(name,'Agate') <> 0) then cost := cost + 1000;
X`09if (index(name,'Alexandrite') <> 0) then cost := cost + 5000;
X`09if (index(name,'Amathyst') <> 0) then cost := cost + 2000;
X`09if (index(name,'Antlerite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Aquamarine') <> 0) then cost := cost + 6000;
X`09if (index(name,'Argentite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Azurite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Beryl') <> 0) then cost := cost + 2000;
X`09if (index(name,'Bloodstone') <> 0) then cost := cost + 3500;
X`09if (index(name,'Calcite') <> 0) then cost := cost + 1500;
X`09if (index(name,'Carnelian') <> 0) then cost := cost + 1000;
X`09if (index(name,'Coral') <> 0) then cost := cost + 1000;
X`09if (index(name,'Corundum') <> 0) then cost := cost + 1000;
X`09if (index(name,'Cryolite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Diamond') <> 0) then cost := cost + 35000;
X`09if (index(name,'Diorite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Emerald') <> 0) then cost := cost + 20000;
X`09if (index(name,'Flint') <> 0) then cost := cost + 5000;
X`09if (index(name,'Fluorite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Gabbro') <> 0) then cost := cost + 5000;
X`09if (index(name,'Garnet') <> 0) then cost := cost + 6500;
X`09if (index(name,'Granite') <> 0) then cost := cost + 500;
X`09if (index(name,'Gypsum') <> 0) then cost := cost + 3000;
X`09if (index(name,'Hematite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Jade') <> 0) then cost := cost + 12000;
X`09if (index(name,'Jasper') <> 0) then cost := cost + 3000;
X`09if (index(name,'Kryptonite') <> 0) then cost := cost + 5000;
X`09if (index(name,'Lapus lazuli') <> 0) then cost := cost + 4500;
X`09if (index(name,'Limestone') <> 0) then cost := cost + 1000;
X`09if (index(name,'Malachite') <> 0) then cost := cost + 3000;
X`09if (index(name,'Manganite') <> 0) then cost := cost + 5000;
X`09if (index(name,'Marble') <> 0) then cost := cost + 5500;
X`09if (index(name,'Mica') <> 0) then cost := cost + 1500;
X`09if (index(name,'Moonstone') <> 0) then cost := cost + 3000;
X`09if (index(name,'Neptunite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Obsidian') <> 0) then cost := cost + 2500;
X`09if (index(name,'Onyx') <> 0) then cost := cost + 1500;
X`09if (index(name,'Opal') <> 0) then cost := cost + 1000;
X`09if (index(name,'Pearl') <> 0) then cost := cost + 11500;
X`09if (index(name,'Pyrite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Quartz') <> 0) then cost := cost + 1000;
X`09if (index(name,'Quartzite') <> 0) then cost := cost + 1500;
X`09if (index(name,'Rhodonite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Rhyolite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Ruby') <> 0) then cost := cost + 14500;
X`09if (index(name,'Sapphire') <> 0) then cost := cost + 14500;
X`09if (index(name,'Sphalerite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Staurolite') <> 0) then cost := cost + 1000;
X`09if (index(name,'Tiger eye') <> 0) then cost := cost + 8500;
X`09if (index(name,'Topaz') <> 0) then cost := cost + 1000;
X`09if (index(name,'Turquoise') <> 0) then cost := cost + 3000;
X`09if (index(name,'Zircon') <> 0) then cost := cost + 1000;
X      end;
X   end;
X end;
XEnd.
$ CALL UNPACK CREATE.PAS;1 23467343
$ create 'f'
X`5Binherit('moria.env','dungeon.env')`5D module creature;
X
X`5Bglobal,psect(creature$code)`5D procedure load_monsters;
X
Xvar
X  count             : integer;
X  f1                : text;
X  a`09`09    : ctype;
X
X      begin
X        `7Bload monsters from file`7D
X        open(f1,file_name:=MORIA_MON,history:=READONLY);
X        Reset(f1);
X        for count := 1 to max_creatures do begin
X          readln (f1, a);
X          readln (f1, c_list`5Bcount`5D.aaf);
X          readln (f1, c_list`5Bcount`5D.ac);
X          readln (f1, c_list`5Bcount`5D.name);
X          readln (f1, c_list`5Bcount`5D.cmove : HEX);
X          readln (f1, c_list`5Bcount`5D.spells : HEX);
X          readln (f1, c_list`5Bcount`5D.cdefense : HEX);
X          readln (f1, c_list`5Bcount`5D.sleep);
X          readln (f1, c_list`5Bcount`5D.mexp);
X          readln (f1, c_list`5Bcount`5D.speed);
X          readln (f1, c_list`5Bcount`5D.cchar);
X          readln (f1, c_list`5Bcount`5D.hd);
X          readln (f1, c_list`5Bcount`5D.damage);
X          readln (f1, c_list`5Bcount`5D.level);
X`09  readln (f1, c_list`5Bcount`5D.mr);
X        end;
X        close(f1);
X`09open(f1,file_name:=MORIA_CST, history:=READONLY, error:=continue);
X`09if (status(f1) = 0) then
X`09reset(f1);
X`09begin`09
X`09  if (not eof(f1)) then
X`09  begin
X`09    repeat
X`09      readln (f1,a);
X`09      if (length(a) > 25) then a := substr(a,1,25);
X`09      if (not eof(f1)) then
X`09      begin
X`09        readln (f1,count);
X`09        if ((count <= max_creatures) and (count > 0)) then
X`09        begin
X`09`09  c_list`5Bcount`5D.name := a;
X`09        end;
X`09      end;
X`09    until(eof(f1));
X`09    close(f1);
X`09  end;
X`09end;
X      end;
X
X`09`7B replace <gp> for game players name `7D
X`5Bglobal,psect(creature$code)`5D procedure replace_name;
X
X  var
X`09count`09`09: integer;
X`09mark`09`09: integer;
X`09t_str`09`09: vtype;
X
X`09begin
X`09  for count := 1 to max_creatures do`20
X`09    begin
X`09      mark := index(c_list`5Bcount`5D.name, '<gp>');
X`09      if (mark <> 0) then
X`09`09begin
X`09`09  t_str := py.misc.name;
X`09`09  if (t_str = '') then t_str := 'Dead Guy';
X`09`09  if (length(t_str) > 15) then t_str := substr(t_str,1,15);
X`09`09  t_str := t_str + substr(c_list`5Bcount`5D.name,mark+4,
X`09`09`09   length(c_list`5Bcount`5D.name)-(mark+3));
X`09`09  if (mark <> 1) then
X`09`09      t_str := substr(c_list`5Bcount`5D.name,1,mark-1) + t_str;
X`09`09  c_list`5Bcount`5D.name := t_str;
X`09`09end;
X`09     end;
X`09 end;
X
X
X`7Bname any monster you wish `5Bcurrently virtual`5D`7D
X`5Bglobal,psect(creature$code)`5D procedure mon_name;
X
X`09procedure append_mon(mon_num : integer);
X`09
X`09var
X`09  f1`09`09: text;
X
X`09begin
X`09  open(f1,file_name:=MORIA_CST,history:=UNKNOWN,error:=continue);
X`09  extend(f1);
X`09  writeln(f1, c_list`5Bmon_num`5D.name);
X`09  writeln(f1, mon_num : 4);
X`09  close(f1);
X`09end;
X
Xvar
X`09virtual_name`09`09: ctype;
X`09mon_num`09`09`09: integer;
X
X`09begin
X`09  prt('Monster to rename:',1,1);
X`09  if (get_string(virtual_name,1,20,26)) then
X`09  begin
X`09    mon_num := find_mon(virtual_name);
X`09    if (mon_num <> 0) then
X`09      begin
X`09`09prt('New name:',1,1);
X`09`09if (get_string(virtual_name,1,11,26)) then
X`09`09  c_list`5Bmon_num`5D.name := virtual_name;
X`09`09  append_mon(mon_num);
X`09      end
X`09    else
X`09      msg_print('Hmm.... can''t find a monster with that name');
X`09  end;
X`09  msg_print('');
X`09end;
X
X`7Breturns number of monster in list specified by virtual_name`7D
X`5Bglobal,psect(creature$code)`5D function find_mon(virtual_name : ctype): i
+-+-+-+-+-+-+-+-  END  OF PART 8 +-+-+-+-+-+-+-+-