-+-+-+-+-+-+-+-+ START OF PART 71 -+-+-+-+-+-+-+-+
X`09  get_string(tmp_str,1,26,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > 2) and (tmp_val < 119)) then
X`09    begin
X`09      con  := tmp_val;
X`09      ccon := tmp_val;
X`09      prt_constitution;
X`09    end;
X`09  prt('(3 - 118) Charisma     = ',1,1);
X`09  get_string(tmp_str,1,26,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > 2) and (tmp_val < 119)) then
X`09    begin
X`09      chr  := tmp_val;
X`09      cchr := tmp_val;
X`09      prt_charisma;
X`09    end;
X`09end;
X      with py.misc do
X`09begin
X`09  prt('(1 - 32767) Hit points = ',1,1);
X`09  get_string(tmp_str,1,26,10);
X`09  tmp_val := -1;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > 0) and (tmp_val < 32768)) then
X`09    begin
X`09      mhp  := tmp_val;
X`09      chp  := tmp_val;
X`09      prt_mhp;
X`09      prt_chp;
X`09    end;
X`09  prt('(0 - 32767) Mana       = ',1,1);
X`09  get_string(tmp_str,1,26,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 32768)) then
X`09    begin
X`09      mana  := tmp_val;
X`09      cmana := tmp_val;
X`09      prt_cmana;
X`09    end;
X`09  writev(tmp_str,'Current=',srh:1,'  (0-200) Searching = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 201)) then
X`09    srh  := tmp_val;
X`09  writev(tmp_str,'Current=',stl:1,'  (0-10) Stealth = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 11)) then
X`09    stl  := tmp_val;
X`09  writev(tmp_str,'Current=',disarm:1,'  (0-200) Disarming = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 201)) then
X`09    disarm := tmp_val;
X`09  writev(tmp_str,'Current=',save:1,'  (0-100) Save = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 201)) then
X`09    save := tmp_val;
X`09  writev(tmp_str,'Current=',bth:1,'  (0-200) Base to hit = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 201)) then
X`09    bth  := tmp_val;
X`09  writev(tmp_str,'Current=',bthb:1,'  (0-200) Bows/Throwing = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if ((tmp_val > -1) and (tmp_val < 201)) then
X`09    bthb := tmp_val;
X`09  writev(tmp_str,'Current=',au:1,'  Gold = ');
X`09  tmp_val := length(tmp_str);
X`09  prt(tmp_str,1,1);
X`09  get_string(tmp_str,1,tmp_val+1,10);
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if (tmp_val > -1) then
X`09    begin
X`09      au := tmp_val;
X`09      prt_gold;
X`09    end;
X`09end;
X      erase_line(msg_line,msg_line);
X      py_bonuses(blank_treasure,0);
X    end;
X
X`09`7B Wizard routine for creating objects`09`09`09-RAK-`09`7D
X`5Bpsect(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 inventory`5Binven_max`5D 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,13,15 :`09tchar := '`7E';
X`09      2  :`09tchar := '&';
X`09      10 :`09tchar := '`7B';
X`09      11 :`09tchar := '`7B';
X`09      12 :`09tchar := '`7B';
X`09      20 :`09tchar := '`7D';
X`09      21 :`09tchar := '/';
X`09      22 :`09tchar := '\';
X`09      23 :`09tchar := '`7C';
X`09      25 :`09tchar := '\';
X`09      30 :`09tchar := '`5D';
X`09      31 :`09tchar := '`5D';
X`09      32 :`09tchar := '(';
X`09      33 :`09tchar := '`5D';
X`09      34 :`09tchar := ')';
X`09      35 :`09tchar := '`5B';
X`09      36 :`09tchar := '(';
X`09      40 :`09tchar := '"';
X`09      45 :`09tchar := '=';
X`09      55 :`09tchar := '_';
X`09      60 :`09tchar := '-';
X`09      65 :`09tchar := '-';
X`09      70,71 :`09tchar := '?';
X`09      75,76,77:`09tchar := '!';
X`09      80 :`09tchar := ',';
X`09      90 :`09tchar := '?';
X`09      91 :`09tchar := '?';
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,17,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 := inventory`5Binven_max`5D;
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  inventory`5Binven_max`5D := blank_treasure;
X`09end;
X    end;
$ CALL UNPACK [.SOURCE.INCLUDE]WIZARD.INC;1 1362882515
$ 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`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;`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<R2,R3,R4,R5,R6>
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<R2,R3,R4,R5>
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.
X`09movc3`09curlen_c,(r1),(r3)`09; Move col cursor characters.
X`09mull3`09#12,8(ap),r1`09`09; (8 bytes * index) for row.
X`09movab`09cursor_r-10`5Br1`5D,r1`09; Address of needed row coord.
X`09movc3`09curlen_r,(r1),(r3)`09; Move row cursor characters.
X`09brb`092$`09`09`09; Branch to copy string
X1$:`09`09`09`09`09; Row,Col format
X`09mull3`09#12,8(ap),r1`09`09; (8 bytes * index) for row.
X`09movab`09cursor_r-10`5Br1`5D,r1`09; Address of needed row coord.
X`09movc3`09curlen_r,(r1),(r3)`09; Move row cursor characters.
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.
X`09movc3`09curlen_c,(r1),(r3)`09; Move col cursor characters.
X2$:`09`09`09`09`09; Copy String
X`09tstw`09@4(ap)`09`09`09; No string?
X`09beql`093$`09`09`09; No move needed.
X`09movl`094(ap),r1`09`09; Move address of string arg.
X`09movc3`09@4(ap),2(r1),(r3)`09; Move string arg into output buff.
X3$:
X`09addw3`09cursor_l,@4(ap),r1`09; Total length of new output
X`09addw2`09r1,out_len`09`09; Total length of saved output
X`09cmpw`09out_len,#900`09`09; Buffer getting full?
+-+-+-+-+-+-+-+-  END  OF PART 71 +-+-+-+-+-+-+-+-