-+-+-+-+-+-+-+-+ START OF PART 21 -+-+-+-+-+-+-+-+ X`09`7B Calculates the total number of points earned`09`09-JWT-`09`7D X function total_points : integer; X begin X`09with py.misc do X`09 total_points := max_exp + (100*py.misc.max_lev); X end; X X X`09`7B Enters a players name on the top twenty list`09`09-JWT-`09`7D X procedure top_twenty; X var X`09list`09`09: array `5B1..20`5D of vtype; X`09blank`09`09: packed array `5B1..13`5D of char; X`09i1,i2,i3,i4`09: integer; X`09n1`09`09: integer; X`09trys`09`09: integer; X`09o1,o2`09`09: vtype; X`09f1`09`09: text; X`09flag,file_flag`09: boolean; X begin X`09if (wizard1) then exit; X`09clear(1,1); X`09for i1 := 1 to 20 do X`09 list`5Bi1`5D := ''; X`09n1 := 1; X`09priv_switch(1); X`09trys := 0; X`09file_flag := false; X`09repeat X`09 open (f1,file_name:=moria_top, X`09`09organization:=sequential,history:=old, X`09`09sharing:=none,error:=continue); X`09 if (status(f1) = 2) then X`09 begin X`09 trys := trys + 1; X`09 if (trys > 5) then X`09`09file_flag := true X`09 else X`09`09sleep(2); X`09 end X`09 else X`09 file_flag := true; X`09until(file_flag); X`09if ((status(f1) <> 0) and (status(f1) <> 2)) then`20 X`09 open (f1,file_name:=moria_top, X`09`09organization:=sequential,history:=new, X`09`09sharing:=none,error:=continue); X`09if (status(f1) <> 0) then X`09 begin X`09 writeln('Error in opening ',moria_top); X`09 writeln('Please contact local Moria Wizard.'); X`09 exit; X`09 end; X`09reset(f1); X`09while ((not eof(f1)) and (n1 <= 20)) do X`09 begin X`09 readln(f1,list`5Bn1`5D,error:=continue); X`09 n1 := n1 + 1; X`09 end; X`09n1 := n1 - 1; X`09i1 := 1; X`09i3 := total_points; X`09flag := false; X`09while ((i1 <= n1) and (not flag)) do X`09 begin X`09 readv(list`5Bi1`5D,blank,i4); X`09 if (i4 < i3) then X`09 flag := true X`09 else X`09 i1 := i1 + 1; X`09 end; X`09if ((flag) or (n1 = 0) or (n1 < 20)) then X`09 begin X`09 for i2 := 19 downto i1 do X`09 list`5Bi2+1`5D := list`5Bi2`5D; X`09 o1 := get_username; X`09 case py.misc.lev of X`09 1`09`09: writev(o2,py.misc.lev:1,'st level '); X`09 2`09`09: writev(o2,py.misc.lev:1,'nd level '); X`09 3`09`09: writev(o2,py.misc.lev:1,'rd level '); X`09 otherwise`09 writev(o2,py.misc.lev:1,'th level '); X`09 end; X`09 writev(list`5Bi1`5D,pad(o1,' ',13),i3:7,' ', X`09`09py.misc.name,', a ',o2,py.misc.race,' ', X`09`09py.misc.tclass,'.'); X`09 if (n1 < 20) then X`09 n1 := n1 + 1; X`09 flag := false; X`09 end; X`09rewrite(f1); X`09for i1 := 1 to n1 do X`09 writeln(f1,list`5Bi1`5D); X`09close(f1); X`09priv_switch(0); X`09put_buffer('Username Points Character that died.',1,1); X`09for i1 := 1 to n1 do X`09 put_buffer(list`5Bi1`5D,i1+1,1); X`09put_buffer('',i1+2,1); X`09put_qio; X end; X X X`09`7B Change the player into a King!`09`09`09-RAK-`09`7D X procedure kingly; X begin X`09`7B Change the character attributes...`09`09`7D X`09dun_level := 0; X`09died_from := 'Ripe Old Age'; X`09with py.misc do X`09 begin X`09 lev := lev + max_player_level; X`09 if (sex`5B1`5D = 'M') then X`09 begin X`09`09title := 'Magnificent'; X`09 tclass := '*King*'; X`09 end X`09 else X`09 begin X`09`09title := 'Beautiful'; X`09 tclass := '*Queen*'; X`09 end; X`09 au := au + 250000; X`09 max_exp := max_exp + 5000000; X`09 exp := max_exp; X`09 end; X`09`7B Let the player know that he did good...`09`7D X`09clear(1,1); X`09dprint(' #',2); X`09dprint(' #####',3); X`09dprint(' #',4); X`09dprint(' ,,, $$$ ,,,',5); X`09dprint(' ,,=$ "$$$$$" $=,,',6); X`09dprint(' ,$$ $$$ $$,',7); X`09dprint(' *> <*> <*',8); X`09dprint(' $$ $$$ $$',9); X`09dprint(' "$$ $$$ $$"',10); X`09dprint(' "$$ $$$ $$"',11); X`09dprint(' *#########*#########*',12); X`09dprint(' *#########*#########*',13); X`09dprint(' Veni, Vidi, Vici!',16); X`09dprint(' I came, I saw, I conquered!',17); X`09dprint(' All Hail the Mighty King!',18); X`09flush; X`09pause(24); X end; X X X`09`7B What happens upon dying...`09`09`09`09-RAK-`09`7D X begin X if (total_winner) then kingly; X print_tomb; X top_twenty; X exit; X end; $ CALL UNPACK [.SOURCE.INCLUDE]DEATH.INC;1 2065525902 $ create 'f' X`09`7B Object descriptor routines`09`09`09`09`09`7D X X`09`7B Randomize colors, woods, and metals`09`09`09`09`7D X`5Bpsect(setup$code)`5D procedure randes; X var X`09i1,i2`09`09: integer; X`09tmp`09`09: vtype; X begin X for i1 := 1 to max_colors do X`09begin X`09 i2 := randint(max_colors); X`09 tmp := colors`5Bi1`5D; X`09 colors`5Bi1`5D := colors`5Bi2`5D; X`09 colors`5Bi2`5D := tmp; X`09end; X for i1 := 1 to max_woods do X`09begin X`09 i2 := randint(max_woods); X`09 tmp := woods`5Bi1`5D; X`09 woods`5Bi1`5D := woods`5Bi2`5D; X`09 woods`5Bi2`5D := tmp; X`09end; X for i1 := 1 to max_metals do X`09begin X`09 i2 := randint(max_metals); X`09 tmp := metals`5Bi1`5D; X`09 metals`5Bi1`5D := metals`5Bi2`5D; X`09 metals`5Bi2`5D := tmp; X`09end; X for i1 := 1 to max_rocks do X`09begin X`09 i2 := randint(max_rocks); X`09 tmp := rocks`5Bi1`5D; X`09 rocks`5Bi1`5D := rocks`5Bi2`5D; X`09 rocks`5Bi2`5D := tmp; X`09end; X for i1 := 1 to max_amulets do X`09begin X`09 i2 := randint(max_amulets); X`09 tmp := amulets`5Bi1`5D; X`09 amulets`5Bi1`5D := amulets`5Bi2`5D; X`09 amulets`5Bi2`5D := tmp; X`09end; X for i1 := 1 to max_mush do X`09begin X`09 i2 := randint(max_mush); X`09 tmp := mushrooms`5Bi1`5D; X`09 mushrooms`5Bi1`5D := mushrooms`5Bi2`5D; X`09 mushrooms`5Bi2`5D := tmp; X`09end; X end; X X X`09`7B Return random title`09`09`09`09`09`09`7D X`5Bpsect(setup$code)`5D procedure rantitle`09( X`09`09`09var title`09: varying`5Ba`5D of char X`09`09`09`09`09); X var X`09i1,i2,i3`09: integer; X begin X i3 := randint(2) + 1; X title := 'Titled "'; X for i1 := 1 to i3 do X`09begin X`09 for i2 := 1 to randint(2) do X`09 title := title + syllables`5Brandint(max_syllables)`5D; X`09 if (i1 <> i3) then title := title + ' '; X`09end; X title := title + '"'; X end; X X X`09`7B Initialize all Potions, wands, staves, scrolls, ect...`09`7D X`5Bpsect(setup$code)`5D procedure magic_init(random_seed : unsigned); X var X`09i1,tmpv`09`09: integer; X`09tmps`09`09: vtype; X begin X seed := random_seed; X randes; X for i1 := 1 to max_objects do X`09begin X`09 tmpv := int(uand(%X'FF',object_list`5Bi1`5D.subval)); X`09 case object_list`5Bi1`5D.tval of X`09 75,76 : if (tmpv <= max_colors) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%C',colors`5Btmpv`5D); X`09 70,71 : begin X`09`09 rantitle(tmps); X`09`09 insert_str(object_list`5Bi1`5D.name,'%T',tmps); X`09`09 end; X`09`0945 : if (tmpv <= max_colors) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%R',rocks`5Btmpv`5D); X`09`0940 : if (tmpv <= max_rocks) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%A',amulets`5Btmpv`5D); X`09`0965 : if (tmpv <= max_amulets) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%M',metals`5Btmpv`5D); X`09`0955 : if (tmpv <= max_woods) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%W',woods`5Btmpv`5D); X`09 80 : if (tmpv <= max_mush) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%M',mushrooms`5Btmpv`5D); X`09`0960 : `7Bif (tmpv <= max_rods) then X`09`09 insert_str(object_list`5Bi1`5D.name,'%D',rods`5Btmpv`5D)`7D; X`09`09otherwise ; X`09 end X`09end X end; X X X`09`7B Remove 'Secret' symbol for identity of object`09`09`09`7D X`5Bpsect(misc1$code)`5D procedure known1`09( X`09`09`09var object_str`09: varying`5Ba`5D of char X`09`09`09`09`09); X var X`09pos,olen`09: integer; X`09str1,str2`09: vtype; X begin X pos := index(object_str,'`7C'); X if (pos > 0) then X`09begin X`09 olen := length(object_str); X`09 str1 := substr(object_str,1,pos-1); X`09 str2 := substr(object_str,pos+1,olen-pos); X`09 writev(object_str,str1,str2); X`09end; X end; X X X`09`7B Remove 'Secret' symbol for identity of pluses`09`09`09`7D X`5Bpsect(misc1$code)`5D procedure known2`09( X`09`09`09var object_str`09: varying`5Ba`5D of char X`09`09`09`09`09); X var X`09pos,olen`09: integer; X`09str1,str2`09: vtype; X begin X pos := index(object_str,'`5E'); X if (pos > 0) then X`09begin X`09 olen := length(object_str); X`09 str1 := substr(object_str,1,pos-1); X`09 str2 := substr(object_str,pos+1,olen-pos); X`09 writev(object_str,str1,str2); X`09end; X end; X X X`09`7B Return string without quoted portion`09`09`09`09`7D X`5Bpsect(misc1$code)`5D procedure unquote`09( X`09`09`09var object_str`09: varying`5Ba`5D of char X`09`09`09`09`09); X var X`09pos0,pos1,pos2,olen`09: integer; X`09str1,str2`09`09: vtype; X begin X pos0 := index(object_str,'"'); X if (pos0 > 0) then X`09begin X`09 pos1 := index(object_str,'`7E'); X`09 pos2 := index(object_str,'`7C'); X`09 olen := length(object_str); X`09 str1 := substr(object_str,1,pos1); X`09 str2 := substr(object_str,pos2+1,olen-pos2); X`09 writev(object_str,str1,str2); X`09end X end; X`09 `20 X X X`09`7B Somethings been identified`09`09`09`09`09`7D X`5Bpsect(misc1$code)`5D procedure identify(item : treasure_type); X var X`09i1,x1,x2`09`09: integer; X begin X x1 := item.tval; X x2 := item.subval; X if (index(item.name,'`7C') > 0) then X`09begin X for i1 := 1 to max_talloc do X`09 with t_list`5Bi1`5D do X`09 if ((tval = x1) and (subval = x2)) then X`09 begin X`09 unquote(name); X`09 known1(name); X`09 end; X for i1 := 1 to inven_max do X`09 with inventory`5Bi1`5D do X`09 if ((tval = x1) and (subval = x2)) then X`09 begin X`09 unquote(name); X`09 known1(name); X`09 end; X i1 := 0; X repeat X`09 i1 := i1 + 1; X`09 with object_list`5Bi1`5D do X`09 if ((tval = x1) and (subval = x2)) then X`09 if (index(name,'%T') > 0) then X`09`09 begin X`09 insert_str(name,' %T`7C',''); X`09`09 object_ident`5Bi1`5D := true; X`09`09 end X`09`09else X`09`09 begin X`09 unquote(name); X`09 known1(name); X`09 object_ident`5Bi1`5D := true; X`09 end; X until (i1 = max_objects); X`09end; X end; X X X`09`7B Returns a description of item for inventory`09`09`09`7D X`5Bpsect(misc1$code)`5D procedure objdes( X`09`09var out_val `09: varying`5Ba`5D of char; X`09`09 ptr `09: integer; X`09`09 pref `09: boolean); X var X`09pos`09`09: integer; X`09tmp_val`09`09: vtype; X begin X with inventory`5Bptr`5D do X`09begin X`09 tmp_val := name; X`09 pos := index(tmp_val,'`7C'); X`09 if (pos > 0) then X`09 tmp_val := substr(tmp_val,1,pos-1); X`09 pos := index(tmp_val,'`5E'); X`09 if (pos > 0) then X`09 tmp_val := substr(tmp_val,1,pos-1); X`09 if (not(pref)) then X`09 begin X`09 pos := index(tmp_val,' ('); X`09 if (pos > 0) then X`09`09tmp_val := substr(tmp_val,1,pos-1); X`09 end; X`09 insert_num(tmp_val,'%P1',p1,true); X`09 insert_num(tmp_val,'%P2',tohit,true); X`09 insert_num(tmp_val,'%P3',todam,true); X`09 insert_num(tmp_val,'%P4',toac,true); X`09 insert_num(tmp_val,'%P5',p1,false); X`09 insert_num(tmp_val,'%P6',ac,false); X`09 if (number <> 1) then X`09 begin X`09 insert_str(tmp_val,'ch`7E','ches'); X`09 insert_str(tmp_val,'`7E','s'); X`09 end X`09 else X`09 insert_str(tmp_val,'`7E',''); X`09 if (pref) then X`09 begin X`09 if (index(tmp_val,'&') > 0) then X`09 begin X`09 insert_str(tmp_val,'&',''); X`09 if (number > 1) then X`09 writev(out_val,number:1,tmp_val) X`09`09 else if (number < 1) then X`09`09 writev(out_val,'no more',tmp_val) X`09 else if (tmp_val`5B2`5D in vowel_set) then X`09 writev(out_val,'an',tmp_val) X`09 else X`09 writev(out_val,'a',tmp_val); X`09 end X`09 else X`09 out_val := tmp_val; X`09 out_val := out_val + '.'; X`09 end X`09 else X`09 begin X`09 insert_str(tmp_val,'& ',''); X`09 out_val := tmp_val; X`09 end; X`09end X end; $ CALL UNPACK [.SOURCE.INCLUDE]DESC.INC;1 520826051 $ create 'f' X`09`7B Eat some food...`09`09`09`09`09-RAK-`09`7D X`5Bpsect(misc2$code)`5D procedure eat; X var X`09`09i1`09`09`09`09: unsigned; X`09`09i2,i3,item_val`09`09`09: integer; X`09`09out_val`09`09`09`09: vtype; X`09`09redraw,ident`09`09`09: boolean; X begin X`09reset_flag := true; X`09if (inven_ctr > 0) then X`09 begin X`09 if (find_range(`5B80`5D,i2,i3)) then X`09 begin X`09`09redraw := false; X`09`09if (get_item(item_val,'Eat what?',redraw,i2,i3)) then X`09`09 with inventory`5Bitem_val`5D do X`09`09 begin X`09`09 if (redraw) then draw_cave; X`09`09 reset_flag := false; X`09`09 i1 := flags; X`09`09 ident := false; X`09`09 while (i1 > 0) do X`09`09`09begin X`09`09`09 i2 := bit_pos(i1); X`09`7B Foods`09`09`09`09`09`09`09`7D X`09case (i2) of X`09 1 :`09with py.flags do X`09`09 begin X`09`09 poisoned := poisoned + randint(10) + level; X`09`09 ident := true; X`09`09 end; X`09 2 :`09with py.flags do X`09`09 begin X`09`09 blind := blind + randint(250) + 10*level + 100; X`09`09 draw_cave; X`09`09 msg_print('A veil of darkness surrounds you.'); X`09`09 ident := true; X`09`09 end; X`09 3 :`09with py.flags do X`09`09 begin X`09`09 afraid := afraid + randint(10) + level; X`09`09 msg_print('You feel terrified!'); X`09`09 ident := true; X`09`09 end; X`09 4 :`09with py.flags do X`09`09 begin X`09`09 confused := confused + randint(10) + level; X`09`09 msg_print('You feel drugged.'); +-+-+-+-+-+-+-+- END OF PART 21 +-+-+-+-+-+-+-+-