-+-+-+-+-+-+-+-+ START OF PART 87 -+-+-+-+-+-+-+-+
X`09      IF weight_changed THEN prt_weight;
X`09      IF gold_changed THEN prt_gold;
X`09    END
X`09  ELSE
X`09    BEGIN
X`09      if redisplay then cur_top := inv;
X`09      IF gold_changed OR weight_changed THEN msg_print( ' ' );
X`09    END;
X`09END;
X
X`09`7B Get the ID of a store item and return it's value`09-RAK-`09`7D
X`5Bpsect(store$code)`5D function get_store_item(
X`09`09`09`09var com_val`09: integer;
X`09`09`09`09pmt`09 `09: vtype;
X`09`09`09`09i1,i2`09`09: integer) : boolean;
X      var
X`09`09command `09: char;
X`09`09out_val`09`09: vtype;
X`09`09flag`09`09: boolean;
X      begin
X`09com_val := 0;
X`09flag := true;
X`09writev(out_val,'(Items ',chr(i1+96),'-',chr(i2+96),
X`09`09`09`09`09', `5EZ to exit) ',pmt);
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`093,25,26,27 :`09flag := false;
X`09`09otherwise com_val := com_val - 96;
X`09    end;
X`09  end;
X`09msg_flag := false;
X`09erase_line(msg_line,msg_line);
X`09get_store_item := flag;
X      end;
X
XPROCEDURE dump( filename : vtype );
X
X`09VAR
X
X`09`09dump`09: TEXT;
X`09`09item`09: inven_ptr;
X`09`09out_val`09: vtype;
X
X`09BEGIN
X`09  OPEN( dump, FILE_NAME:=filename, ERROR:=CONTINUE );
X`09  IF STATUS(dump) = 0 THEN
X`09    BEGIN
X`09      if filename <> 'NL:' then msg_print('Dumping to '+filename);
X`09      REWRITE(dump);
X`09      item := inv;
X `09      WHILE item <> NIL DO
X`09`09WITH item`5E.data DO BEGIN
X`09`09  CASE item`5E.data.trade_type OF
X`09`09    for_sale :
X`09`09      BEGIN
X`09`09`09writeln( dump, 'for sale:' );
X`09`09`09SYS$ASCTIM( out_val.length, out_val.body, time, );
X`09`09`09writeln( dump, '  time:        ', out_val );
X`09`09`09inven_temp`5E.data := object;
X`09`09`09objdes( out_val, inven_temp, true );
X`09`09`09writeln( dump, '  object:      ', out_val );
X`09`09`09writeln( dump, '  seller:      ', seller );
X`09`09`09SYS$ASCTIM( out_val.length, out_val.body, bid_time, );
X`09`09`09writeln( dump, '  bid time:    ', out_val );
X`09`09`09writeln( dump, '  best bid:    ', best_bid:1 );
X`09`09`09writeln( dump, '  best bidder: ', best_bidder );
X`09`09      END;
X`09`09    cash :
X`09`09      BEGIN
X`09`09`09writeln( dump, 'cash:' );
X`09`09`09SYS$ASCTIM( out_val.length, out_val.body, time, );
X`09`09`09writeln( dump, '  time:   ', out_val );
X`09`09`09writeln( dump, '  amount: ', amount:1 );
X`09`09`09writeln( dump, '  owner:  ', owner );
X`09`09      END;
X`09`09  END;
X`09`09  item := item`5E.next;
X`09`09END;
X`09      CLOSE( dump )
X`09    END
X`09  ELSE
X`09    msg_print( 'Error opening TRADE.DUMP' );
X`09  if (filename <> 'NL:') then msg_print( '' );
X`09END;
X
XPROCEDURE bid;
X
X`09VAR
X
X`09`09offer,to_bank,which`09`09: INTEGER;
X`09`09item`09`09`09`09: inven_ptr;
X`09`09flag`09`09`09`09: boolean;
X
X`09BEGIN
X`09  IF (cur_display_size > 0) THEN
X`09  IF get_store_item( which, 'Which one?', 1, cur_display_size ) THEN
X`09    BEGIN
X`09      msg_print( 'How much do you offer? ' );
X`09      IF NOT get_string( out_val, 1, 24, 40) THEN erase_line( 1, 1 )
X`09      ELSE
X`09`09BEGIN
X`09`09  READV( out_val, offer, ERROR:=CONTINUE );
X`09`09  IF offer <= (`09cur_display`5Bwhich`5D`5E.data.best_bid *
X`09`09`09`09bid_increment_factor ) THEN
X`09`09    msg_print('You''ll have to do better than that!')
X`09`09  ELSE
X`09`09    begin
X`09`09      flag := false;
X`09`09      if (py.misc.money`5Btotal$`5D >= offer) then
X`09`09`09begin
X`09`09`09  subtract_money(offer*gold$value,true);
X`09`09`09  flag := true;
X`09`09`09end
X`09`09      else
X`09`09`09begin
X`09`09`09  to_bank := offer - py.misc.money`5Btotal$`5D;
X`09`09`09  flag := send_page(to_bank);
X`09`09`09end;
X`09`09      if (flag) then begin
X`09`09      item := cur_display`5Bwhich`5D;
X`09`09      if item`5E.data.best_bid > 0 THEN
X`09`09`09BEGIN
X`09`09`09  send_money(item`5E.data.best_bidder,
X`09`09`09`09     ROUND(refund_on_bid * item`5E.data.best_bid) );
X`09`09`09  dump('NL:');
X`09`09`09  made_profit(ROUND(profit_from_bid *
X`09`09`09`09      item`5E.data.best_bid ) );
X`09`09`09END;
X`09`09      item`5E.data.best_bidder := py.misc.ssn;
X`09`09      item`5E.data.best_bid := offer;
X`09`09      SYS$GETTIM( item`5E.data.bid_time );
X`09`09      cur_display`5Bwhich`5D := NIL;
X`09`09      item := nil;
X`09`09      deliver;
X`09`09      display_inv( cur_top );
X`09`09      display_gold;
X`09`09      end;
X`09`09    END;
X`09`09END;
X`09    END;
X`09END;
X
XPROCEDURE sell;
X
X`09VAR
X
X`09`09i1`09`09`09`09: INTEGER;
X`09`09item_ptr`09`09`09: treas_ptr;
X`09`09redraw`09`09`09`09: BOOLEAN;
X`09`09item`09`09`09`09: inven_ptr;
X`09`09response`09`09`09: vtype;
X`09`09wgt`09`09`09`09: integer;
X`09`09temp_ptr`09`09`09: treas_ptr;
X
X`09BEGIN
X`09  redraw := FALSE;
X`09  response := '';
X`09  change_all_ok_stats(true,true);
X`09  IF get_item(item_ptr,'Which one? ',redraw,inven_ctr,trash_char,false) T
VHEN
X`09    BEGIN
X`09      wgt := 0;
X`09      temp_ptr := item_ptr`5E.next;
X`09      if (uand(item_ptr`5E.data.flags2,holding_bit) <> 0) then
X`09`09begin
X`09`09  while ((temp_ptr <> nil) and (temp_ptr`5E.is_in)) do
X`09`09  begin
X`09`09    wgt := wgt + temp_ptr`5E.data.weight * temp_ptr`5E.data.number;
X`09`09    temp_ptr := temp_ptr`5E.next;
X`09`09  end;
X`09`09end;
X`09      IF ( index( item_ptr`5E.data.name, '`7C' ) > 0 ) OR
X`09`09 ( index( item_ptr`5E.data.name, '`5E' ) > 0 ) THEN
X`09`09  response := 'I can''t sell that!  Identify it first!'
X`09      else if (wgt <> 0) then
X`09`09response := 'Hey that bag is full of items! Empty it first.'
X`09      else if (item_ptr`5E.is_in) then
X`09`09response := 'You can''t sell an item *IN* a bag of holding.'
X`09      ELSE IF`09item_value( item_ptr`5E.data ) <
X`09`09`09acceptable_item_price THEN
X`09`09  response := 'What is THAT?  I won''t have that in my shop!'
X`09      ELSE
X`09`09BEGIN
X`09`09  NEW( item );
X`09`09  item`5E.next := inv;
X`09`09  item`5E.prev := NIL;
X`09`09  item`5E.data.trade_type := for_sale;
X`09`09  item`5E.data.seller := py.misc.ssn;
X`09`09  item`5E.data.object := item_ptr`5E.data;
X`09`09  item`5E.data.object.number := 1;
X`09`09  item`5E.data.best_bid := 0;
X`09`09  SYS$GETTIM( item`5E.data.time );
X`09`09  if (inv <> nil) then inv`5E.prev := item;
X`09`09  inv := item;
X`09`09  cur_top := inv;
X`09`09  inven_weight := inven_weight - item_ptr`5E.data.weight;
X`09`09  item_ptr`5E.data.number := item_ptr`5E.data.number - 1;
X`09`09  if item_ptr`5E.data.number <= 0 then
X`09`09    delete_inven_item(item_ptr);
X`09`09  response := 'Remember to come pick up your cash when it sells.';
X`09        END;
X`09    END;
X`09  IF redraw
X`09    THEN display_store
X`09    ELSE display_inv( cur_top );
X`09  msg_print( response );
X`09END;
X
XPROCEDURE parse_command;
X
X`09VAR
X
X`09`09command`09`09`09: CHAR;
X`09`09com_val,which`09`09: INTEGER;
X`09`09out_val`09`09`09: vtype;
X`09`09ssn`09`09`09: ssn_type;
X`09`09item`09`09`09: inven_ptr;
X
X`09BEGIN
X`09  IF get_com( '', command ) THEN
X`09    BEGIN
X`09      com_val := ORD( command );
X`09      CASE com_val OF
X`7Bctrl-d`7D`094`09: IF wizard2 THEN
X`09`09`09    BEGIN
X`09`09`09      IF (cur_display_size > 0) THEN
X`09`09`09      IF get_store_item( which, 'Delete which one?',
X`09`09`09`09`091, cur_display_size ) THEN
X`09`09`09`09BEGIN
X`09`09`09`09  IF get_com( 'Refund money? (Y/N)', command ) THEN
X`09`09`09`09    CASE command OF
X`09`09`09`09      'y', 'Y'`09: WITH cur_display`5Bwhich`5D`5E.data
X`09`09`09`09`09DO BEGIN
X`09`09`09`09`09  send_money( best_bidder, ROUND(
X`09`09`09`09`09`09refund_on_bid * best_bid ) );
X`09`09`09`09`09  made_profit( ROUND( profit_from_bid *
X`09`09`09`09`09`09best_bid ) );
X`09`09`09`09`09  send_money( seller, ROUND( item_value(
X`09`09`09`09`09`09object ) * refund_on_sale ) );
X`09`09`09`09`09  made_profit( -ROUND( item_value(
X`09`09`09`09`09`09object ) * refund_on_sale ) );
X`09`09`09`09`09END;
X`09`09`09`09      OTHERWISE ;
X`09`09`09`09    END;
X`09`09`09`09  delete_item( cur_display`5Bwhich`5D );
X`09`09`09`09  cur_display`5Bwhich`5D := NIL;
X`09`09`09`09  display_inv( cur_top );
X`09`09`09`09END;
X`09`09`09    END;
X`7Bctrl-e`7D`095`09: IF wizard2 THEN dump( 'TRADE.DUMP' );
X`7Bctrl-i`7D`099`09: IF wizard2 THEN
X`09`09`09    BEGIN
X`09`09`09      IF (cur_display_size > 0) THEN
X`09`09`09      IF get_store_item( which, 'Info on which?',
X`09`09`09`09`091, cur_display_size ) THEN
X`09`09`09`09WITH cur_display`5Bwhich`5D`5E.data DO BEGIN
X`09`09`09`09  erase_line(  8+6, 1 );
X`09`09`09`09  erase_line(  9+6, 1 );
X`09`09`09`09  erase_line( 10+6, 1 );
X`09`09`09`09  erase_line( 11+6, 1 );
X`09`09`09`09  erase_line( 12+6, 1 );
X`09`09`09`09  SYS$ASCTIM( out_val.length, out_val.body,
X`09`09`09`09`09time, );
X`09`09`09`09  prt( 'Sale time : ' + out_val, 9+6, 1 );
X`09`09`09`09  WRITEV( out_val, item_value( object ):1 );
X`09`09`09`09  prt( 'Item value : ' + out_val, 9+6, 60 );
X`09`09`09`09  prt( 'Seller : ' + seller, 10+6, 1 );
X`09`09`09`09  prt( 'Bidder : ' + best_bidder, 11+6, 1 );
X`09`09`09`09  msg_print( 'Press <space> to continue' );
X`09`09`09`09  msg_print( '' );
X`09`09`09`09  cur_display_size := 12;
X`09`09`09`09  cur_display`5B 8`5D := NIL;
X`09`09`09`09  cur_display`5B 9`5D := NIL;
X`09`09`09`09  cur_display`5B10`5D := NIL;
X`09`09`09`09  cur_display`5B11`5D := NIL;
X`09`09`09`09  cur_display`5B12`5D := NIL;
X`09`09`09`09  display_inv( cur_top );
X`09`09`09`09END;
X`09`09`09    END;
X`7Bctrl-p`7D`0916`09: IF wizard2 THEN
X`09`09`09    BEGIN
X`09`09`09      WRITEV( out_val, 'Profits made to date: ',
X`09`09`09`09profits.money:1 );
X`09`09`09      msg_print( out_val );
X`09`09`09    END;
X`7Bctrl-r`7D`0918`09: display_store;
X`09`0932`09: BEGIN
X`09`09`09    IF cur_top = blegga THEN
X`09`09`09      prt( 'Entire inventory is displayed.', 1, 1 )
X`09`09`09    ELSE
X`09`09`09      BEGIN
X`09`09`09`09cur_top := blegga;
X`09`09`09`09display_inv(cur_top);
X`09`09`09      END;
X`09`09`09  END;
X`09`09101`09: IF inven_command( 'e', trash_ptr, '') THEN display_store;
X`09`09105`09: IF inven_command( 'i', trash_ptr,'') THEN display_store;
X`09`09116`09: IF inven_command( 't', trash_ptr,'') THEN display_store;
X`09`09119`09: IF inven_command( 'w', trash_ptr,'') THEN display_store;
X`09`09120`09: IF inven_command( 'x', trash_ptr,'') THEN display_store;
X`09`09112     : IF NOT (py.misc.cheated or total_winner) THEN bid;
X`09`09115     : IF NOT (py.misc.cheated or total_winner) THEN sell;
X`09`09OTHERWISE prt( 'Invalid Command.', 1, 1 );
X`09      END;
X`09    END
X`09  ELSE exit_flag := TRUE;
X`09
X`09END;
X
XBEGIN
X  tics := 1;
X  exit_flag := FALSE;
X  entered := FALSE;
X  open_trade_file;
X  IF NOT exit_flag THEN
X    BEGIN
X      full_ssn := py.misc.ssn; py.misc.ssn`5B70`5D := ' ';
X      read_inv;
X      deliver;
X      IF NOT exit_flag THEN
X`09BEGIN
X`09  display_store;
X`09  entered := TRUE;
X`09  WHILE NOT exit_flag DO
X`09    begin
X`09      parse_command;
X`09      adv_time(false);
X`09      tics := tics + 1;
X`09      check_kickout_time(tics,2);
X`09    end;
X`09END;
X      write_inv;
X      py.misc.ssn := full_ssn;
X      msg_print( 'The storekeeper says "Come again. . ."' ); put_qio;
X      CLOSE( sales, ERROR:=CONTINUE );
X      IF entered THEN draw_cave;
X    END;
X
XEND;
$ CALL UNPACK TRADE.INC;1 1901527655
$ create 'f'
X
X  type
X`09byteint`09`09= `5Bbyte`5D 0..255;
X`09bytlint`09`09= `5Bbyte`5D -128..127;
X`09wordint`09`09= `5Bword`5D 0..65535;
X`09worlint`09`09= `5Bword`5D -32768..32767;
X`09quad_type`09= record
X`09`09`09    l0`09: unsigned;
X`09`09`09    l1  : unsigned;
X`09`09`09  end;
X`09atype`09`09= varying  `5B16`5D of char;
X`09btype`09`09= varying  `5B14`5D of char;
X`09ctype`09`09= varying  `5B26`5D of char;
X`09dtype`09`09= varying   `5B5`5D of char;
X`09etype`09`09= varying  `5B34`5D of char;
X`09htype`09`09= varying  `5B12`5D of char;
X`09string`09`09= varying `5B132`5D of char;
X`09mtype`09`09= varying `5B190`5D of char;
X`09ntype`09`09= varying`5B1024`5D of char;
X`09ttype`09`09= varying  `5B68`5D of char;
X`09vtype`09`09= varying  `5B80`5D of char;
X`09stat_type`09= packed array `5B1..6`5D of char;
X`09account_type`09= Varying  `5B10`5D of char;
X`09obj_set`09`09= set of 0..255;
X`09char_set`09= set of 'A'..'z';
X`09stat_set`09= 0..5;
X`09stat_s_type`09= array `5Bstat_set`5D of byteint;
X`09ssn_type`09= packed array `5B1..70`5D of char;
X`09key_type`09= record`09`09`7B For char saver`09`7D
X`09`09file_id : `5Bkey(0)`5D ssn_type;
X`09`09seed`09: integer;
X`09end;
X`09money_type = array`5Btotal$..mithril`5D of integer;
X`09game_time_type = record
X`09`09year`09: integer;
X`09`09month`09: byteint;
X`09`09day`09: byteint;
X`09`09hour`09: byteint;
X`09`09secs`09: wordint;
X`09end;
X`09time_type = record
X`09`09years`09`09: wordint;
X`09`09months`09`09: wordint;
X`09`09days`09`09: wordint;
X`09`09hours`09`09: wordint;
X`09`09minutes`09`09: wordint;
X`09`09seconds`09`09: wordint;
X`09`09hundredths`09: wordint;
X`09end;
X`09creature_type = record
X`09`09aaf`09: `5Bbit(7),pos(0)`5D 0..127; `7B Area affect radius`09`7D
X`09`09ac`09: `5Bbit(7),pos(8)`5D 0..127;`09`7B AC`09`7D
X`09`09name`09: ctype;`09`7B Descrip of creature`09`7D
X`09`09cmove`09: unsigned;`09`7B Bit field`09`09`7D
X`09`09spells`09: unsigned;`09`7B Creature spells`09`7D
X`09`09cdefense: unsigned;`09`7B Bit field`09`09`7D
X`09`09sleep`09: worlint;`09`7B Inactive counter`09`7D
X`09`09mexp`09: integer;`09`7B Exp value for kill`09`7D
X`09`09speed`09: bytlint;`09`7B Movement speed`09`7D
X`09`09cchar`09: char;`09`09`7B Character rep.`09`7D
X`09`09hd`09: dtype;`09`7B Creatures hit die`09`7D
X`09`09damage`09: etype;`09`7B Type attack and damage`7D
X`09`09level`09: bytlint;`09`7B Level of creature`09`7D
X`09`09mr      : byteint;`09`7B Magic Resistance      `7D
X`09end;
X`09monster_type = record
X`09`09hp`09: worlint;`09`7B Hit points`09`09`7D
X`09`09csleep`09: worlint;`09`7B Inactive counter`09`7D
X`09`09cdis`09: worlint;`09`7B Cur dis from player`09`7D
X`09`09mptr`09: wordint;`09`7B Pointer into creature`09`7D
X`09`09nptr`09: wordint;`09`7B Pointer to next block`09`7D
X`09`09cspeed`09: bytlint;`09`7B Movement speed`09`7D
X
X`09`09`09`7B Note: FY and FX constrain dungeon size to 255`09`7D
X`09`09fy`09: byteint;`09`7B Y Pointer into map`09`7D
+-+-+-+-+-+-+-+-  END  OF PART 87 +-+-+-+-+-+-+-+-