-+-+-+-+-+-+-+-+ START OF PART 28 -+-+-+-+-+-+-+-+ X prt('You were their last hope, and you have let them down. The Boss',9,3) V; X prt('has vacated the Earth and now resides in an ultra-secure satel-',10,3 V); X prt('lite orbiting in geosynchronous orbit over Sumatra. You lose,',11,3) V; X prt('although you may explore the Boss'' demense to your heart''s',12,3); X prt('content. But it will do absolutely no good at all.',13,3); X pause(24); X out_of_time := true; X draw_cave; XEND; X X $ CALL UNPACK [.INC]DEATH.INC;1 993972441 $ create 'f' X`7B Object descriptor routines`20 X Randomize colors, woods, and metals `7D X`5Bpsect(setup$code)`5D procedure randes; X var X i1,i2 : integer; X tmp : vtype; X BEGIN X for i1 := 1 to max_colors do X BEGIN X i2 := randint(max_colors); X tmp := colors`5Bi1`5D; X colors`5Bi1`5D := colors`5Bi2`5D; X colors`5Bi2`5D := tmp; X END; X for i1 := 1 to max_woods do X BEGIN X i2 := randint(max_woods); X tmp := woods`5Bi1`5D; X woods`5Bi1`5D := woods`5Bi2`5D; X woods`5Bi2`5D := tmp; X END; X for i1 := 1 to max_metals do X BEGIN X i2 := randint(max_metals); X tmp := metals`5Bi1`5D; X metals`5Bi1`5D := metals`5Bi2`5D; X metals`5Bi2`5D := tmp; X END; X for i1 := 1 to max_rocks do X BEGIN X i2 := randint(max_rocks); X tmp := rocks`5Bi1`5D; X rocks`5Bi1`5D := rocks`5Bi2`5D; X rocks`5Bi2`5D := tmp; X END; X for i1 := 1 to max_amulets do X BEGIN X i2 := randint(max_amulets); X tmp := amulets`5Bi1`5D; X amulets`5Bi1`5D := amulets`5Bi2`5D; X amulets`5Bi2`5D := tmp; X END; X for i1 := 1 to max_mush do X BEGIN X i2 := randint(max_mush); X tmp := mushrooms`5Bi1`5D; X mushrooms`5Bi1`5D := mushrooms`5Bi2`5D; X mushrooms`5Bi2`5D := tmp; X END; X END; X`20 X`20 X`7B Return random title `7D X`5Bpsect(setup$code)`5D procedure rantitle ( var title : varying`5Ba`5D of V char ); X X var X `09i3 : integer; X X BEGIN`20 X i3 := (max_syllables div 4); X title := 'Labeled "'; X title := title + syllables`5B (i3*0) + randint(i3)`5D; X title := title + ' to '; X title := title + syllables`5B (i3*1) + randint(i3)`5D; X title := title + ' '; X title := title + syllables`5B (i3*2) + randint(i3)`5D; X title := title + ' '; X title := title + syllables`5B (i3*3) + randint(i3)`5D; X title := title + '"'; X END;`20 X X X`7B Initialize all Potions, wands, staves, scrolls, ect..`7D X`5Bpsect(setup$code)`5D procedure magic_init(random_seed : unsigned); X var X i1,tmpv : integer; X tmps : vtype; X BEGIN X seed := random_seed; X randes; X for i1 := 1 to max_objects do X BEGIN X tmpv := int(uand(%X'FF',object_list`5Bi1`5D.subval)); X case object_list`5Bi1`5D.tval of X 3,75,76 : if (tmpv <= max_colors) then X insert_str(object_list`5Bi1`5D.name,'%C',colors`5Btmp Vv`5D); X 70,71 : BEGIN X rantitle(tmps); X insert_str(object_list`5Bi1`5D.name,'%T',tmps); X END; X 45 : if (tmpv <= max_colors) then X insert_str(object_list`5Bi1`5D.name,'%R',rocks`5Btmpv V`5D); X 40 : if (tmpv <= max_rocks) then X insert_str(object_list`5Bi1`5D.name,'%A',amulets`5Btm Vpv`5D); X 65 : if (tmpv <= max_amulets) then X insert_str(object_list`5Bi1`5D.name,'%M',metals`5Btmp Vv`5D); X 55 : if (tmpv <= max_woods) then X insert_str(object_list`5Bi1`5D.name,'%W',woods`5Btmpv V`5D); X 80 : if (tmpv <= max_mush) then X insert_str(object_list`5Bi1`5D.name,'%M',mushrooms`5B Vtmpv`5D); X 60 : `7Bif (tmpv <= max_rods) then X insert_str(object_list`5Bi1`5D.name,'%D',rods`5Btmpv` V5D)`7D; X otherwise ; X END X END X END; X`20 X`20 X`7B Remove 'Secret' symbol for identity of object `7D X`5Bpsect(misc1$code)`5D procedure known1 ( var object_str : varying`5Ba`5D V of char ); X var X pos,olen : integer; X str1,str2 : vtype; X BEGIN X pos := index(object_str,'`7C'); X if (pos > 0) then X BEGIN X olen := length(object_str); X str1 := substr(object_str,1,pos-1); X str2 := substr(object_str,pos+1,olen-pos); X writev(object_str,str1,str2); X END; X END; X`20 X`20 X`7B Remove 'Secret' symbol for identity of pluses `7D X`5Bpsect(misc1$code)`5D procedure known2 (var object_str : varying`5Ba`5D of V char ); X var X pos,olen : integer; X str1,str2 : vtype; X BEGIN X pos := index(object_str,'`5E'); X if (pos > 0) then X BEGIN X olen := length(object_str); X str1 := substr(object_str,1,pos-1); X str2 := substr(object_str,pos+1,olen-pos); X writev(object_str,str1,str2); X END; X END; X`20 X`20 X`7B Return string without quoted portion `7D X`5Bpsect(misc1$code)`5D procedure unquote (var object_str : varying`5Ba`5D o Vf char ); X var X pos0,pos1,pos2,olen : integer; X str1,str2 : vtype; X BEGIN X pos0 := index(object_str,'"'); X if (pos0 > 0) then X BEGIN X pos1 := index(object_str,'`7E'); X pos2 := index(object_str,'`7C'); X olen := length(object_str); X str1 := substr(object_str,1,pos1); X str2 := substr(object_str,pos2+1,olen-pos2); X writev(object_str,str1,str2); X END X END; X`20 X`20 X`20 X`7B Somethings been identified `7D X`5Bpsect(misc1$code)`5D procedure identify(item : treasure_type); X var X i1,x1,x2 : integer; X BEGIN X x1 := item.tval; X x2 := item.subval; X if (index(item.name,'`7C') > 0) then X BEGIN X for i1 := 1 to max_talloc do X with t_list`5Bi1`5D do X if ((tval = x1) and (subval = x2)) then X BEGIN X unquote(name); X known1(name); X END; X for i1 := 1 to inven_max do X with inventory`5Bi1`5D do X if ((tval = x1) and (subval = x2)) then X BEGIN X unquote(name); X known1(name); X END; X i1 := 0; X repeat `20 X i1 := i1 + 1; X with object_list`5Bi1`5D do X if ((tval = x1) and (subval = x2)) then X if (index(name,'%T') > 0) then X BEGIN X insert_str(name,' %T`7C',''); X object_ident`5Bi1`5D := true; X END X else X BEGIN X unquote(name); X known1(name); X object_ident`5Bi1`5D := true; X END; X until (i1 = max_objects); X END; X END; X`20 X`20 X`7B Returns a description of item for inventory `7D X`5Bpsect(misc1$code)`5D procedure objdes(var out_val : varying`5Ba`5D of cha Vr; X`09`09`09`09 ptr`09 : integer; X`09`09`09`09`09 pref`09 : boolean; X`09`09`09`09`09 which_list : char); X var X pos `09`09: integer; X tmp_val`09`09: vtype; X`09obj_describe : treasure_type; X`09 X BEGIN X if (which_list = 'e') then`20 X obj_describe := equipment`5Bptr`5D `20 X else if (which_list = 't') then X obj_describe := temporary_slot X else X obj_describe := inventory`5Bptr`5D; X X with obj_describe do X BEGIN X tmp_val := name; X pos := index(tmp_val,'`7C'); X if (pos > 0) then X tmp_val := substr(tmp_val,1,pos-1); X pos := index(tmp_val,'`5E'); X if (pos > 0) then X tmp_val := substr(tmp_val,1,pos-1); X if (not(pref)) then X BEGIN X pos := index(tmp_val,' ('); X if (pos > 0) then X tmp_val := substr(tmp_val,1,pos-1); X END; X insert_num(tmp_val,'%P1',p1,true); X insert_num(tmp_val,'%P2',tohit,true); X insert_num(tmp_val,'%P3',todam,true); X insert_num(tmp_val,'%P4',toac,true); X insert_num(tmp_val,'%P5',p1,false); X insert_num(tmp_val,'%P6',ac,false); X if (number <> 1) then X BEGIN X insert_str(tmp_val,'ch`7E','ches'); X`09 insert_str(tmp_val,'fe`7E','ves'); X insert_str(tmp_val,'`7E','s'); X END X else X insert_str(tmp_val,'`7E',''); X if (pref) then X BEGIN X if (index(tmp_val,'&') > 0) then X BEGIN X insert_str(tmp_val,'&',''); X if (number > 1) then X writev(out_val,number:1,tmp_val) X else if (number < 1) then X writev(out_val,'no more',tmp_val) X else if (tmp_val`5B2`5D in vowel_set) then X writev(out_val,'an',tmp_val) X else X writev(out_val,'a',tmp_val); X END X else `20 X out_val := tmp_val; X out_val := out_val + '.'; X END X else X BEGIN X insert_str(tmp_val,'& ',''); X out_val := tmp_val X END; X END X END; $ CALL UNPACK [.INC]DESC.INC;1 2081177940 $ create 'f' X`7B Use an alien device... `7D X `5Bpsect(staff$code)`5D procedure use; X var X i1 : unsigned; X i2,i3,item_val,chance : integer; X out_val : vtype; X redraw,ident : boolean; X begin X reset_flag := true; X if (inven_ctr > 0) then X begin X if (find_range(`5B55`5D,i2,i3)) then X begin X redraw := false; X if (get_item(item_val,'Use which weird device?',redraw,i2,i3 V)) X `09 then X with inventory`5Bitem_val`5D do X begin X if (redraw) then draw_cave; X reset_flag := false; X with py.misc do X chance := wierd + lev + int_adj - level; X if (py.flags.confused > 0) then X chance := trunc(chance/2.0); X if (chance < 0) then chance := 0; X if (randint(chance) < use_device) then X msg_print('You failed to use the device properly.' V) X else if (p1 > 0) then X begin X i1 := flags; X ident := false; X p1 := p1 - 1; X while (i1 > 0) do X begin X i2 := bit_pos(i1); X`7B Staves...`7D X case (i2) of X 1 : ident := light_area(char_row,char_col); X 2 : ident := detect_sdoor; X 3 : ident := detect_trap; X 4 : ident := detect_treasure; X 5 : ident := detect_object; X 6 : begin X teleport(100); X ident := true; X end; X 7 : ident := earthquake; X 8 : begin X for i3 := 1 to randint(4) do X begin X y := char_row; X x := char_col; X summon_monster(y,x,false); X end; X ident := true; X end; X 9 : ident := genocide; X 10 : ident := destroy_area(char_row,char_col); X 11 : ident := starlite(char_row,char_col); X 12 : ident := speed_monsters(+1); X 13 : ident := speed_monsters(-1); X 14 : ident := sleep_monsters2_3(char_row,char_col,20); X 15 : ident := hp_player(randint(8),'a staff.'); X 16 : ident := detect_invisible; X 17 : begin X py.flags.fast := py.flags.fast + randint(30) + 15; X ident := true; X end; X 18 : begin X py.flags.slow := py.flags.slow + randint(30) + 15; X ident := true; X end; X 19 : ident := mass_poly; X 20 : if (remove_curse) then X begin X msg_print('The staff glows blue for a moment...'); X ident := true; X end; X 21 : ident := detect_evil; X 22 : if ((cure_blindness) or (cure_poison) or (cure_confusion)) t Vhen X ident := true; X 23 : ident := dispell_creature(%X'0004',60); X 24 : ident := mass_genocide; X 25 : ident := unlight_area(char_row,char_col); X otherwise ; X end; X`7B End of staff actions... `7D X end; X if (ident) then X identify(inventory`5Bitem_val`5D); X if (flags <> 0) then X with py.misc do X begin X exp := exp + round(level/lev); X prt_experience; X end; X desc_charges(item_val); X end X end X else X if (redraw) then draw_cave; X end X else X msg_print('You are not carrying any wierd devices.'); X end X else X msg_print('But you are not carrying anything.'); X end; $ CALL UNPACK [.INC]DEVICE.INC;1 35005701 $ create 'f' X`7BThis Include file contains all the inventory display routines. +-+-+-+-+-+-+-+- END OF PART 28 +-+-+-+-+-+-+-+-