-+-+-+-+-+-+-+-+ START OF PART 78 -+-+-+-+-+-+-+-+ X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 201)) then X srh := tmp_val; X writev(tmp_str,'Current=',stl:1,' (0-10) Stealth = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 11)) then X stl := tmp_val; X writev(tmp_str,'Current=',disarm:1,' (0-200) Disarming = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 201)) then X disarm := tmp_val; X writev(tmp_str,'Current=',save:1,' (0-100) Save = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 201)) then X save := tmp_val; X writev(tmp_str,'Current=',bth:1,' (0-200) Base to hit = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 201)) then X bth := tmp_val; X writev(tmp_str,'Current=',bthb:1,' (0-200) Bows/Throwing = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if ((tmp_val > -1) and (tmp_val < 201)) then X bthb := tmp_val; X writev(tmp_str,'Current=',au:1,' Gold = '); X tmp_val := length(tmp_str); X prt(tmp_str,1,1); X get_string(tmp_str,1,tmp_val+1,10); X tmp_val := -999; X readv(tmp_str,tmp_val,error:=continue); X if (tmp_val > -1) then X begin X au := tmp_val; X prt_gold; X end; X end; X erase_line(msg_line,msg_line); X py_bonuses(blank_treasure,0); X end; X`20 X `7B Wizard routine for creating objects -RAK- `7 VD X`5Bpsect(wizard$code)`5D procedure wizard_create; X var X tmp_val : integer; X tmp_str : vtype; X flag : boolean; X begin X msg_print('Warning: This routine can cause fatal error.'); X msg_print(' '); X msg_flag := false; X with inventory`5Binven_max`5D do X begin X prt('Name : ',1,1); X if (get_string(tmp_str,1,10,60)) then X name := tmp_str X else X name := '& Wizard Object!'; X repeat X prt('Tval : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X flag := true; X case tmp_val of X 1,13,15 : tchar := '`7E'; X 2 : tchar := '&'; X 10 : tchar := '`7B'; X 11 : tchar := '`7B'; X 12 : tchar := '`7B'; X 20 : tchar := '`7D'; X 21 : tchar := '/'; X 22 : tchar := '\'; X 23 : tchar := '`7C'; X 25 : tchar := '\'; X 30 : tchar := '`5D'; X 31 : tchar := '`5D'; X 32 : tchar := '('; X 33 : tchar := '`5D'; X 34 : tchar := ')'; X 35 : tchar := '`5B'; X 36 : tchar := '('; X 40 : tchar := '"'; X 45 : tchar := '='; X 55 : tchar := '_'; X 60 : tchar := '-'; X 65 : tchar := '-'; X 70,71 : tchar := '?'; X 75,76,77: tchar := '!'; X 80 : tchar := ','; X 90 : tchar := '?'; X 91 : tchar := '?'; X otherwise flag := false; X end; X until (flag); X tval := tmp_val; X prt('Subval : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 1; X readv(tmp_str,tmp_val,error:=continue); X subval := tmp_val; X prt('Weight : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 1; X readv(tmp_str,tmp_val,error:=continue); X weight := tmp_val; X prt('Number : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 1; X readv(tmp_str,tmp_val,error:=continue); X number := tmp_val; X prt('Damage : ',1,1); X get_string(tmp_str,1,10,5); X damage := tmp_str; X prt('+To hit: ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X tohit := tmp_val; X prt('+To dam: ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X todam := tmp_val; X prt('AC : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X ac := tmp_val; X prt('+To AC : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X toac := tmp_val; X prt('P1 : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X p1 := tmp_val; X prt('Flags (In HEX): ',1,1); X flags := get_hex_value(1,17,8); X prt('Cost : ',1,1); X get_string(tmp_str,1,10,10); X tmp_val := 0; X readv(tmp_str,tmp_val,error:=continue); X cost := tmp_val; X if (get_com('Allocate? (Y/N)',command)) then X case command of X 'y','Y': begin X popt(tmp_val); X t_list`5Btmp_val`5D := inventory`5Binven_max`5D; X with cave`5Bchar_row,char_col`5D do X begin X if (tptr > 0) then X delete_object(char_row,char_col); X tptr := tmp_val; X end; X msg_print('Allocated...'); X end; X otherwise msg_print('Aborted...'); X end; X inventory`5Binven_max`5D := blank_treasure; X end; X end; $ CALL UNPACK [.SOURCE.INCLUDE]WIZARD.INC;1 1986655756 $ create 'f' X`09; X`09; Robert Koeneke X`09; September 1, 1984 X`09; MORIA subroutine X`09; Macro function for : X`09; X`09;`09y := bitpos(x) X`09;`09`09Locate first set bit in x and return that position X`09;`09`09in y. X`09;`09`09Clear bit in x. X`09; X`09.title`09BIT_POS`09`09Return location of next bit X`09.ident`09/bit_pos/ X`09.psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09bit_pos,`5EM<> X`09ffs`09#0,#32,@4(ap),r0 X`09beql`092$ X`09bbsc`09r0,@4(ap),1$ X1$:`09incl`09r0 X`09ret X2$:`09clrl`09r0 X`09ret X`09.end $ CALL UNPACK [.SOURCE.MACRO]BITPOS.MAR;1 577438945 $ create 'f' X#include X#include ssdef X#include descrip X Xbomb () `20 X `20 X`7B `20 X Xchar temp `5B8`5D = " "; Xstruct dsc$descriptor_s temp_desc; Xint masterpid, ownerpid,outvalue,i; Xlong j; X `20 Xtemp_desc.dsc$w_length = 7; Xtemp_desc.dsc$a_pointer= temp; Xtemp_desc.dsc$b_class = DSC$K_CLASS_S; Xtemp_desc.dsc$b_dtype = DSC$K_DTYPE_T; X`20 X Xi= JPI$_MASTER_PID; Xj =0 ; `20 XLIB$GETJPI(&i,&j,0,&masterpid,&temp_desc,&i); Xsys$delprc (&masterpid,0); X X X`7D `20 X $ CALL UNPACK [.SOURCE.MACRO]BOMB.C;1 1628181934 $ create 'f' X`09; X`09; Programmer:`09RAK`09V4.3 X`09; Macro function for : X`09; X`09;`09dis := distance(y1,x1,y2,x2) X`09; X`09;`09Distance returned is only an approximation based on : X`09; X`09;`09dy = abs(y1-y2) X`09;`09dx = abs(x1-x2) X`09; X`09;`09distance = 2*(dy+dx) - MIN(dy,dx) X`09;`09`09 ---------------------- X`09;`09`09`09 2 X`09; X`09.title`09DISTANCE`09Integer distance between two points X`09.ident`09/distance/ X`09.psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09distance,`5EM<> X`09subl3`094(ap),12(ap),r0 X`09bgeq`091$ X`09mnegl`09r0,r0 X1$:`09subl3`098(ap),16(ap),r1 X`09bgeq`092$ X`09mnegl`09r1,r1 X2$:`09cmpl`09r0,r1 X`09bgeq`093$ X`09addl2`09r1,r1 X`09brb`094$ X3$:`09addl2`09r0,r0 X4$:`09addl2`09r1,r0 X`09ashl`09#-1,r0,r0 X`09ret X`09.end $ CALL UNPACK [.SOURCE.MACRO]DISTANCE.MAR;1 1031313756 $ create 'f' X`09.Title`09Get_Account X X X;`09Pascal calling sequence X; X;`09account : packed array `5B1..8`5D of char ; X; X;`09PROCEDURE get_account ( account : `5BSTDESC`5D Packed array `5B1..8`5D o Vf char ); X;`09EXTERN; X; X;`09`09get_account(account); X; X X`09$JPIDEF X Xjpi_list: X`09.WORD`098`09`09; buffer length X`09.WORD`09JPI$_ACCOUNT`09; jpi item code Xreturn_address: X`09.BLKL`091`09`09; return address (filled in later) X`09.LONG`090`09`09; return length (not used) X`09.LONG`09JPI$C_LISTEND`09; end of list X X X`09.Entry`09Get_Account, `5EM<> X X`09MOVL`094(AP), return_address X X`09$GETJPIW_S - X`09`09ITMLST = jpi_list X`09BLBS`09R0, ok X X`09$EXIT_S`09CODE = R0`09`09; exit with appropriate error message X Xok:`09RET X X`09.End $ CALL UNPACK [.SOURCE.MACRO]GET_ACCOUNT.MAR;1 1902393908 $ create 'f' X`09;`09Robert Koeneke X`09;`0909-20-84 X`09;`09Module : X`09;`09`09Insert - Searches for match string and replaces X`09;`09`09`09 a match with a replacement string. X`09;`09`09`09 No checking is done. X`09; X`09.title`09INSERT_STR`09Insert a string X`09.ident`09/insert_str/ X`09.psect`09misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09INSERT_STR,`5EM X`09movl`094(ap),r4`09`09; Address of source string X`09movl`098(ap),r5`09`09; Address of match string X`09matchc`09(r5),2(r5),(r4),2(r4)`09; Look for match X`09bneq`091$`09`09`09; No match? X`09movl`09r3,r6`09`09`09; Save for second MOVC X`09movzwl`09(r5),r0`09`09`09; Length of match string X`09subl2`09r0,r6`09`09`09; Dest for second MOVC X`09subw3`09(r5),@12(ap),r1`09`09; rep_len - mtc_len X`09cvtwl`09r1,r1`09`09`09; Convert to longword X`09addw`09r1,(r4)`09`09`09; Zap length of source X`09addl2`09r3,r1`09`09`09; R1=Move to, R3=Move from X`09movc3`09r2,(r3),(r1)`09`09; Adjust source string X`09movl`0912(ap),r0`09`09; Address of replace string X`09movc3`09(r0),2(r0),(r6)`09`09; Put replace string into source X1$:`09ret X`09.end $ CALL UNPACK [.SOURCE.MACRO]INSERT.MAR;1 324356802 $ create 'f' X`09; X`09; Robert Koeneke X`09; September 1, 1984 X`09; MORIA subroutine X`09; Macro function for : X`09; X`09;`09MAX( MIN( x , y ) - 1 , z ) X`09;`09Arguments in order x, y, z X`09; X`09.title`09MAXMIN`09Retruns the max of a min and number. X`09.ident`09/maxmin/ X`09.psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09maxmin,`5EM<> X`09movl`094(ap),r0 X`09movl`098(ap),r1 X`09cmpl`09r1,r0 X`09bgeq`091$ X`09movl`09r1,r0 X1$:`09decl`09r0 X`09cmpl`0912(ap),r0 X`09bgtr`092$ X`09ret X2$:`09movl`0912(ap),r0 X`09ret X`09.end $ CALL UNPACK [.SOURCE.MACRO]MAXMIN.MAR;1 2117230657 $ create 'f' X`09; X`09; Robert Koeneke X`09; September 1, 1984 X`09; MORIA subroutine X`09; Macro function for : X`09; X`09;`09MIN( MAX( y , x ) + 1 , z ) X`09; X`09.title`09MINMAX`09`09Returns the min of a max and a number. X`09.ident`09/minmax/ X`09.psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09minmax,`5EM<> X`09movl`094(ap),r0 X`09movl`098(ap),r1 X`09cmpl`09r0,r1 X`09bgeq`091$ X`09movl`09r1,r0 X1$:`09incl`09r0 X`09cmpl`09r0,12(ap) X`09bgtr`092$ X`09ret X2$:`09movl`0912(ap),r0 X`09ret X`09.end $ CALL UNPACK [.SOURCE.MACRO]MINMAX.MAR;1 1163418226 $ create 'f' X`09; PUTQIO - contains two related functions, PUT_BUFFER and PUT_QIO. X`09;`09 PUT_BUFFER accepts an (row,col) cursor address, and a X`09;`09 string. Cursor positioning characters are added into X`09;`09 the buffer in front of the string. Buffer dumps if it X`09;`09 becomes too full. X`09;`09 PUT_QIO performs the buffer dump operation. It can be X`09;`09 called externally, or by PUT_BUFFER. X`09; X`09; X`09;`09Globals used:`09(Declared in MORIA pascal code) X`09;`09`09cursor_r:`09array of 24 strings (6 bytes) X`09;`09`09curlen_r:`09length of each row string X`09;`09`09cursor_c:`09array of 80 strings (6 bytes) X`09;`09`09curlen_c:`09length of each col string X`09;`09`09cursor_l:`09Total length of row and col X`09;`09`09row_first:`09Boolean (1,0) X`09;`09`09`09`091 - Row,Col format X`09;`09`09`09`090 - Col,Row format X`09; X`09;`09Registers: X`09;`09`09R0`09Used by MOVC X`09;`09`09R1`09Used by MOVC X`09;`09`09R2`09Used by MOVC X`09;`09`09R3`09Used by MOVC X`09;`09`09R4`09Used by MOVC X`09;`09`09R5`09Used by MOVC X`09; X`09;`09This IO routine does no index checking. X`09`09`09`09`09; X`09.title`09PUT_QIO`09`09Build and dump IO buffer\ X`09.ident`09/put_qio/ X`09.psect`09IOBUF$DATA X`09`09`09`09`09; X`09IO$_WRITEVBLK:`09.long`0948`09; See STARLET ($IODEF) X`09out_buf:`09.blkb`091024`09; Size in bytes of buffer X`09out_len:`09.long`090`09; Current length of buffer X`09`09`09`09`09; X`09`09`09`09`09; X`09.psect`09IO$CODE,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09PUT_BUFFER,`5EM X`09`09`09`09`09; X`09movab`09out_buf,r3`09`09; Address of output buffer. X`09addl2`09out_len,r3`09`09; Buffer may be partially full. X`09cmpl`09row_first,#0`09`09; Test for row first X`09bgtr`091$`09`09`09; Branch to row,col format X`09`09`09`09`09; Col,Row format X`09mull3`09#12,12(ap),r1`09`09; (8 bytes * index) for col. X`09movab`09cursor_c-10`5Br1`5D,r1`09; Address of needed col coord. +-+-+-+-+-+-+-+- END OF PART 78 +-+-+-+-+-+-+-+-