$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 20-MAY-1992 06:22:43.80   By user MASMUMMY 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 106 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. BANK.INC;1
$!       2. BIT_POS.MAR;1
$!       3. BIT_POS64.FOR;1
$!       4. BJ.INC;1
$!       5. BLOW.INC;1
$!       6. BUILD.COM;1
$!       7. CASINO.PAS;1
$!       8. CHANGER.INC;1
$!       9. CONSTANTS.INC;1
$!      10. CREATE.PAS;1
$!      11. CREATURE.PAS;1
$!      12. DEATH.PAS;1
$!      13. DESC.PAS;1
$!      14. DISTANCE.MAR;1
$!      15. DUNGEON.PAS;1
$!      16. EAT.INC;1
$!      17. FILES.PAS;1
$!      18. GENERATE.PAS;1
$!      19. GET_ACCOUNT.MAR;1
$!      20. HELP.PAS;1
$!      21. HORSE.INC;1
$!      22. IMORIA.CLD;1
$!      23. IMORIA_SETUP.COM;1
$!      24. INSERT.MAR;1
$!      25. INSURANCE.INC;1
$!      26. INVEN.PAS;1
$!      27. IO.PAS;1
$!      28. MAGIC.INC;1
$!      29. MAXMIN.MAR;1
$!      30. MINMAX.MAR;1
$!      31. MISC.PAS;1
$!      32. MONK.INC;1
$!      33. MONSTERS.DAT;1
$!      34. MORIA.PAS;1
$!      35. MORIADEF.CLD;1
$!      36. MORIAHLP.RNH;1
$!      37. NETOPEN.PAS;1
$!      38. PLAY.INC;1
$!      39. PLAYER.PAS;1
$!      40. POTIONS.INC;1
$!      41. PRAYER.INC;1
$!      42. PUTQIO.MAR;1
$!      43. QUEST.PAS;1
$!      44. RANDINT.MAR;1
$!      45. RANDREP.MAR;1
$!      46. ROUTINES.INC;1
$!      47. SAVE.PAS;1
$!      48. SCREEN.PAS;1
$!      49. SCROLLS.INC;1
$!      50. SING.INC;1
$!      51. SLOTS.INC;1
$!      52. SPELLS.INC;1
$!      53. STAFFS.INC;1
$!      54. STORE.PAS;1
$!      55. SUBQUAD.MAR;1
$!      56. TERMDEF.PAS;1
$!      57. TRADE.INC;1
$!      58. TYPES.INC;1
$!      59. USERS.MAR;1
$!      60. UW_ID.FOR;1
$!      61. VALUES.INC;1
$!      62. VARIABLES.INC;1
$!      63. WANDS.INC;1
$!      64. WIZARD.PAS;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X`5Bpsect(bank$code)`5D procedure enter_bank;
X`20
Xvar
X        exit_flag       : boolean;
X        shop_owner      : vtype;
X        out_val         : vtype;
X `09tics`09`09: integer;
X`09coin$name`09: array `5B4..6`5D of vtype;
X
X
X`7B Display their money    ADW`7D
Xprocedure display_money;
X  var
X        out_val : vtype;
X  begin
X    writev(out_val,' Gold remaining : ',(py.misc.money`5Btotal$`5D):1);
X    prt(out_val,18,18);
X    writev(out_val,' Account : ',(py.misc.account):1);`09
X    prt(out_val,16,20);
X    with py.misc do begin
X      writev(out_val, 'You have ');
X      put_buffer(out_val, 6, 25);
X      writev(out_val, 'Mithril  : ',money`5B6`5D:10);
X      put_buffer(out_val, 8, 25);
X      writev(out_val, 'Platinum : ',money`5B5`5D:10);
X      put_buffer(out_val, 9, 25);
X      writev(out_val, 'Gold     : ',money`5B4`5D:10);
X      put_buffer(out_val, 10, 25);
X      writev(out_val, 'Silver   : ',money`5B3`5D:10);
X      put_buffer(out_val, 12, 25);
X      writev(out_val, 'Copper   : ',money`5B2`5D:10);
X      put_buffer(out_val, 13, 25);
X      writev(out_val, 'Iron     : ',money`5B1`5D:10);
X      put_buffer(out_val, 14, 25);
X    end;
X    if(wizard2) then begin
X      put_buffer('Bank has ', 6, 50);
X      writev(out_val,bank`5Bmithril`5D:10);
X      put_buffer(out_val, 8, 50);
X      writev(out_val,bank`5Bplatinum`5D:10);
X      put_buffer(out_val, 9, 50);
X      writev(out_val,bank`5Bgold`5D:10);
X      put_buffer(out_val, 10, 50);
X    end;
X    put_qio;
Xend;
X`20
X`7BClear the screen and display the bank.`7D`20
Xprocedure display_store;
X  begin
X    clear(1,1);
X    prt(shop_owner,4,10);
X    display_money;
X    prt('You may:',19,1);
X    prt(' d) Deposit money.             w) Withdraw money.',20,1);
X    prt(' c) Change small currency.     i) Buy insurance.',21,1);
X    prt('`5EZ) Exit from building.       `5ER) Redraw the screen.',22,1);
X    prt(' p) Put item in vault.         r) Remove item from vault.',23,1);
X  end;
X`20
X`7B Returns true if a number >= 0 is entered, false if escaped, `7D
X`7B negative numbers not permitted.                      -MKC-  `7D
Xfunction get_entry(comment : vtype; var num : integer) : boolean;
X  var
X        in_val                  : vtype;
X        valid                   : boolean;
X  begin
X    num:=-1;
X    repeat
X      valid:=true;
X      msg_print(comment);
X      msg_flag := false;
X      if get_string(in_val,1,length(comment)+2,40) then begin
X        readv(in_val,num,error:=continue);
X        if (num>=0) then get_entry:=true
X          else begin
X            msg_print('Invalid entry.');
X            valid:=false
X          end
X      end else begin       `7Buser escaped out`7D
X        erase_line(msg_line,msg_line);
X        get_entry:=false;
X      end;
X    until valid;
X  end;
X`20
X`7B Deposit a given number of mithril, platinum, and gold in the bank, `7D
X`7B but the bank takes its percentage                      -ADW-MKC-   `7D`2
V0
Xprocedure deposit_money;
X  var
X        deposit                 : integer;
X
X  procedure dep_munny(mon_type : integer);
X    var deposit : integer;
X    begin
X     with py.misc do
X      if (money`5Bmon_type`5D > 0) then begin
X`09repeat
X`09  if (get_entry('How much '+coin$name`5Bmon_type`5D+' to deposit?',
X`09`09`09deposit)) then
X`09    if (deposit > money`5Bmon_type`5D) then
X`09      msg_print('You do not have that much '+name+'!');
X`09until (deposit <= money`5Bmon_type`5D);
X`09if (deposit>0) then begin
X`09  bank`5Bmon_type`5D := bank`5Bmon_type`5D + deposit;
X`09  money`5Bmon_type`5D := money`5Bmon_type`5D - deposit;
X`09  inven_weight := inven_weight - coin$weight * deposit;
X`09  account := account + trunc(deposit*bank_skim*coin$value`5Bmon_type`5D)
X`09`09div gold$value;
X`09  display_money;
X`09end;
X      end;
X    end;
X
X  begin
X    dep_munny(mithril);
X    dep_munny(platinum);
X    dep_munny(gold);
X    reset_total_cash;
X  end;
X`20
X`7B Withdraw a given amount, in gold pieces, teller makes change. `7D
X`7B Bank may not have enough!                              -MKC-  `7D`20
Xprocedure withdraw_money;
X  var
X        deliver,is_some`09`09`09: boolean;
X`09amt_given`09`09`09: array`5Bgold..mithril`5D of integer;
X        mon_type,withdraw,weight_left`09: integer;
X`09out_val`09`09`09`09: vtype;
X     `20
X  begin
X    with py.misc do begin
X      repeat  `7B get amount to withdraw `7D
X        if get_entry('How much money to withdraw (in gold)?',withdraw) then
X          if(withdraw > account) then begin
X            msg_print('You do not have that much!');
X            msg_print('You should keep better track of your account!');
X          end;
X      until (withdraw<=account);
X`7B The amount actually given is the minimum of how much the user wants, `7D
X`7B how much the bank has, and how much the user can carry.              `7D
X      if(withdraw>0) then begin
X`09weight_left := weight_limit*100-inven_weight;
X`09for mon_type := gold to mithril do
X`09  begin
X`09   amt_given`5Bmon_type`5D := min((withdraw * gold$value) div
X`09     coin$value`5Bmon_type`5D,bank`5Bmon_type`5D,weight_left div coin$wei
Vght);
X`09   weight_left:=weight_left - amt_given`5Bmon_type`5D*coin$weight;
X`09   withdraw:=withdraw-amt_given`5Bmon_type`5D*(coin$value`5Bmon_type`5D
X`09`09 div gold$value);
X`09  end;
X        deliver:=true;
X`09is_some := amt_given`5Bmithril`5D+amt_given`5Bplatinum`5D+amt_given`5Bgol
Vd`5D>0;
X`09if (withdraw>0) then  `7B if unable to give the entire amount `7D
X`09  if (weight_left>0) then  `7B they can't carry it all `7D
X`09    if (is_some) then
X`09     begin
X`09      msg_print('You cannot carry it all.');
X`09      deliver:=get_yes_no('Do you want as much as you can carry?')
X`09     end
X`09    else
X`09     begin
X`09      msg_print('You cannot carry any more money.');
X`09      deliver:=false;
X`09    end
X`09  else begin `7B the bank doesn't have enough money `7D
X`09    if (is_some) then begin
X`09      msg_print('We are rather short of cash today.');
X`09      deliver:=get_yes_no('Do you want as much as you can get?')
X`09    end
X`09    else begin
X`09      msg_print('We do not have the cash to give you.');
X`09      msg_print('Try again tomorrow.');
X`09      deliver:=false;
X`09    end;
X          end;
X`09if deliver then begin
X`09  for mon_type := gold to mithril do
X`09    begin
X`09      if (amt_given`5Bmon_type`5D > 0) then
X`09`09begin
X`09`09  writev(out_val,'The teller gives you ',amt_given`5Bmon_type`5D:1,
X`09`09`09' '+coin$name`5Bmon_type`5D+' pieces.');
X`09`09  msg_print(out_val);
X`09`09  money`5Bmon_type`5D := money`5Bmon_type`5D + amt_given`5Bmon_type`5D
V;
X`09`09  bank`5Bmon_type`5D := bank`5Bmon_type`5D - amt_given`5Bmon_type`5D;
X`09`09  account := account-amt_given`5Bmon_type`5D*coin$value`5Bmon_type`5D
X`09`09`09div gold$value;
X`09`09end;
X`09    end;
X`09  inven_weight := weight_limit*100-weight_left;
X          reset_total_cash;
X          display_money;
X`09end;  `7Bdeliver`7D
X      end;  `7Bwithdraw`7D
X    end;  `7Bwith`7D
X  end;  `7Bwithdraw_money`7D
X
X   `7B  characters can put items in storage  `7D
X  procedure safe_deposit (deposit : boolean);
X
X
X`09var
X`09  junk_list`09`09: array`5B1..20`5D of vtype;
X`09  count`09`09`09: integer;
X`09  com_ptr`09`09: treas_ptr;
X`09  out_val       `09: vtype;
X`09  temp`09`09`09: integer;
X`09  f1`09`09`09: text;
X`09  f2`09`09`09: text;
X`09  in_char`09`09: char;
X`09  i1`09`09`09: integer;
X`09  redraw`09`09: boolean;
X
X  begin
X    redraw := false;
X    with py.misc do
X    if (deposit) then
X      if (inven_ctr > 0) then
X      begin
X`09count := change_all_ok_stats(true,false);
X`09com_ptr := inventory_list;
X`09while (com_ptr <> nil) do
X`09begin
X`09  if(com_ptr`5E.data.tval=bag_or_sack) and (com_ptr`5E.insides<>0) then
X`09  begin
X`09    com_ptr`5E.ok := false;
X`09    count := count - 1;
X`09  end;
X`09  com_ptr := com_ptr`5E.next;
X`09end;
X`09if (get_item(com_ptr,'Deposit?',redraw,count,in_char,false)) then
X`09begin
X`09  if (com_ptr`5E.data.cost > 10000) then
X`09  begin
X`09    open(f1,file_name:='Moria_Bnk',history:=unknown,error:=continue);
X`09    if (status(f1) = 0) then
X`09    begin
X`09      extend(f1);
X`09      objdes(out_val,com_ptr,true);
X`09      msg_print('Deposited ' + out_val + '.');
X`09      msg_print(' ');
X`09      writeln(f1,py.misc.ssn);
X`09      with com_ptr`5E.data do
X `09      begin
X`09`09writeln(f1,name);
X`09`09writeln(f1,tval);
X`09`09writeln(f1,tchar);
X`09`09writeln(f1,flags2);
X`09`09writeln(f1,flags);
X`09`09writeln(f1,p1);
X`09`09writeln(f1,cost);
X`09`09writeln(f1,subval);
X`09`09writeln(f1,weight);
X`09`09writeln(f1,number);
X`09`09writeln(f1,tohit);
X`09`09writeln(f1,todam);
X`09`09writeln(f1,ac);
X`09`09writeln(f1,toac);
X`09`09writeln(f1,damage);
X`09`09writeln(f1,level);
X`09      end;
X`09      writeln(f1,com_ptr`5E.ok);
X`09      inven_destroy(com_ptr);
X`09      close(f1);
X`09    end;
X`09  end
X`09else
X`09  begin
X`09    msg_print('Put that back in your pack.  We only allow *valued* items
V in our vault');
X`09    msg_print(' ');
X`09  end;
X`09end;
X      end
X      else
X        prt('But you aren''t carrying anything.',1,1)
X    else
X      begin
X        open(f1,file_name:='Moria_bnk',history:=old,error:=continue);
X        if (status(f1) <> 0) then
X        begin
X`09  count := 0;
X`09  repeat
X`09    count := count + 1;
X`09    readln(f1,out_val);
X`09    if (out_val = py.misc.ssn) then
X`09    begin
X`09      readln(f1,junk_list`5Bcount`5D);
X`09      for i1 :=1 to 16 do readln(f1,out_val);`09`09
X`09    end
X`09    else
X`09      for i1 :=1 to 17 do readln(f1,out_val);
X`09  until (eof or (count > 19));
X`09  close(f1);
X        end;
X`09prt('Remove which one?',1,1);
X`09for i1 := 1 to count do
X          prt(chr(i1+96)+') '+junk_list`5Bi1`5D,i1+2,1);
X      end; `20
X      display_store;
X    end;
X
X  procedure change_money;
X`7B  Changes money of one type to money of another type.        -JPS- `7D
X    var`20
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-