-+-+-+-+-+-+-+-+ START OF PART 86 -+-+-+-+-+-+-+-+
X         clear(1,1);
X`09 redraw := true;
X`09 objdes(out_val,item_val,true,'i');
X`09     prt('Item : '+name,2,1);
X`09     prt('Desc : '+out_val,3,1);
X`09 prt_num('Type Value   : ',tval`09   ,4,5);
X             prt('Character    : '+tchar   ,5,5);       `20
X`09 prt_num('P1 Value     : ',p1`09   ,6,5);
X`09 prt_num('Price        : ',cost`09   ,7,5);
X`09 prt_num('Sub Value    : ',subval  ,8,5);
X`09 prt_num('Weight       : ',weight  ,9,5);
X`09 prt_num('Number       : ',number ,10,5);
X`09 prt_num('To hit       : ',tohit  ,11,5);
X`09 prt_num('To Damage    : ',todam  ,12,5);
X`09 prt_num('Base AC      : ',ac`09  ,13,5);
X`09 prt_num('Plus to AC   : ',toac`09  ,14,5);
X`09     prt('Damage       : '+damage ,15,5);
X         prt_num('Power Level  : ',level  ,16,5);
X`09 prt('Flags:',5,30);
X`09 i1 := flags;
X`09 counter := 5;
X`09 while (i1 > 0) do
X`09   begin
X`09     counter := counter+1;
X`09     i2 := bit_pos(i1);
X`09     prt_num('',i2,counter,31);`09`20
X`09   end;`09   `09`20
X`09 pause(24);
X       end;
X   if (redraw) then draw_cave;
X END;
X
X
X`5Bpsect(wizard$code)`5D  procedure beckon_creature;
X  VAR
X       monster,y,x`09: integer;
X       tmp_str`09`09: vtype;`09`20
X
X  BEGIN
X    prt_num('Summon Which Creature (1-',max_creatures,1,1);`20
X    prt(') ? ',1,29);
X    get_string(tmp_str,1,33,4);
X    monster := -1;
X    readv(tmp_str,monster,error:=continue);
X    if (monster > 0) then
X      Begin
X        repeat
X          y := char_row + randint(10) - 5;
X          x := char_col + randint(10) - 5;
X        until ((cave`5By,x`5D.cptr = 0) and (cave`5By,x`5D.fopen));
X `09place_monster(y,x,monster,true);
X`09creatures(false);
X      End;
X  END;
X
$ CALL UNPACK [.INC]WIZARD.INC;1 4196233
$ 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 [.MAR]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 [.MAR]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 [.MAR]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 [.MAR]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 [.MAR]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?
X`09bgtr`09DUMP_QIO`09`09; Output the buffer...
X`09ret`09`09`09`09; return from PUT_BUFFER
X`09`09`09`09`09;
X`09`09`09`09`09; PUT_QIO entry point
XPUT_QIO::
X`09.word`090
X`09`09`09`09`09;
XDUMP_QIO:
X`09$QIOW_S`09EFN=#6, -`09`09; Unique event flag
X`09`09CHAN=channel, -`09`09; Output the buffer
X`09`09FUNC=IO$_WRITEVBLK, -`09; Write virtual block
X`09`09P1=out_buf, -`09`09; Address of buffer
X`09`09P2=out_len`09`09; Buffers current length
X`09`09`09`09`09;
X`09movw`09#0,out_len`09`09; Clear buffer;
X`09ret`09`09`09`09; Return from PUT_QIO
X`09`09`09`09`09;
X`09.end
$ CALL UNPACK [.MAR]PUTQIO.MAR;1 2019791587
$ create 'f'
X`09;
X`09;  Macro function for :
X`09;
X`09;`09y := RANDINT(x) where y receives an integer
X`09;`09`09`091 <= y <= x
X`09;
X`09;  Seed is a global variable declared in PASCAL main.
X`09;
X`09.title`09randint`09`09Uniform random number generator
X`09.ident`09/randint/
X`09.psect  misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2
X`09.entry`09randint,`5EM<>
X`09mull2`09#16807,seed
X`09bicl2`09#`5EX80000000,seed
X`09subl3`09#1,seed,r0
X`09emul`09r0,4(ap),#0,r0
X`09ediv`09#2147483647,r0,r0,r1
X`09addl2`09#1,r0
X`09ret
X`09.end
$ CALL UNPACK [.MAR]RANDINT.MAR;1 1047970647
$ create 'f'
X`09;
X`09;  Macro function for :
X`09;
X`09;`09For i := 1 to y do sum := sum + randint(x)
X`09;  where RANDINT returns random integer 1 <= r <= x
X`09;
X`09;  Seed is a global variable declared in PASCAL main
X`09;
X`09.title`09RAND_REP
X`09.ident`09/rand_rep/
X`09.psect  misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2
X`09.entry`09rand_rep,`5EM<r2,r3,r4>
X`09movl`094(ap),r4
X`09cmpl`09r4,#0
X`09bleq`092$
X`09movl`09#0,r0
X1$:`09mull2`09#16807,seed
X`09bicl2`09#`5EX80000000,seed
X`09subl3`09#1,seed,r2
X`09emul`09r2,8(ap),#0,r2
X`09ediv`09#2147483647,r2,r2,r3
X`09addl`09r2,r0
X`09sobgtr`09r4,1$
X`09addl`094(ap),r0
X`09ret
X2$:`09movl`09#0,r0
X`09ret
X`09.end
X
$ CALL UNPACK [.MAR]RANDREP.MAR;1 225796726
$ v=f$verify(v)
$ EXIT