-+-+-+-+-+-+-+-+ START OF PART 28 -+-+-+-+-+-+-+-+
X`09end;
X      put_buffer(cursor_erl+str_buff,msg_line,msg_line);
X      old_msg := str_buff;
X      msg_flag := true;
X    end;
X
X
X`09`7B Prompts (optional) and returns ord value of input char`09`7D
X`09`7B Function returns false if <ESCAPE>,CNTL/(Y,C,Z) is input`09`7D
X`5Bpsect(io$code)`5D function get_com`09(
X`09`09`09`09prompt`09`09: varying`5Ba`5D of char;
X`09`09`09`09var command`09: char
X`09`09`09`09`09) : boolean;
X    var
X`09com_val`09`09: integer;
X    begin
X      if (length(prompt) > 1) then prt(prompt,1,1);
X      inkey(command);
X      com_val := ord(command);
X      case com_val of
X`093,25,26,27`09: get_com := false;
X`09otherwise`09  get_com := true;
X      end;
X      erase_line(msg_line,msg_line);
X      msg_flag := false;
X    end;
X
X
X`09`7B Gets a string terminated by <RETURN>`09`09`09`09`7D
X`09`7B Function returns false if <ESCAPE>,CNTL/(Y,C,Z) is input`09`7D
X`5Bpsect(io$code)`5D function get_string`09(
X`09`09`09var in_str`09: varying`5Ba`5D of char;
X`09`09`09row,column,slen : integer
X`09`09`09`09`09) : boolean;
X    var
X`09start_col,end_col,i1`09: integer;
X`09x`09`09`09: char;
X`09tmp`09`09`09: vtype;
X`09flag,abort`09`09: boolean;
X`09
X    begin
X      abort := false;
X      flag  := false;
X      in_str:= '';
X      put_buffer(pad(in_str,' ',slen),row,column);
X      put_buffer('',row,column);
X      start_col := column;
X      end_col := column + slen - 1;
X      repeat
X`09inkey(x);
X`09case ord(x) of
X`09 3,25,26,27 :`09abort := true;
X`09`0913  : `09flag  := true;
X`09`09127 : `09begin
X`09`09`09  if (column > start_col) then
X`09`09`09    begin
X`09`09`09      column := column - 1;
X`09`09`09      put_buffer(' '+chr(8),row,column);
X`09`09`09      in_str := substr(in_str,1,length(in_str)-1);
X`09`09`09    end;
X`09`09`09end;
X`09 otherwise`09begin
X`09`09`09  tmp := x;
X`09`09`09  put_buffer(tmp,row,column);
X`09`09`09  in_str := in_str + tmp;
X`09`09`09  column := column + 1;
X`09`09`09  if (column > end_col) then
X`09`09`09    flag := true;
X`09`09`09end;
X`09end;
X      until (flag or abort);
X      if (abort) then
X`09get_string := false
X      else
X`09begin`09`09`09`7B Remove trailing blanks`09`7D
X`09  i1 := length(in_str);
X`09  if (i1 > 1) then
X`09    begin
X`09      while ((in_str`5Bi1`5D = ' ') and (i1 > 1)) do
X`09        i1 := i1 - 1;
X`09      in_str := substr(in_str,1,i1);
X`09    end;
X`09  get_string := true;
X`09end;
X    end;
X
X
X`09`7B Return integer value of hex string`09`09`09-RAK-`09`7D
X`5Bpsect(wizard$code)`5D function get_hex_value(row,col,slen : integer) : in
Vteger;
X    type
X`09pack_type`09`09= packed array `5B1..9`5D of char;
X    var
X`09bin_val`09`09`09: integer;
X`09tmp_str`09`09`09: vtype;
X`09pack_str`09`09: pack_type;
X
X    `5Basynchronous,external(OTS$CVT_TZ_L)`5D function convert_hex_to_bin(
X`09`09%stdescr hex_str`09: pack_type;
X`09`09%ref`09 hex_val `09: integer;
X`09`09%immed`09 val_size`09: integer := %immed 4;
X`09`09%immed`09 flags`09`09: integer := %immed 1) : integer;
X`09`09external;
X
X    begin
X      get_hex_value := 0;
X      if (get_string(tmp_str,row,col,slen)) then
X`09if (length(tmp_str) <= 8) then
X`09  begin
X`09    pack_str := pad(tmp_str,' ',9);
X`09    if (odd(convert_hex_to_bin(pack_str,bin_val))) then
X`09      get_hex_value := bin_val;
X`09  end;
X    end;
X
X
X
X`09`7B Pauses for user response before returning`09`09-RAK-`09`7D
X`5Bpsect(misc2$code)`5D procedure pause(prt_line : integer);
X    var
X`09dummy`09`09`09: char;
X    begin
X      prt('`5BPress any key to continue`5D',prt_line,24);
X      inkey(dummy);
X      erase_line(24,1);
X    end;
X
X
X`09`7B Pauses for user response before returning`09`09-RAK-`09`7D
X`09`7B NOTE: Delay is for players trying to roll up "perfect"`09`7D
X`09`7B`09characters.  Make them wait a bit...`09`09`09`7D
X`5Bpsect(misc2$code)`5D procedure pause_exit(
X`09`09prt_line`09: integer;
X`09`09delay`09`09: integer);
X    var
X`09dummy`09`09`09: char;
X    begin
X      prt('`5BPress any key to continue, or <Control>-Z to exit`5D',prt_line
V,11);
X      inkey(dummy);
X      case ord(dummy) of
X`093,25,26 :`09begin
X`09`09`09  erase_line(prt_line,1);
X`09`09`09  if (delay > 0) then sleep(delay);
X`09`09`09  exit;
X`09`09`09end;
X`09otherwise;
X      end;
X      erase_line(prt_line,1);
X    end;
X
X
X`09`7B Returns the image path for Moria`09`09`09-RAK-`09`7D
X`09`7B Path is returned in a VARYING`5B80`5D of char`09`09`09`7D
X`5Bpsect(setup$code)`5D procedure get_paths;
X    type
X`09word`09= 0..65535;
X`09rec_jpi`09= record
X`09`09`09pathinfo : packed record
X`09`09`09`09     pathlen`09`09: word;
X`09`09`09`09     jpi$_imagname`09: word;
X`09`09  `09`09   end;
X`09`09`09ptr_path`09: `5Epath;
X`09`09`09ptr_pathlen`09: `5Einteger;
X`09`09`09endlist`09`09: integer
X`09`09  end;
X`09path`09`09= packed array `5B1..128`5D of char;
X    var
X`09i1`09`09: integer;
X`09tmp_str`09`09: path;
X`09image_path`09: vtype;
X`09flag`09`09: boolean;
X
X`09`7B Call JPI and return the image path as a packed 128`09-RAK-`09`7D
X    function get_jpi_path : path;
X      var
X`09status`09`09: integer;
X`09user`09`09: path;
X`09jpirec`09`09: rec_jpi;
X
X`09`7B GETJPI definition`09`7D
X      `5Basynchronous,external(SYS$GETJPI)`5D function $getjpi(
X`09`09%immed`09p1`09: integer := %immed 0;
X`09`09%immed`09p2`09: integer := %immed 0;
X`09`09%immed`09p3`09: integer := %immed 0;
X`09`09var`09itmlst`09: rec_jpi;
X`09`09%immed`09p4`09: integer := %immed 0;
X`09`09%immed`09p5`09: integer := %immed 0;
X`09`09%immed`09p6`09: integer := %immed 0) : integer;
X`09`09external;
X
X      begin
X`09with jpirec do
X`09  begin
X`09    pathinfo.pathlen`09`09:= 128;`09`09`7B Image length`09`7D
X`09    pathinfo.jpi$_imagname`09:= %x207;`09`7B Image path`09`7D
X`09    new (ptr_path);
X`09    pad(ptr_path`5E,' ',128);
X`09    new (ptr_pathlen);
X`09    ptr_pathlen`5E`09`09:= 0;
X`09    endlist`09`09`09:= 0;
X`09  end;
X`09status := $getjpi(itmlst:=jpirec);
X`09if (not(odd(status))) then
X`09  begin
X`09    clear(1,1);
X  `09    put_buffer('Error in retrieving image path.',1,1);
X`09    exit;
X`09  end
X`09else
X`09  get_jpi_path := jpirec.ptr_path`5E;
X      end;
X
X    begin
X      tmp_str := get_jpi_path;
X      i1 := 0;
X      flag := false;
X      image_path := '';
X      repeat
X`09i1 := i1 + 1;
X`09if (tmp_str`5Bi1`5D = '`5D') then flag := true;
X`09image_path := image_path + tmp_str`5Bi1`5D;
X`09if (i1 > 127) then flag := true;
X      until(flag);
X      MORIA_HOU := image_path + 'HOURS.DAT';
X      MORIA_MOR := image_path + 'MORIA.DAT';
X      MORIA_MAS := image_path + 'MORIACHR.DAT';
X      MORIA_TOP := image_path + 'MORIATOP.DAT';
X      MORIA_HLP := image_path + 'MORIAHLP.HLB';
X    end;
$ CALL UNPACK [.SOURCE.INCLUDE]IO.INC;1 1862767193
$ create 'f'
X`09`7B Throw a magic spell`09`09`09`09`09-RAK-`09`7D
X`5Bpsect(misc2$code)`5D procedure cast;
X      var
X`09`09i1,i2,item_val,dir              : integer;
X`09`09choice,chance                   : integer;
X`09`09dumy,y_dumy,x_dumy              : integer;
X`09`09redraw                          : boolean;
X      begin
X`09reset_flag := true;
X`09if (py.flags.blind > 0) then
X`09  msg_print('You can''t see to read your spell book!')
X`09else if (no_light) then
X`09  msg_print('You have no light to read by.')
X`09else if (py.flags.confused > 0) then
X`09  msg_print('You are too confused...')
X`09else if (class`5Bpy.misc.pclass`5D.mspell) then
X`09  if (inven_ctr > 0) then
X`09    begin
X`09      if (find_range(`5B90`5D,i1,i2)) then
X`09`09begin
X`09`09  redraw := false;
X`09`09  if (get_item(item_val,'Use which spell-book?',
X`09`09`09`09`09`09`09redraw,i1,i2)) then
X`09`09    begin
X`09`09      if (cast_spell('Cast which spell?',item_val,
X`09`09`09`09`09`09choice,chance,redraw)) then
X`09`09`09with magic_spell`5Bpy.misc.pclass,choice`5D do
X`09`09`09  begin
X`09`09`09    reset_flag := false;
X`09`09`09    if (randint(100) < chance) then
X`09`09`09      msg_print('You failed to get the spell off!')
X`09`09`09    else
X`09`09`09      begin
X`09`09`09`09y_dumy := char_row;
X`09`09`09`09x_dumy := char_col;
X`09`7B Spells...                                     `7D
X`09case choice of
X`09  1  :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_bolt(0,dir,char_row,char_col,
X`09`09`09`09`09damroll('2d6')+1,'Magic Missile');
X`09  2  :  detect_monsters;
X`09  3  :  teleport(10);
X`09  4  :  light_area(char_row,char_col);
X`09  5  :  hp_player(damroll('4d4'),'a magic spell.');
X`09  6  :  begin
X`09`09  detect_sdoor;
X`09`09  detect_trap;
X`09`09end;
X`09  7  :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_ball(2,dir,char_row,char_col,9,'Stinking Cloud');
X`09  8  :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  confuse_monster(dir,char_row,char_col);
X`09  9 :   if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_bolt(1,dir,char_row,char_col,
X`09`09`09`09`09damroll('3d8')+1,'Lightning Bolt');
X`09  10 :  td_destroy;
X`09  11 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  sleep_monster(dir,char_row,char_col);
X`09  12 :  cure_poison;
X`09  13 :  teleport(py.misc.lev*5);
X`09  14 :  for i1 := 23 to inven_max-1 do
X`09`09  with inventory`5Bi1`5D do
X`09`09    flags := uand(flags,%X'7FFFFFFF');
X`09  15 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_bolt(4,dir,char_row,char_col,
X`09`09`09`09`09damroll('4d8')+1,'Frost Bolt');
X`09  16 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  wall_to_mud(dir,char_row,char_col);
X`09  17 :  create_food;
X`09  18 :  recharge(20);
X`09  19 :  sleep_monsters1(char_row,char_col);
X`09  20 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  poly_monster(dir,char_row,char_col);
X`09  21 :  ident_spell;
X`09  22 :  sleep_monsters2;
X`09  23 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_bolt(5,dir,char_row,char_col,
X`09`09`09`09`09damroll('6d8')+1,'Fire Bolt');
X`09  24 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  speed_monster(dir,char_row,char_col,-1);
X`09  25 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_ball(4,dir,char_row,char_col,33,'Frost Ball');
X`09  26 :  recharge(50);
X`09  27 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  teleport_monster(dir,char_row,char_col);
X`09  28 :  with py.flags do
X`09`09  fast := fast + randint(20) + py.misc.lev;
X`09  29 :  if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then
X`09`09  fire_ball(5,dir,char_row,char_col,49,'Fire Ball');
X`09  30 :  destroy_area(char_row,char_col);
X`09  31 :  genocide;
X`09  otherwise ;
X`09end;
X`09`7B End of spells...                              `7D
X`09`09`09`09if (not(reset_flag)) then
X`09`09`09`09  with py.misc do
X`09`09`09`09    begin
X`09`09`09`09      exp := exp + sexp;
X`09`09`09`09      prt_experience;
X`09`09`09`09      sexp := 0;
X`09`09`09`09    end
X`09`09`09      end;
X`09`09`09    with py.misc do
X`09`09`09      if (not(reset_flag)) then
X`09`09`09`09begin
X`09`09`09`09  if (smana > cmana) then
X`09`09`09`09    begin
X`09`09`09`09      msg_print('You faint from the effort!');
X`09`09`09`09      py.flags.paralysis :=
X`09`09`09`09`09randint(5*trunc(smana-cmana));
X`09`09`09`09      cmana := 0;
X`09`09`09`09      if (randint(3) = 1) then
X`09`09`09`09begin
X`09`09`09`09  msg_print('You have damaged your health!');
X`09`09`09`09  py.stat.ccon := de_statp(py.stat.ccon);
X`09`09`09`09  prt_constitution;
X`09`09`09`09end;
X`09`09`09`09    end
X`09`09`09`09  else
X`09`09`09`09    cmana := cmana - smana;
X`09`09`09`09  prt_cmana;
X`09`09`09`09end
X`09`09`09  end
X`09`09    end
X`09`09  else
X`09`09    if (redraw) then draw_cave;
X`09`09end
X`09      else
X`09`09msg_print('But you are not carrying any spell-books!');
X`09    end
X`09  else
X`09    msg_print('But you are not carrying any spell-books!')
X`09else
X`09  msg_print('You can''t cast spells!');
X      end;
$ CALL UNPACK [.SOURCE.INCLUDE]MAGIC.INC;1 257528498
$ create 'f'
X`09`7B Use date and time to produce random seed`09`09-RAK-`09`7D
X`5Bpsect(setup$code)`5D function get_seed : unsigned;
X    type
X`09$quad = `5Bquad,unsafe`5D record
X`09`09l0      : unsigned;
X`09`09l1      : unsigned;
X`09end;
X    var
X`09time            : $quad;
X`09seed_val        : unsigned;
X
X    `5Basynchronous,external (SYS$GETTIM)`5D function get_time(
X`09`09var time : $quad) : integer;
X`09`09external;
X
X    begin
X      get_time(time);                           `7B Current time  `7D
X      seed_val := uor(time.l0,time.l1);         `7B Random number `7D
X      get_seed := uor(seed_val,%X'00000001');   `7B Odd number    `7D
X    end;
X
X
X`09`7B Returns the day number; 1=Sunday...7=Saturday `09-RAK-`09`7D
X`5Bpsect(setup$code)`5D function day_num : integer;
X    var
X`09i1              : integer;
X    `5Bexternal(LIB$DAY)`5D function day(
X`09var daynum              : integer;
X`09dum1                    : integer := %immed 0;
X`09dum2                    : integer := %immed 0) : integer;
X`09external;
X    begin
X      day(i1);
X      day_num := ((i1+3) mod 7) + 1;
X    end;
X
X
X`09`7B Returns the hour number; 0=midnight...23=11 PM`09-RAK-`09`7D
X`5Bpsect(setup$code)`5D function hour_num : integer;
X    var
X`09hour            : integer;
X`09time_str        : packed array `5B1..11`5D of char;
X    begin
X      time(time_str);
X      readv(substr(time_str,1,2),hour);
X      hour_num := hour;
X    end;
X
X
X`09`7B Check the day-time strings to see if open`09`09-RAK-`09`7D
X`5Bpsect(setup$code)`5D function check_time : boolean;
X    begin
X      case days`5Bday_num,(hour_num+5)`5D of
X`09'.'  :  check_time := false;    `7B Closed                `7D
X`09'X'  :  check_time := true;     `7B Normal hours          `7D
X`09otherwise check_time := false;  `7B Other, assumed closed `7D
X      end;
X    end;
X
X
X`09`7B Generates a random integer x where 1<=X<=MAXVAL`09-RAK-`09`7D
X  function randint                      (
X`09`09%immed maxval           :       integer
X`09`09`09`09`09) : integer;
X`09external;
X
X  function rand_rep`09`09`09(
X`09`09%immed num              : integer;
X`09`09%immed die              : integer
+-+-+-+-+-+-+-+-  END  OF PART 28 +-+-+-+-+-+-+-+-