-+-+-+-+-+-+-+-+ START OF PART 106 -+-+-+-+-+-+-+-+
X`09    if input_field('(0-32767) Mana = ',tmp_val,0,32767,flag) then
X`09      begin
X`09        if flag then
X`09`09  begin
X`09`09    mana := tmp_val;
X`09`09    cmana := mana;
X`09`09    prt_mana;
X`09`09  end
X`09      end
X`09    else
X`09      goto abort;
X`09  tmp_val := srh;
X`09  if input_field('(0-200) Searching = ',tmp_val,0,200,flag) then
X`09    srh := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := stl;
X`09  if input_field('(0-10) Stealth = ',tmp_val,0,10,flag) then
X`09    stl := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := disarm;
X`09  if input_field('(0-200) Disarming = ',tmp_val,0,200,flag) then
X`09    disarm := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := save;
X`09  if input_field('(0-100) Save = ',tmp_val,0,100,flag) then
X`09    save := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := bth;
X`09  if input_field('(0-200) Base to hit = ',tmp_val,0,200,flag) then
X`09    bth := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := bthb;
X`09  if input_field('(0-200) Bows/Throwing = ',tmp_val,0,200,flag) then `20
X`09    bthb := tmp_val
X`09  else
X`09    goto abort;
X`09  tmp_val := money`5Btotal$`5D;
X`09  if input_field('Player Gold = ',tmp_val,0,100000000,flag) then
X`09    begin
X`09      if flag then
X`09`09begin
X`09`09  tmp_val := (tmp_val-money`5Btotal$`5D)*gold$value;
X`09`09  if (tmp_val>0) then
X`09`09    add_money(tmp_val)
X`09`09  else
X`09`09    subtract_money(-tmp_val,true);
X`09`09  prt_weight;
X`09`09  prt_gold;
X`09`09end;
X`09    end
X`09  else
X`09    goto abort;
X`09  if not input_field('Account Gold = ',account,0,1000000000,flag) then
X`09    goto abort;
X`09  tmp_val := inven_weight;
X`09  if input_field('Current Weight (100/unit weight) = ',tmp_val,0,900000,f
Vlag) then
X`09    begin
X`09      inven_weight := tmp_val;
X`09      prt_weight;
X`09    end
X`09  else
X`09    goto abort;
X`09end;
Xabort:
X      erase_line(msg_line,msg_line);
X      py_bonuses(blank_treasure,0);
X    end;
X
X
X
X`09`7B Wizard routine to edit high score file`09`09-DMF-`09`7D
X`5Bglobal,psect(wizard$code)`5D procedure edit_score_file;
X    const
X`09display_size`09= 15;
X    type
X`09list_elem = record
X`09`09data`09: string;
X`09`09next`09: `5Elist_elem;
X`09end;
X`09list_elem_ptr = `5Elist_elem;
X    var
X`09data_list`09: list_elem_ptr;
X`09cur_top`09`09: list_elem_ptr;
X`09blegga`09`09: list_elem_ptr;
X`09curse`09`09: list_elem_ptr;
X`09cur_display`09: array `5B1..display_size`5D of list_elem_ptr;
X`09cur_display_size: integer;
X`09blank`09`09: packed array `5B1..13`5D of char;
X`09i1,i2,i3,i4`09: integer;
X`09trys`09`09: integer;
X`09f1`09`09: text;
X`09flag,file_flag`09: boolean;
X`09exit_flag`09: boolean;
X`09temp,temp2`09: ntype;
X`09ch`09`09: char;
X`09want_save`09: boolean;
X    procedure display_commands;
X      begin
X`09prt('You may:',21,1);
X`09prt(' d) Delete an entry.              b) Browse to next page.',22,1);
X`09prt(' c) Change an entry.',23,1);
X`09prt('`5EZ) Exit and save changes         q) Quit without saving.',24,1);
X      end;
X    procedure display_list(start : list_elem_ptr);
X      var
X`09`09count,old_display_size`09: integer;
X      begin
X`09old_display_size := cur_display_size;
X`09count := 0;
X`09while (start <> nil) and (count < display_size) do
X`09  begin
X`09    count := count + 1;
X`09    if (cur_display`5Bcount`5D <> start) then
X`09      begin
X`09`09cur_display`5Bcount`5D := start;
X`09`09writev(temp2,chr(96+count),')',start`5E.data);
X`09`09if (length(temp2) > 80) then temp2 := substr(temp2,1,80);
X`09`09prt(temp2,count+3,1);
X`09      end;
X`09    start := start`5E.next;
X`09  end;
X`09cur_display_size := count;
X`09while (old_display_size > cur_display_size) do
X`09  begin
X`09    erase_line(old_display_size+3,1);
X`09    cur_display`5Bold_display_size`5D := nil;
X`09    old_display_size := old_display_size - 1;
X`09  end;
X`09if (start = nil) then
X`09  blegga := data_list
X`09else
X`09  blegga := start;
X      end;
X    procedure clear_display;
X      var
X`09`09index`09: integer;
X      begin
X`09cur_display_size := 0;
X`09for index := 1 to display_size do
X`09  cur_display`5Bindex`5D := nil;
X      end;
X    procedure display_screen;
X      begin
X`09clear(1,1);
X`09clear_display;
X`09put_buffer('  Username     Points  Diff    Character name    Level  Race
V         Class',2,1);
X`09put_buffer('  ____________ ________ _ ________________________ __ _______
V___ ______________',3,1);
X`09display_list(cur_top);
X`09display_commands;
X      end;
X    function get_list_entry(
X`09`09var com_val`09: integer;
X`09`09pmt`09`09: vtype;
X`09`09i1,i2`09`09: integer) : boolean;
X      var
X`09`09command`09`09: char;
X`09`09flag`09`09: boolean;
X      begin
X`09com_val := 0;
X`09flag := true;
X`09writev(out_val,'(Entries ',chr(i1+96),'-',chr(i2+96),', `5EZ to exit) ',
X`09`09`09pmt);
X`09while (((com_val < i1) or (com_val > i2)) and (flag)) do
X`09  begin
X`09    prt(out_val,1,1);
X`09    inkey(command);
X`09    com_val := ord(command);
X`09    case com_val of
X`09      3,25,26,27 : flag := false;
X`09      otherwise com_val := com_val - 96;
X`09    end;
X`09  end;
X`09erase_line(1,1);
X`09get_list_entry := flag;
X      end;
X    procedure parse_command;
X      var
X`09command`09`09`09: char;
X`09com_val,which`09`09: integer;
X`09user,score,name,level`09: string;
X`09race,class,diffic`09: string;
X`09sc,lvl,diff`09`09: integer;
X`09top_flag`09`09: boolean;
X
X      begin
X`09if get_com('',command) then
X`09  begin
X`09    com_val := ord(command);
X`09    case com_val of
X`7B`5ER`7D`09      18: display_screen;
X`7Bb`7D`09      98: begin
X`09`09    if (cur_top = blegga) then
X`09`09      prt('Entire list is displayed.',1,1)
X`09`09    else
X`09`09      begin
X`09`09`09cur_top := blegga;
X`09`09`09display_list(cur_top);
X`09`09      end;
X`09`09  end;
X`7Bc`7D`09      99: begin
X`09`09    if (cur_display_size > 0) then
X`09`09      if (get_list_entry(which,' Change which one?',1,
X`09`09`09`09`09 cur_display_size)) then
Xbegin
X  prt('Username : ',1,1);
X  if (get_string(user,1,12,12)) then
X    begin
X      prt('Score : ',1,1);
X      if (get_string(score,1,9,8)) then
X`09begin
X`09  prt('Character name : ',1,1);
X`09  if (get_string(name,1,18,24)) then
X`09    begin
X`09      prt('Level : ',1,1);
X`09      if (get_string(level,1,9,2)) then
X`09`09begin
X`09`09  prt('Race : ',1,1);
X`09`09  if (get_string(race,1,8,10)) then
X`09`09    begin
X`09`09      prt('Class : ',1,1);
X`09`09      if (get_string(class,1,9,16)) then
X`09`09`09begin
X`09`09`09  prt('Difficulty : ',1,1);
X`09`09`09  if (get_string(diffic,1,14,1)) then
X`09`09`09    begin
X`09`09`09      readv(score,sc,error:=continue);
X`09`09`09      readv(level,lvl,error:=continue);
X`09`09`09      readv(diffic,diff,error:=continue);
X`09`09`09      writev(cur_display`5Bwhich`5D`5E.data,
X`09`09`09`09`09pad(user,' ',13),sc:8,' ',diff:1,' ',
X`09`09`09`09`09center(name,24),' ',lvl:2,' ',
X`09`09`09`09`09center(race,10),' ',center(class,16),
X`09`09`09`09`09error:=continue);
X`09`09`09      cur_display`5Bwhich`5D := nil;
X`09`09`09      display_list(cur_top);
X`09`09`09      prt('Score changed.',1,1);
X`09`09`09    end
X`09`09`09  else
X`09`09`09    prt('Score not changed.',1,1);
X`09`09`09end
X`09`09      else
X`09`09`09prt('Score not changed.',1,1);
X`09`09    end
X`09`09  else
X`09`09    prt('Score not changed.',1,1);
X`09`09end
X`09      else
X`09`09prt('Score not changed.',1,1);
X`09    end
X          else
X`09    prt('Score not changed.',1,1);
X`09end
X      else
X`09prt('Score not changed.',1,1);
X    end
X  else
X    prt('Score not changed.',1,1);
Xend;
X`09`09  end;
X`7Bd`7D`09     100: begin
X`09`09    if (cur_display_size > 0) then
X`09`09      if (get_list_entry(which,' Delete which one?',1,
X`09`09`09`09`09 cur_display_size)) then
X`09`09`09begin
X`09`09`09  if (cur_display`5Bwhich`5D = cur_top) then`20
X`09`09`09    top_flag := true
X`09`09`09  else
X`09`09`09    top_flag := false;
X`09`09`09  curse := data_list;
X`09`09`09  while (curse`5E.next <> cur_display`5Bwhich`5D) do
X`09`09`09    curse := curse`5E.next;
X`09`09`09  curse`5E.next := cur_display`5Bwhich`5D`5E.next;
X`09`09`09  if (top_flag) then cur_top := curse`5E.next;
X`09`09`09end;
X`09`09`09cur_display`5Bwhich`5D := nil;
X`09`09`09display_list(cur_top);
X`09`09  end;
X`7Bq`7D`09     113: begin
X`09`09    exit_flag := true;
X`09`09    want_save := false;
X`09`09  end;
X`09      otherwise prt('Invalid command',1,1);
X`09    end;
X`09  end
X        else
X`09  exit_flag := true;
X      end;
X    begin
X      trys := 0;
X      file_flag := false;
X      repeat
X`09open (f1,file_name:=moria_top,organization:=sequential,history:=old,
X`09`09 sharing:=none,error:=continue);
X`09if (status(f1) = 2) then
X`09  begin
X`09    trys := trys + 1;
X`09    if (trys > 5) then
X`09      file_flag := true
X`09    else
X`09      sleep(2);
X`09  end
X`09else
X`09  file_flag := true;
X      until(file_flag);
X      if (status(f1) <> 0) then
X`09begin
X`09  msg_print('Couldn''t open top score file.');
X`09  msg_print('Try again later.');
X`09end
X      else
X`09begin
X`09  data_list := nil;
X`09  want_save := true;
X`09  reset(f1);
X`09  while (not eof(f1)) do
X`09    begin
X`09      readln(f1,temp,error:=continue);
X`09      seed := encrypt_seed1;
X`09      decrypt(temp);
X`09      if (data_list = nil) then
X`09`09begin
X`09`09  new(data_list);
X`09`09  data_list`5E.next := nil;
X`09`09  data_list`5E.data := temp;
X`09`09  curse := data_list;
X`09`09end
X`09      else
X`09`09begin
X`09`09  new(curse`5E.next);
X`09`09  curse := curse`5E.next;
X`09`09  curse`5E.next := nil;
X`09`09  curse`5E.data := temp;
X`09`09end;
X`09    end;
X`09  exit_flag := false;
X`09  cur_top := data_list;
X`09  display_screen;
X`09  while not exit_flag do parse_command;
X`09  if (want_save) then
X`09    begin
X`09      rewrite(f1);
X`09      curse := data_list;
X`09      while (curse <> nil) do
X`09`09begin
X`09`09  temp := curse`5E.data;
X`09`09  seed := encrypt_seed1;
X`09`09  encrypt(temp);
X`09`09  writeln(f1,temp);
X`09`09  curse := curse`5E.next;
X`09`09end;
X`09    end;
X`09  close(f1);
X`09end;
X      draw_cave;
X    end;
X
X`09`7B Wizard routine for creating objects`09`09`09-RAK-`09`7D
X`5Bglobal,psect(wizard$code)`5D procedure wizard_create;
X    var
X`09tmp_val`09`09`09: integer;
X`09tmp_str`09`09`09: vtype;
X`09flag`09`09`09: boolean;
X    begin
X      msg_print('Warning: This routine can cause fatal error.');
X      msg_print(' ');
X      msg_flag := false;
X      with inven_temp`5E.data do
X`09begin
X          prt('Name   : ',1,1);
X          if (get_string(tmp_str,1,10,40)) then
X`09    name := tmp_str
X`09  else
X`09    name := '& Wizard Object!';
X`09  repeat
X`09    prt('Tval   : ',1,1);
X`09    get_string(tmp_str,1,10,10);
X`09    tmp_val := 0;
X`09    readv(tmp_str,tmp_val,error:=continue);
X`09    flag := true;
X`09    case tmp_val of
X`09      1,3,6,13,15`09: tchar := '`7E';
X`09      4,5`09`09: tchar := '*';
X`09      2 `09`09: tchar := '&';
X`09      10,11,12`09`09: tchar := '`7B';
X`09      20`09`09: tchar := '`7D';
X`09      21`09`09: tchar := '/';
X`09      22,25`09`09: tchar := '\';
X`09      23`09`09: tchar := '`7C';
X`09      30,31,33`09`09: tchar := '`5D';
X`09      32,36`09`09: tchar := '(';
X`09      34`09`09: tchar := ')';
X`09      35`09`09: tchar := '`5B';
X`09      40`09`09: tchar := '"';
X`09      45`09`09: tchar := '=';
X`09      55`09`09: tchar := '_';
X`09      60,65`09`09: tchar := '-';
X`09      70,71,90,91`09: tchar := '?';
X`09      75,76,77`09`09: tchar := '!';
X`09      80`09`09: tchar := ',';
X`09      85,86,92`09`09: tchar := '%';
X`09      otherwise`09flag := false;
X`09    end;
X`09  until (flag);
X`09  tval := tmp_val;
X`09  prt('Subval : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 1;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  subval := tmp_val;
X`09  prt('Weight : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 1;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  weight := tmp_val;
X`09  prt('Number : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 1;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  number := tmp_val;
X`09  prt('Damage : ',1,1);
X`09  get_string(tmp_str,1,10,5);
X`09  damage := tmp_str;
X`09  prt('+To hit: ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  tohit := tmp_val;
X`09  prt('+To dam: ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  todam := tmp_val;
X`09  prt('AC     : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  ac := tmp_val;
X`09  prt('+To AC : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  toac := tmp_val;
X`09  prt('P1     : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  p1 := tmp_val;
X`09  prt('Flags  (In HEX): ',1,1);
X`09  flags := get_hex_value(1,18,8);
X`09  prt('Flags2 (In HEX): ',1,1);
X`09  flags2 := get_hex_value(1,18,8);
X`09  prt('Cost : ',1,1);
X`09  get_string(tmp_str,1,10,10);
X`09  tmp_val := 0;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  cost := tmp_val;
X`09  if (get_com('Allocate? (Y/N)',command)) then
X`09    case command of
X`09`09'y','Y':  begin
X`09`09`09    popt(tmp_val);
X`09`09`09    t_list`5Btmp_val`5D := inven_temp`5E.data;
X`09`09`09    with cave`5Bchar_row,char_col`5D do
X`09`09`09      begin
X`09`09`09`09if (tptr > 0) then
X`09`09`09`09  delete_object(char_row,char_col);
X`09`09`09`09tptr := tmp_val;
X`09`09`09      end;
X`09`09`09    msg_print('Allocated...');
X`09`09`09  end;
X`09`09otherwise msg_print('Aborted...');
X`09    end;
X`09  inven_temp`5E.data := blank_treasure;
X`09end;
X`09move_char(5);
X`09creatures(false);
X    end;
Xend.
X
X
X
X
X
X
$ CALL UNPACK WIZARD.PAS;1 470359579
$ v=f$verify(v)
$ EXIT