-+-+-+-+-+-+-+-+ START OF PART 20 -+-+-+-+-+-+-+-+ X`09`09`09 cdesc := cdesc + 'magically summons a monster!'; X`09`09`09 msg_print(cdesc); X`09`09`09 y := char_row; X`09`09`09 x := char_col; X`09`09`09 summon_monster(y,x,false); X`09`09`09 check_mon_lite(y,x); X`09`09`09end; X`7BSummon Undead`7D 15 : begin X`09`09`09 cdesc := cdesc + 'magically summons an undead!'; X`09`09`09 msg_print(cdesc); X`09`09`09 y := char_row; X`09`09`09 x := char_col; X`09`09`09 summon_undead(y,x); X`09`09`09 check_mon_lite(y,x); X`09`09`09end; X`7BSlow Person `7D 16 : begin X`09`09`09 cdesc := cdesc + 'casts a spell.'; X`09`09`09 msg_print(cdesc); X`09`09`09 if (py.flags.free_act) then X`09`09`09 msg_print('You are unaffected...') X`09`09`09 else if (player_saves(wis_adj+py.misc.lev)) then X`09`09`09 msg_print('You resist the affects of the spell.') X`09`09`09 else if (py.flags.slow > 0) then X`09`09`09 py.flags.slow := py.flags.slow + 2 X`09`09`09 else X`09`09`09 py.flags.slow := randint(5) + 3; X`09`09`09end; X`7BDrain Mana `7D 17 : if (trunc(py.misc.cmana) > 0) then X`09`09`09 begin X`09`09`09 outval := cdesc+'draws psychic energy from you!'; X`09`09`09 msg_print(outval); X`09`09`09 outval := cdesc+'appears healthier...'; X`09`09`09 msg_print(outval); X`09`09`09 r1 := ( randint(level) div 2 ) + 1; X`09`09`09 if (r1 > py.misc.cmana) then r1 := py.misc.cmana; X`09`09`09 py.misc.cmana := py.misc.cmana - r1; X`09`09`09 hp := hp + 6*trunc(r1); X`09`09`09 end; X`7BBreath Light `7D 20 : begin X`09`09`09 cdesc := cdesc + 'breathes lightning.'; X`09`09`09 msg_print(cdesc); X`09`09`09 breath(1,char_row,char_col,trunc(hp/4.0),ddesc); X`09`09`09end; X`7BBreath Gas `7D 21 : begin X`09`09`09 cdesc := cdesc + 'breathes gas.'; X`09`09`09 msg_print(cdesc); X`09`09`09 breath(2,char_row,char_col,trunc(hp/3.0),ddesc); X`09`09`09end; X`7BBreath Acid `7D 22 : begin X`09`09`09 cdesc := cdesc + 'breathes acid.'; X`09`09`09 msg_print(cdesc); X`09`09`09 breath(3,char_row,char_col,trunc(hp/3.0),ddesc); X`09`09`09end; X`7BBreath Frost `7D 23 : begin X`09`09`09 cdesc := cdesc + 'breathes frost.'; X`09`09`09 msg_print(cdesc); X`09`09`09 breath(4,char_row,char_col,trunc(hp/3.0),ddesc); X`09`09`09end; X`7BBreath Fire `7D 24 : begin X`09`09`09 cdesc := cdesc + 'breathes fire.'; X`09`09`09 msg_print(cdesc); X`09`09`09 breath(5,char_row,char_col,trunc(hp/3.0),ddesc); X`09`09`09end; X`09`09otherwise begin X`09`09`09 msg_print('Creature cast unknown spell.'); X`09`09`09 cdesc := ''; X`09`09`09 end; X`09`09 end; X`09`09`7B End of spells `7D X`09`09 end; X`09`09end; X`09 end; X X X`09`7B Main procedure for monster movement (MON_MOVE)`09-RAK-`09`7D X`09begin X`09 mon_move := false; X`09 with c_list`5Bm_list`5Bmonptr`5D.mptr`5D do X`09 begin X`09`09`7B Does the critter multiply? `7D X`09 if (uand(cmove,%X'00200000') <> 0) then X`09`09if (max_mon_mult >= mon_tot_mult) then X`09`09 if ((py.flags.rest mod mon_mult_adj) = 0) then X`09`09 with m_list`5Bmonptr`5D do X`09`09 begin X`09`09`09i3 := 0; X`09`09`09for i1 := fy-1 to fy+1 do X`09`09`09 for i2 := fx-1 to fx+1 do X`09`09`09 if (in_bounds(i1,i2)) then X`09`09`09 if (cave`5Bi1,i2`5D.cptr > 1) then X`09`09`09`09i3 := i3 + 1; X`09`09`09if (i3 < 4) then X`09`09`09 if (randint(i3*mon_mult_adj) = 1) then X`09`09`09 multiply_monster(fy,fx,mptr,false); X`09`09 end; X`09`09`7B Creature is confused? Chance it becomes un-confused `7D X`09 move_test := false; X`09 if (m_list`5Bmonptr`5D.confused) then X`09`09begin X`09`09 mm`5B1`5D := randint(9); X`09`09 mm`5B2`5D := randint(9); X`09`09 mm`5B3`5D := randint(9); X`09`09 mm`5B4`5D := randint(9); X`09`09 mm`5B5`5D := randint(9); X`09`09 mon_move := make_move(monptr,mm); X`09`09 if (randint(8) = 1) then X`09`09 m_list`5Bmonptr`5D.confused := false; X`09`09 move_test := true; X`09`09end X`09`09`7B Creature may cast a spell `7D X`09 else if (spells > 0) then X`09`09mon_move := cast_spell(monptr,move_test); X`09 if (not(move_test)) then X`09`09begin X`09`09`7B 75% random movement `7D X`09`09 if ((randint(100) < 75) and X`09`09 (uand(cmove,%X'00000020') <> 0)) then X`09`09 begin X`09`09 mm`5B1`5D := randint(9); X`09`09 mm`5B2`5D := randint(9); X`09`09 mm`5B3`5D := randint(9); X`09`09 mm`5B4`5D := randint(9); X`09`09 mm`5B5`5D := randint(9); X`09`09 mon_move := make_move(monptr,mm); X`09`09 end X`09`09`7B 40% random movement `7D X`09`09 else if ((randint(100) < 40) and X`09`09 (uand(cmove,%X'00000010') <> 0)) then X`09`09 begin X`09`09 mm`5B1`5D := randint(9); X`09`09 mm`5B2`5D := randint(9); X`09`09 mm`5B3`5D := randint(9); X`09`09 mm`5B4`5D := randint(9); X`09`09 mm`5B5`5D := randint(9); X`09`09 mon_move := make_move(monptr,mm); X`09`09 end X`09`09`7B 20% random movement `7D X`09`09 else if ((randint(100) < 20) and X`09`09 (uand(cmove,%X'00000008') <> 0)) then X`09`09 begin X`09`09 mm`5B1`5D := randint(9); X`09`09 mm`5B2`5D := randint(9); X`09`09 mm`5B3`5D := randint(9); X`09`09 mm`5B4`5D := randint(9); X`09`09 mm`5B5`5D := randint(9); X`09`09 mon_move := make_move(monptr,mm); X`09`09 end X`09`09`7B Normal movement `7D X`09`09 else if (uand(cmove,%X'00000002') <> 0) then X`09`09 begin X`09`09 if (randint(200) = 1) then X`09`09`09begin X`09`09`09 mm`5B1`5D := randint(9); X`09`09`09 mm`5B2`5D := randint(9); X`09`09`09 mm`5B3`5D := randint(9); X`09`09`09 mm`5B4`5D := randint(9); X`09`09`09 mm`5B5`5D := randint(9); X`09`09`09end X`09`09 else X`09`09`09get_moves(monptr,mm); X`09`09 mon_move := make_move(monptr,mm); X`09`09 end X`09`09`7B Attack, but don't move `7D X`09`09 else if (uand(cmove,%X'00000001') <> 0) then X`09`09 if (m_list`5Bmonptr`5D.cdis < 2) then X`09`09 begin X`09`09`09get_moves(monptr,mm); X`09`09`09mon_move := make_move(monptr,mm); X`09`09 end X`09`09end; X`09 end; X`09end; X X X`09`7B Main procedure for creatures`09`09`09`09-RAK-`09`7D X begin X`09if (muptr > 0) then X`09 begin X`09`7B Process the monsters `7D X`09i1 := muptr; X`09repeat X`09 with m_list`5Bi1`5D do X`09 begin X`09 cdis := distance(char_row,char_col,fy,fx); X`09 if (attack) then `7B Attack is argument passed to CREATURE`7D X`09`09begin X`09`09 i3 := movement_rate(cspeed); X`09`09 if (i3 > 0) then X`09`09 for i2 := 1 to movement_rate(cspeed) do X`09`09 begin X`09`09`09if ((cdis <= c_list`5Bmptr`5D.aaf) or (ml)) then X`09`09`09 begin X`09`09`09 if (csleep > 0) then X`09`09`09 if (py.flags.aggravate) then X`09`09`09`09csleep := 0 X`09`09`09 else if (py.flags.rest < 1) then X`09`09`09`09if (randint(10) > py.misc.stl) then X`09`09`09`09 csleep := csleep - trunc(75.0/cdis); X`09`09`09 if (stuned > 0) then X`09`09`09`09stuned := stuned - 1; X`09`09`09 if ((csleep <= 0) and (stuned <= 0)) then X`09`09`09 begin X`09`09`09`09moldy := fy; X`09`09`09`09moldx := fx; X`09`09`09`09if (mon_move(i1)) then X`09`09`09`09 if (ml) then X`09`09`09`09 begin X`09`09`09`09 ml := false; X`09`09`09`09 if (test_light(moldy,moldx)) then X`09`09`09`09`09lite_spot(moldy,moldx) X`09`09`09`09 else X`09`09`09`09`09unlite_spot(moldy,moldx); X`09`09`09`09 end; X`09`09`09 end; X`09`09`09 end; X`09`09`09update_mon(i1); X`09`09 end X`09`09 else X`09`09 update_mon(i1); X`09`09end X`09 else X`09`09update_mon(i1); X`09 end; X`09 i1 := m_list`5Bi1`5D.nptr; X`09until ((i1 = 0) or (moria_flag)); X`09`7B End processing monsters `7D X`09 end; X end; $ CALL UNPACK [.SOURCE.INCLUDE]CREATURE.INC;1 555415546 $ create 'f' X`09`7B Handles the gravestone and top-twenty routines`09-RAK-`09`7D X`5Bpsect(death$code)`5D procedure upon_death; X type X`09word`09= 0..65535; X`09recj`09= record X`09`09`09unameinfo`09: packed record X`09`09`09`09unamelen`09: word; X`09`09`09`09jpi$_username`09: word; X`09`09`09end; X`09`09`09ptr_uname`09: `5Eusernam; X`09`09`09ptr_unamelen`09: `5Einteger; X`09`09`09endlist`09`09: integer X`09end; X`09usernam`09`09= packed array `5B1..12`5D of char; X X X`09`7B function returns the players USERNAME`09`09`09-JWT-`09`7D X function get_username : usernam; X var X`09user`09`09: usernam; X`09icode`09`09: integer; X`09jpirec`09`09: recj; X X`09`7B calls GETJPI routine to return the USERNAME`09`09-JWT-`09`7D X function sys$getjpi`09(%immed`09p1`09: integer; X`09`09`09 `09%immed`09p2`09: integer; X`09`09`09 `09%immed`09p3`09: integer; X`09`09`09 `09var`09itmlst`09: recj; X`09`09`09 `09%immed`09p4`09: integer; X`09`09`09 `09%immed`09p5`09: integer; X`09`09`09 `09%immed`09p6`09: integer) : integer; X external; X X begin X`09with jpirec do X`09 begin X`09 unameinfo.unamelen`09`09:= 12; X`09 unameinfo.jpi$_username`09:= %x202; X`09 new (ptr_uname); X`09 ptr_uname`5E`09`09`09:= ' '; X`09 new (ptr_unamelen); X`09 ptr_unamelen`5E`09`09:= 0; X`09 endlist`09`09`09:= 0 X`09 end; X`09icode := SYS$GETJPI (0,0,0,jpirec,0,0,0); X`09if not odd(icode) then X`09 begin X`09 writeln('Error in GETJPI process'); X`09 halt X`09 end X`09else X`09 get_username := jpirec.ptr_uname`5E X`09end; X X X X`09`7B Centers a string within a 31 character string`09`09-JWT-`09`7D X function fill_str (p1 : vtype) : vtype; X var X`09s1`09: vtype; X`09i1`09: integer; X begin X s1 := ''; X i1 := trunc(length(p1) / 2); X fill_str := substr(pad(s1,' ',15-i1) + pad(p1,' ',31),1,31); X end; X X X`09`7B Prints a line to the screen efficiently`09`09-RAK-`09`7D X procedure dprint(str : vtype; row : integer); X var X`09i1,i2,nblanks,xpos`09`09`09: integer; X`09prt_str`09`09`09`09`09: vtype; X begin X`09prt_str := ''; X`09nblanks := 0; X xpos := 0; X`09for i1 := 1 to length(str) do X`09 begin X`09 if (str`5Bi1`5D = ' ') then X`09 begin X`09`09if (xpos > 0) then X`09`09 begin X`09`09 nblanks := nblanks + 1; X`09`09 if (nblanks > 5) then X`09`09 begin X`09`09`09nblanks := 0; X`09`09`09put_buffer(prt_str,row,xpos); X`09`09`09prt_str := ''; X`09`09`09xpos := 0; X`09`09 end X`09`09 end; X`09 end X`09 else X`09 begin X`09`09if (xpos = 0) then xpos := i1; X`09`09if (nblanks > 0) then X`09`09 begin X`09`09 for i2 := 1 to nblanks do X`09`09 prt_str := prt_str + ' '; X`09`09 nblanks := 0; X`09`09 end; X`09`09prt_str := prt_str + str`5Bi1`5D; X`09 end; X`09 end; X`09if (xpos > 0) then X`09 put_buffer(prt_str,row,xpos); X end; X X X`09`7B Prints the gravestone of the character`09`09-RAK-`09`7D X procedure print_tomb; X var X`09str1,str2,str3,str4,str5,str6,str7,str8`09: vtype; X`09dstr`09`09`09`09`09: array `5B0..19`5D of vtype; X`09fnam`09`09`09`09`09: vtype; X`09command`09`09`09`09`09: char; X`09f1`09`09`09`09`09: text; X`09i1`09`09`09`09`09: integer; X`09day`09`09`09`09`09: packed array `5B1..11`5D of char; X`09flag`09`09`09`09`09: boolean; X begin X date(day); X`09str1 := fill_str(py.misc.name); X`09str2 := fill_str(py.misc.title); X`09str3 := fill_str(py.misc.tclass); X writev(str4,'Level : ',py.misc.lev:1); X`09str4 := fill_str(str4); X writev(str5,py.misc.exp:1,' Exp'); X`09str5 := fill_str(str5); X`09writev(str6,py.misc.au:1,' Au'); X`09str6 := fill_str(str6); X`09writev(str7,'Died on Level : ',dun_level:1); X`09str7 := fill_str(str7); X`09str8 := fill_str(died_from); Xdstr`5B00`5D := ' '; Xdstr`5B01`5D := ' _______________________'; Xdstr`5B02`5D := ' / \ ___'; Xdstr`5B03`5D := ' / \ ___ / \ _ V__'; Xdstr`5B04`5D := ' / RIP \ \ : : / V \'; Xdstr`5B05`5D := ' / \ : _;,,,;_ : V :'; Xdstr`5B06`5D := ' /'+str1+ '\,;_ _;, V,,;_'; Xdstr`5B07`5D := ' `7C the `7C ___'; Xdstr`5B08`5D := ' `7C '+str2+ ' `7C / \'; Xdstr`5B09`5D := ' `7C `7C : :'; Xdstr`5B10`5D := ' `7C '+str3+ ' `7C _;,,,;_ V ____'; Xdstr`5B11`5D := ' `7C '+str4+ ' `7C / V \'; Xdstr`5B12`5D := ' `7C '+str5+ ' `7C : V :'; Xdstr`5B13`5D := ' `7C '+str6+ ' `7C : V :'; Xdstr`5B14`5D := ' `7C '+str7+ ' `7C _; V,,,,;_'; Xdstr`5B15`5D := ' `7C killed by `7C'; Xdstr`5B16`5D := ' `7C '+str8+ ' `7C'; Xdstr`5B17`5D := ' `7C '+day+ ' `7C'; Xdstr`5B18`5D := ' *`7C * * * * * * `7C *'; Xdstr`5B19`5D := '________)/\\_)_/___(\/___(//_\)/_\//__\\(/_`7C_)_______'; X`09clear(1,1); X`09for i1 := 0 to 19 do X`09 dprint(dstr`5Bi1`5D,i1+1); X`09flush; X`09if (get_com('Print to file? (Y/N)',command)) then X`09 case command of X`09 'y','Y': begin X`09`09`09prt('Enter Filename:',1,1); X`09`09`09flag := false; X`09`09`09repeat X`09`09`09 if (get_string(fnam,1,17,60)) then X`09`09`09 begin X`09`09`09 if (length(fnam) = 0) then fnam:='MORIACHR.DIE'; X`09`09`09 open (f1,file_name:=fnam,error:=continue); X`09`09`09 if (status(f1) <> 0) then X`09`09`09 prt('Error creating> ' + fnam,2,1) X`09`09`09 else X`09`09`09 begin X`09`09`09`09 flag := true; X`09`09`09`09 rewrite(f1,error:=continue); X`09`09`09`09 for i1 := 0 to 19 do X`09`09`09`09 writeln(f1,dstr`5Bi1`5D,error:=continue); X`09`09`09`09end; X`09`09`09 close(f1,error:=continue); X`09 `09`09 end X`09`09`09 else X`09`09`09 flag := true; X`09`09`09until(flag); X`09`09 end; X`09 otherwise ; X`09 end; X end; X X +-+-+-+-+-+-+-+- END OF PART 20 +-+-+-+-+-+-+-+-