-+-+-+-+-+-+-+-+ START OF PART 85 -+-+-+-+-+-+-+-+ X`09with store`5Bstore_num`5D do X`09 begin X`09 inven_temp`5E.data := store_inven`5Bitem_val`5D.sitem; X`09 with store_inven`5Bitem_val`5D.sitem do X`09 begin X`09 if ((number > 1) and (subval < 512) and (one_of)) then X`09 begin X`09 number := number - 1; X`09`09 inven_temp`5E.data.number := 1; X`09 end X`09 else X`09 begin X`09`09 for i2 := item_val to store_ctr-1 do X`09`09 store_inven`5Bi2`5D := store_inven`5Bi2+1`5D; X`09`09 store_inven`5Bstore_ctr`5D.sitem := blank_treasure; X`09`09 store_inven`5Bstore_ctr`5D.scost := 0; X`09`09 store_ctr := store_ctr - 1; X`09 end; X end X`09 end; X end; X X X X`09`7B Initializes the stores with owners`09`09`09-RAK-`09`7D X`5Bglobal,psect(setup$code)`5D procedure store_init; X var X`09i1,i2,i3`09`09`09: integer; X begin X`09i1 := max_owners div max_stores; X`09for i2 := 1 to max_stores do X`09 with store`5Bi2`5D do X`09 begin X`09 owner := max_stores*(randint(i1)-1) + i2; X`09 insult_cur := 0; X`09 store_open.year := 0; X`09 store_open.month := 0; X`09 store_open.day := 0; X`09 store_open.hour := 0; X`09 store_open.secs := 0; X`09 store_ctr := 0; X`09 for i3 := 1 to store_inven_max do`20 X`09`09begin X`09`09 store_inven`5Bi3`5D.sitem := blank_treasure; X`09`09 store_inven`5Bi3`5D.scost := 0; X`09`09end; X`09 end; X end; X X X`09`7B Initialize the bank`09`09`09`09`09-DMF-`09`7D X`5Bglobal,psect(setup$code)`5D procedure bank_init; X var X`09starting,type_num`09: integer; X begin X`09starting := (randint(2000) + 1000) * 1000; X`09bank`5Biron`5D := starting div 8; X`09bank`5Bcopper`5D := starting div 30; X`09bank`5Bsilver`5D := starting div 50; X`09bank`5Bgold`5D := starting div 250; X`09bank`5Bplatinum`5D := starting div 5000; X`09bank`5Bmithril`5D := starting div 100000; X`09bank`5Btotal$`5D := (bank`5Bmithril`5D * coin$value`5Bmithril`5D + bank`5 VBplatinum`5D * X`09`09coin$value`5Bplatinum`5D) div gold$value + bank`5Bgold`5D; X end; X X X`09`7B Creates an item and inserts it into store's inven`09-RAK-`09`7D X`5Bglobal,psect(store$code)`5D procedure store_create(store_num : integer); X var X`09i1,tries,cur_pos,dummy`09`09`09: integer; X begin X`09tries := 0; X`09popt(cur_pos); X`09with store`5Bstore_num`5D do X`09 repeat X`09 i1 := store_choice`5Bstore_num,randint(store$choices)`5D; X`09 t_list`5Bcur_pos`5D := inventory_init`5Bi1`5D; X`09 magic_treasure(cur_pos,obj_town_level); X`09 inven_temp`5E.data := t_list`5Bcur_pos`5D; X`09 if (store_check_num(store_num)) then X`09 with t_list`5Bcur_pos`5D do X`09 if (cost > 0) then`09`7B Item must be good`09`7D X`09`09 if (cost < (owners`5Bowner`5D.max_cost * gold$value)) then X`09`09 begin X`09`09 store_carry(store_num,dummy); X`09`09 tries := 10; X`09`09 end; X`09 tries := tries + 1; X`09 until(tries > 3); X`09pusht(cur_pos); X end; X X X`09`7B Initialize and up-keep the store's inventory.`09`09-RAK-`09`7D X`5Bglobal,psect(store$code)`5D procedure store_maint; X var X`09i1,i2,dummy`09`09: integer; X X procedure rndcash(var amt : integer; target : integer); X`09begin X`09 amt := (199*amt+randint(2*target)) div 200; X end; X X begin X`09for i1 := 1 to max_stores do X`09 with store`5Bi1`5D do X`09 begin X`09 insult_cur := 0; X`09 if (store_ctr > store$max_inven) then X`09 for i2 := 1 to (store_ctr-store$max_inven+2) do X`09`09 store_destroy(i1,randint(store_ctr),false) X`09 else if (store_ctr < store$min_inven) then X`09`09begin X`09 for i2 := 1 to (store$min_inven-store_ctr+2) do X`09`09 store_create(i1); X`09`09end X`09 else X`09`09begin X`09`09 for i2 := 1 to (1+randint(store$turn_around)) do X`09`09 store_destroy(i1,randint(store_ctr),true); X`09`09 for i2 := 1 to (1+randint(store$turn_around)) do X`09`09 store_create(i1); X`09`09end; X`09 if (i1 = 7) then X`09`09begin X`09`09 if (randint(8) = 1) then X`09`09 begin X`09`09 for i2 := 1 to store_ctr do X`09`09`09store_destroy(i1,i2,false); X`09`09 for i2 := 1 to store$min_inven+2 do X`09`09`09store_create(i1); X`09`09 end X`09`09end; X`09 end; X`09rndcash(bank`5Biron`5D,500000); X`09rndcash(bank`5Bcopper`5D,200000); X`09rndcash(bank`5Bsilver`5D,100000); X`09rndcash(bank`5Bgold`5D,50000); X`09rndcash(bank`5Bplatinum`5D,5000); X`09rndcash(bank`5Bmithril`5D,1000); X`09bank`5Btotal$`5D := (bank`5Bmithril`5D * mithril$value + bank`5Bplatinum` V5D * X`09`09platinum$value) div gold$value + bank`5Bgold`5D; X end; X XEnd. $ CALL UNPACK STORE.PAS;1 1735374140 $ create 'f' X`09.title`09sub_quadtime X; X;`09call sequence X; X;`09call sub_quadtime(a, b, c) X; X;`09where a, b, and c are quadword system time buffers X; X;`09c = a - b X; Xa = 4 Xb = 8 Xc = 12 Xsub_quadtime::`09.word`09`5Em X`09`09movq`09@a(ap),r0`09; minuend in registers X`09`09movl`09b(ap),r2`09; address of subtrahend in r2 X`09`09subl`09(r2),r0`09`09; subtract low order half X`09`09sbwc`094(r2),r1`09; subtract high@order half with carry X; X;`09we now have the time increment between a and b. The system X;`09form of a delta time is the negative of this. We get this by X;`09subtracting from 0. X; X`09`09movl`09c(ap),r2`09; address of destination in r2 X`09`09clrl`09(r2)`09`09; set to 0 X`09`09clrl`094(r2) X`09`09subl`09r0,(r2)`09`09; subtract low half X`09`09sbwc`09r1,4(r2)`09; subtract high half X`09`09ret X`09`09.end $ CALL UNPACK SUBQUAD.MAR;1 341530493 $ create 'f' X`5Binherit('moria.env')`5D module a; X`7B TERMDEF : uses the values returned by SYS$GETDVI to set up the proper`7 VD X`7B addressing codes. New terminals can be added, or existing ones `7 VD X`7B changed wihtout re-compiling the main source. You can use `7 VD X`7B compile.com by specifying: `7 VD X`7B $ cterm :== @DISK_NAME:`5BFILE_PATH`5Dcompile termdef V `7D X`5Bglobal`5D procedure termdef; X type X`09term_type = packed array `5B1..3`5D of char; X`09dvi_type = record X`09`09item_len : wordint; X`09`09item_code : wordint; X`09`09buff_add : `5Einteger; X`09`09len_add : `5Einteger; X`09`09end_item : integer; X`09end; X var X`09dvi_buff : dvi_type; X`09i1 : integer; X`09tmp_str : varying`5B10`5D of char; X`09tmp : char; X`09escape : char; X X `5Bexternal(SYS$GETDVI)`5D function get_dvi`09( X`09`09 efn : integer := %immed 0; X`09`09 chan : integer := %immed 0; X`09%stdescr terminal : term_type; X`09%ref itmlst : dvi_type; X`09`09 isob : integer := %immed 0; X`09`09 astadr : integer := %immed 0; X`09`09 astprm : integer := %immed 0; X`09`09 undefined : integer := %immed 0 X`09`09`09`09`09`09) : integer; X`09external; X X begin X escape := chr(27); X with dvi_buff do X begin X`09item_len := 4; X`09item_code := 6; X`09new(buff_add); X`09new(len_add); X`09end_item := 0; X end; X get_dvi(terminal:='TT:',itmlst:=dvi_buff); X`09`7B Add new terminals in this case statement. The case number is `7D X`09`7B returned by SYS$GETVI. Terminals are either row then col, or `7D X`09`7B col then row. `7D X`09`7B ROW_FIRST should be true if the row is given first. `7D X`09`7B CURSOR_ERL is the sequence for erase-to-end-of-line. `7D X`09`7B CURSOR_ERP is the sequence for erase-to-end-of-page. `7D X`09`7B CURLEN_R is the length of the ROW portion of cursor address `7D X`09`7B CURLEN_C is the length of the COL portion of cursor address `7D X`09`7B CURLEN_L is CURLEN_R + CURLEN_C `7D X`09`7B CURSOR_R is the ROW cursor portion characters `7D X`09`7B CURSOR_C is the COL cursor portion characters `7D X case dvi_buff.buff_add`5E of X`0917 : `7B ADM-3A (/FT2) `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := chr(24); X`09`09 cursor_erp := chr(23); X`09`09 curlen_r := 3; X`09`09 curlen_c := 1; X`09`09 cursor_l := 4; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Row char`7D X`09`09 cursor_r`5Bi1`5D := escape + '=' + tmp; `7B Row part`7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Col char`7D X`09`09 cursor_c`5Bi1`5D := tmp; `7B Col part`7D X`09`09 end; X`09`09end; X`0918 : `7B ADDS100 (/FT3) `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := escape + 'K'; X`09`09 cursor_erp := escape + 'k'; X`09`09 curlen_r := 3; X`09`09 curlen_c := 1; X`09`09 cursor_l := 4; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Row char`7D X`09`09 cursor_r`5Bi1`5D := escape + 'Y' + tmp; `7B Row part`7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Col char`7D X`09`09 cursor_c`5Bi1`5D := tmp; `7B Col part`7D X`09`09 end; X`09`09end; X`0919 : `7B IBM3101 (/FT4) `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := escape + 'I'; X`09`09 cursor_erp := escape + 'J'; X`09`09 curlen_r := 3; X`09`09 curlen_c := 1; X`09`09 cursor_l := 4; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 tmp := chr(i1+39); `7B Row char`7D X`09`09 cursor_r`5Bi1`5D := escape + 'Y' + tmp; `7B Row part`7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 tmp := chr(i1+39); `7B Col char`7D X`09`09 cursor_c`5Bi1`5D := tmp; `7B Col part`7D X`09`09 end; X`09`09end; X`0916 : `7B Teleray 10 (/FT1) `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := escape + 'K'; X`09`09 cursor_erp := escape + 'J'; X`09`09 curlen_r := 3; X`09`09 curlen_c := 1; X`09`09 cursor_l := 4; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Row char`7D X`09`09 cursor_r`5Bi1`5D := escape + 'Y' + tmp; `7B Row part`7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Col char`7D X`09`09 cursor_c`5Bi1`5D := tmp; `7B Col part`7D X`09`09 end; X`09`09end; X`0964 : `7B VT52 (/VT52) `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := escape + 'K'; X`09`09 cursor_erp := escape + 'J'; X`09`09 curlen_r := 3; X`09`09 curlen_c := 1; X`09`09 cursor_l := 4; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Row char`7D X`09`09 cursor_r`5Bi1`5D := escape + 'Y' + tmp; `7B Row part`7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 tmp := chr(i1+31); `7B Col char`7D X`09`09 cursor_c`5Bi1`5D := tmp; `7B Col part`7D X`09`09 end; X`09`09end; X`0996,98,110: `7B VT100 and ANSI X3.64 standard (/VT100) `7D X`09`09`7B VT102 series terminals `7D X`09`09`7B VT200 series terminals `7D X`09`09`7B Note that the row and column strings must always `7D X`09`09`7B of the same length `7D X`09`09begin X`09`09 row_first := true; `7B Sequence is row,col `7D X`09`09 cursor_erl := escape + '`5BK'; X`09`09 cursor_erp := escape + '`5BJ'; X`09`09 curlen_r := 4; X`09`09 curlen_c := 4; X`09`09 cursor_l := 8; X`09`09 for i1 := 1 to 24 do X`09`09 begin X`09`09 writev(tmp_str,'00',i1:1); `7B Row chars`7D X`09`09 tmp_str := substr(tmp_str,length(tmp_str)-1,2); X`09`09 cursor_r`5Bi1`5D := escape + '`5B' + tmp_str; `7B Row part `7D X`09`09 end; X`09`09 for i1 := 1 to 80 do X`09`09 begin X`09`09 writev(tmp_str,'00',i1:1); `7B Col chars`7D X`09`09 tmp_str := substr(tmp_str,length(tmp_str)-1,2); X`09`09 cursor_c`5Bi1`5D := ';' + tmp_str + 'H'; `7B Col part `7D X`09`09 end; X`09`09end; X`09otherwise X`09`09begin X`09`09 writeln('*** ERROR : Terminal not supported ***'); X`09`09 writeln('See TERMDEF.PAS for defining new terminals.'); X`09`09 writeln('*** Terminals supported:'); X`09`09 writeln(' VT52 Set Terminal/VT52'); X`09`09 writeln(' VT100 Set Terminal/VT100'); X`09`09 writeln(' Teleray 10 Set Terminal/FT1'); X`09`09 writeln(' ADM-3A Set Terminal/FT2'); X`09`09 writeln(' ADDS100 Set Terminal/FT3'); X`09`09 writeln(' IBM3101 Set Terminal/FT4'); X`09`09 writeln; X`09`09 exit; X`09`09end; X end; X end; Xend. $ CALL UNPACK TERMDEF.PAS;1 41158127 $ create 'f' X`5Bglobal,PSECT(trade$code)`5D PROCEDURE enter_trading_post; X XCONST X X`09display_size`09`09= 12; X`09acceptable_item_price`09= 50; X`09profit_from_bid`09`09= 0.05; X`09profit_from_sale`09= 0.25; X`09refund_on_bid`09`09= 1.00 - profit_from_bid; X`09refund_on_sale`09`09= 1.00 - profit_from_sale; X`09bid_increment_factor`09= 1.05; X`09take_the_money_and_run`09= 0.90; X`09bid_wait_days`09`09= 0; X`09bid_wait_hours`09`09= 6; X`09expire_time_days`09= 4; X`09expire_time_hours`09= 0; X X X`09%INCLUDE`09'sys$library:passtatus.pas' X XTYPE X X`09trade_types = ( profit_type, for_sale, cash ); X X`09trade_record_type = RECORD X`09`09time`09`09: QUAD_TYPE; X`09`09CASE trade_type : trade_types OF X`09`09`09profit_type`09:`09( X`09`09`09`09money`09`09: INTEGER X`09`09`09`09`09`09); X`09`09`09for_sale`09: `09( X`09`09`09`09object`09`09: treasure_type; X`09`09`09`09seller`09`09: ssn_type;`09`7B py.misc.ssn `7D +-+-+-+-+-+-+-+- END OF PART 85 +-+-+-+-+-+-+-+-