-+-+-+-+-+-+-+-+ START OF PART 29 -+-+-+-+-+-+-+-+ X`09 then writeln(file1,'Medium') X else if (c_list`5Bi1`5D.mr < 110) X`09 then writeln(file1,'High') X else if (c_list`5Bi1`5D.mr < 140) X`09 then writeln(file1,'Very High') X else writeln(file1,'Extreme'); X X for i2 := 1 to 2 do writeln(file1,' ',error:=continue); Xend; X`09`7B End writing to file `7D X`09 close(file1,error:=continue); X`09 prt('Completed.',1,1); X`09 end; X`09end X end; X X X`09`7B Print the character to a file or device`09`09-RAK-`09`7D X`5Bglobal,psect(misc2$code)`5D procedure file_character; X var X`09i1,i2,xbth,xbthb,xfos,xsrh,xstl,xdis`09: integer; X`09xsave,xdev,xswm,xrep,pos`09`09: integer; X`09xinfra`09`09`09`09`09: vtype; X`09file1`09`09`09`09`09: text; X`09out_val,filename1,prt1,prt2,new_page`09: vtype; X`09tstat`09`09`09`09`09: stat_set; X`09out_c`09`09`09`09`09: array `5Bstat_set`5D of stat_type; X`09curse`09`09`09`09`09: treas_ptr; X X begin X prt('File name: ',1,1); X if (get_string(filename1,1,12,64)) then X`09begin X`09 if (length(filename1) = 0) then filename1 := 'MORIACHR.DAT'; X`09 open(file1,filename1,error:=continue); X`09 if (status(file1) = 0) then X`09 begin X`09 prt('Writing character sheet...',1,1); X`09 put_qio; X`09 rewrite(file1,error:=continue); X`09 new_page := chr(12); X`09 writeln(file1,new_page,error:=continue); X`09 for tstat := sr to ca do`09 `20 X`09`09cnv_stat(py.stat.c`5Btstat`5D,out_c`5Btstat`5D); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); Xwrite(file1, ' Name : ',pad(py.misc.name,' ',24),error:=continue); Xwrite(file1, ' Age :',py.misc.age:4,error:=continue); Xwriteln(file1,' Strength : ',out_c`5Bsr`5D:6,error:=continue); Xwrite(file1, ' Race : ',pad(py.misc.race,' ',24),error:=continue); Xwrite(file1, ' Height :',py.misc.ht:4,error:=continue); Xwriteln(file1,' Intelligence : ',out_c`5Biq`5D:6,error:=continue); Xwrite(file1, ' Sex : ',pad(py.misc.sex,' ',24),error:=continue); Xwrite(file1, ' Weight :',py.misc.wt:4,error:=continue); Xwriteln(file1,' Wisdom : ',out_c`5Bws`5D:6,error:=continue); Xwrite(file1, ' Class : ',pad(py.misc.tclass,' ',24),error:=continue); Xwrite(file1, ' Social Class:',py.misc.sc:4,error:=continue); Xwriteln(file1,' Dexterity : ',out_c`5Bdx`5D:6,error:=continue); Xwrite(file1, ' Title : ',pad(py.misc.title,' ',24),error:=continue); Xwrite(file1, ' Difficulty :',py.misc.diffic:4,error:=continue); Xwriteln(file1,' Constitution : ',out_c`5Bcn`5D:6,error:=continue); Xwrite(file1, ' ',' ':30,error:=continue); Xwrite(file1, ' ',error:=continue); Xwriteln(file1,' Charisma : ',out_c`5Bca`5D:6,error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); Xwrite(file1, ' + To Hit :',py.misc.dis_th:3,' ',error:=continue); Xwrite(file1, ' Level :',py.misc.lev:9,error:=continue); Xwriteln(file1,' Max Hit Points :',py.misc.mhp:4,error:=continue); Xwrite(file1, ' + To Damage :',py.misc.dis_td:3,' ',error:=continue); Xwrite(file1, ' Experience :',py.misc.exp:9,error:=continue); Xwriteln(file1,' Cur Hit Points :',trunc(py.misc.chp):4,error:=continue); Xwrite(file1, ' + To AC :',py.misc.dis_tac:3,' ',error:=continue); Xwrite(file1, ' Gold :',py.misc.money`5Btotal$`5D:9,error:=continu Ve); Xwriteln(file1,' Max Mana :',py.misc.mana:4,error:=continue); Xwrite(file1, ' Total AC :',py.misc.dis_ac:3,' ',error:=continue); Xwrite(file1, ' Account :',py.misc.account:9,error:=continue); Xwriteln(file1,' Cur Mana :',py.misc.mana:4,error:=continue); X X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 with py.misc do X`09`09begin X`09`09 xbth := bth + lev*bth_lev_adj + ptohit*bth_plus_adj; X`09`09 xbthb := bthb + lev*bth_lev_adj + ptohit*bth_plus_adj; X`09`09 xfos := 27 - fos; X`09`09 if (xfos < 0) then xfos := 0; X`09`09 xsrh := srh + spell_adj(iq); X`09`09 xstl := stl; X`09`09 xdis := disarm + lev + 2*todis_adj + spell_adj(iq); X`09`09 xsave := save + lev + spell_adj(ws); X`09`09 xdev := save + lev + spell_adj(iq); X`09`09 xswm := py.flags.swim + 4; X`09`09 xrep := 6 + rep div 25; X`09`09 writev(xinfra,py.flags.see_infra*10:1,' feet'); X`09`09end; Xwriteln(file1,'(Miscellaneous Abilities)':50,error:=continue); Xwriteln(file1,' ',error:=continue); Xwrite(file1, ' Fighting : ',pad(likert(xbth ,12),' ',10),error:=continu Ve); Xwrite(file1, ' Stealth : ',pad(likert(xstl , 1),' ',10),error:=continu Ve); Xwriteln(file1,' Perception : ',pad(likert(xfos , 3),' ',10),error:=continu Ve); Xwrite(file1, ' Throw/Bows : ',pad(likert(xbthb,12),' ',10),error:=continu Ve); Xwrite(file1, ' Disarming : ',pad(likert(xdis , 8),' ',10),error:=continu Ve); Xwriteln(file1,' Searching : ',pad(likert(xsrh , 6),' ',10),error:=continu Ve); Xwrite(file1, ' Saving Throw: ',pad(likert(xsave, 6),' ',10),error:=continu Ve); Xwrite(file1, ' Magic Device: ',pad(likert(xdev , 7),' ',10),error:=continu Ve); Xwriteln(file1,' Infra-Vision: ',pad(xinfra,' ',10),error:=continue); Xwrite(file1, ' Reputation : ',pad(likert(xswm , 1),' ',10),error:=continu Ve); Xwrite(file1, ' ',error:=continue); Xwriteln(file1,' Swimming : ',pad(likert(xrep , 1),' ',10),error:=continu Ve); X`09`7B Write out the character's history `7D Xwriteln(file1,' '); Xwriteln(file1,' '); Xwriteln(file1,'Character Background':45); Xfor i1 := 1 to 5 do writeln(file1,pad(py.misc.history`5Bi1`5D,' ',71):76); X`09`7B Write out the time stats`09`09`7D Xwriteln(file1,' '); Xwriteln(file1,' '); Xwith py.misc.birth do X begin X out_val := day_of_week_string(day,10); X if (index(out_val,' ') > 0) then X out_val := substr(out_val,1,index(out_val,' ')-1); X writeln(file1,' You were born at ',time_string(hour,secs),' on ', X`09`09out_val,', ',month_string(month),' the ',place_string(day), X`09`09', ',year:1,' AH.'); X end; Xwriteln(file1,' ',show_char_age); Xwriteln(file1,' The current time is ',full_date_string(py.misc.cur_age),'.' V); Xwriteln(file1,' You have been playing for ',show_play_time); X`09`7B Write out the equipment list... `7D X`09 i2 := 0; X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' `5BCharacter''s Equipment List`5D',error:=continue V); X`09 writeln(file1,' ',error:=continue); Xif (equip_ctr = 0) then X writeln(file1,' Character has no equipment in use.',error:=continue) Xelse X for i1 := Equipment_min to equip_max-1 do X with equipment`5Bi1`5D do X if (tval > 0) then X`09begin X`09 case i1 of X`09 Equipment_primary`09`09: prt1 := ') You are wielding : '; X`09 Equipment_helm`09`09: prt1 := ') Worn on head : '; X`09 Equipment_amulet`09`09: prt1 := ') Worn around neck : '; X`09 Equipment_armor`09`09: prt1 := ') Worn on body : '; X`09 Equipment_belt`09`09: prt1 := ') Worn around body : '; X`09 Equipment_shield`09`09: prt1 := ') Worn on shield arm : '; X`09 Equipment_gloves`09`09: prt1 := ') Worn on hands : '; X`09 Equipment_bracers`09`09: prt1 := ') Worn on wrists : '; X`09 Equipment_right_ring`09: prt1 := ') Right ring finger : '; X`09 Equipment_left_ring`09`09: prt1 := ') Left ring finger : '; X`09 Equipment_boots`09`09: prt1 := ') Worn on feet : '; X`09 Equipment_cloak`09`09: prt1 := ') Worn about body : '; X`09 Equipment_light`09`09: prt1 := ') Light source is : '; X`09 Equipment_secondary`09`09: prt1 := ') Secondary weapon : '; X`09 otherwise prt1 := ') *Unknown value* : '; X`09 end; X`09 i2 := i2 + 1; X`09 inven_temp`5E.data := equipment`5Bi1`5D; X`09 objdes(prt2,inven_temp,true); X`09 if (uand(inven_temp`5E.data.flags2,insured_bit) = 0) then X`09 writev(out_val,' ',chr(i2+96),prt1,prt2) X`09 else X`09 writev(out_val,' (',chr(i2+96),prt1,prt2); X`09 writeln(file1,out_val,error:=continue); X`09end; X`09`7B Write out the character's inventory... `7D X`09 writeln(file1,new_page,error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' `5BGeneral Inventory List`5D',error:=continue); X`09 writeln(file1,' ',error:=continue); Xif (inven_ctr = 0) then X writeln(file1,' Character has no objects in inventory.',error:=continue) Xelse X begin X i1 := 1; X curse := inventory_list; X while (curse <> nil) do X begin X`09if (i1 mod 50) = 0 then X`09 begin X`09 writeln(file1,new_page,error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' `5BGeneral Inventory List, Page ', X`09`09`09`09((i1 div 50) + 1):1,'`5D', X`09`09`09`09error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 end; X`09inven_temp`5E.data := curse`5E.data; X`09objdes(prt1,inven_temp,true); X`09if (curse`5E.is_in) then prt1 := ' ' + prt1; X`09if (i1 < 27) then X`09 if (uand(inven_temp`5E.data.flags2,insured_bit) = 0) then X`09 writev(out_val,' ',chr(i1+96),') ',prt1) X`09 else X`09 writev(out_val,'(',chr(i1+96),') ',prt1) X`09else X`09 if (uand(inven_temp`5E.data.flags2,insured_bit) = 0) then X`09 writev(out_val,' *) ',prt1) X`09 else X`09 writev(out_val,'(*) ',prt1); X`09if (uand(inven_temp`5E.data.flags2,holding_bit) <> 0) then X`09 out_val := out_val + bag_descrip(curse); X`09writeln(file1,out_val,error:=continue); X`09curse := curse`5E.next; X`09i1 := i1 + 1; X end X end; X`09 writeln(file1,new_page,error:=continue); X`09 close(file1,error:=continue); X`09 prt('Completed.',1,1); X`09 end; X`09end X end; X XEnd. $ CALL UNPACK FILES.PAS;1 259075902 $ create 'f' X`5BInherit('Moria.Env')`5D Module Generate; X X`09`7B Generates a random dungeon level`09`09`09-RAK-`09`7D X`5Bglobal,psect(generate$code)`5D procedure generate_cave; X type X`09coords = record X`09`09y`09: integer; X`09`09x`09: integer; X`09end; X X X var X`09doorstk`09`09`09: array `5B1..100`5D of coords; X`09doorptr`09`09`09: integer; X`09stupid`09`09`09: vtype; X X`09`7B Always picks a correct direction`09`09`7D X procedure correct_dir(var rdir,cdir : integer; y1,x1,y2,x2 : integer); X`09var X`09`09test_dir`09: integer; X`09begin X`09 if (y1 < y2) then X`09 rdir := 1 X`09 else if (y1 = y2) then X`09 rdir := 0 X`09 else X`09 rdir := -1; X`09 if (x1 < x2) then X`09 cdir := 1 X`09 else if (x1 = x2) then X`09 cdir := 0 X`09 else X`09 cdir := -1; X`09 if ((rdir <> 0) and (cdir <> 0)) then X`09 case randint(2) of X`09`091 :`09rdir := 0; X`09`092 :`09cdir := 0 X`09 end X`09end; X X X`09`7B Chance of wandering direction`09`09`09`7D X procedure rand_dir(var rdir,cdir : integer;`20 X`09`09`09 y1,x1,y2,x2,chance : integer); X`09begin X`09 case randint(chance) of X`09`091 :`09begin X`09`09`09 rdir := -1; X`09`09`09 cdir := 0 X`09`09`09end; X`09`092 :`09begin X`09`09`09 rdir := 1; X`09`09`09 cdir := 0 X`09`09`09end; X`09`093 :`09begin X`09`09`09 rdir := 0; X`09`09`09 cdir := -1 X`09`09`09end; X`09`094 :`09begin X`09`09`09 rdir := 0; X`09`09`09 cdir := 1 X`09`09`09end; X`09`09otherwise correct_dir(rdir,cdir,y1,x1,y2,x2) X`09 end X`09end; X `20 X X`09`7B Blanks out entire cave`09`09`09`09-RAK-`09`7D X procedure blank_cave; X var X`09i1,i2`09: integer; X begin X for i1 := 1 to max_height do X`09 for i2 := 1 to max_width do X`09 cave`5Bi1,i2`5D := blank_floor; X end; X X X`09`7B Fills in empty spots with desired rock`09`09-RAK-`09`7D X`09`7B Note: 9 is a temporary value.`09`09`09`09`7D X procedure fill_cave(fill : floor_type); X var X`09i1,i2`09: integer; X begin X`09for i1 := 2 to cur_height - 1 do X`09 for i2 := 2 to cur_width - 1 do X`09 with cave`5Bi1,i2`5D do X`09 if (fval in `5B0,8,9`5D) then X`09`09begin X`09`09 fval := fill.ftval; X`09`09 fopen := fill.ftopen; X`09`09end; X end; X X X`09`7B Places indestructable rock around edges of dungeon`09-RAK-`09`7D X procedure place_boundry; X var X`09i1`09: integer; X begin X`09for i1 := 1 to cur_height do X`09 begin X`09 cave`5Bi1,1`5D.fval := boundry_wall.ftval; X`09 cave`5Bi1,1`5D.fopen := boundry_wall.ftopen; X`09 cave`5Bi1,cur_width`5D.fval := boundry_wall.ftval; X`09 cave`5Bi1,cur_width`5D.fopen := boundry_wall.ftopen; X`09 end; X`09for i1 := 1 to cur_width do X`09 begin X`09 cave`5B1,i1`5D.fval := boundry_wall.ftval; X`09 cave`5B1,i1`5D.fopen := boundry_wall.ftopen; X`09 cave`5Bcur_height,i1`5D.fval := boundry_wall.ftval; X`09 cave`5Bcur_height,i1`5D.fopen := boundry_wall.ftopen; X`09 end; X end; X X X`09`7B Places "streamers" of rock through dungeon`09`09-RAK-`09`7D X procedure place_streamer(rock : floor_type; treas_chance : integer); X var X`09i1,y,x,dir,ty,tx,t1,t2`09`09: integer; X`09flag`09`09`09`09: boolean; X begin X X`09`7B Choose starting point and direction`09`09`7D X`09y := trunc(cur_height/2.0) + 11 - randint(23); X`09x := trunc(cur_width/2.0) + 16 - randint(33); X X`09dir := randint(8);`09`7B Number 1-4, 6-9`09`7D X`09if (dir > 4) then dir := dir + 1; X X`09`7B Place streamer into dungeon`09`09`09`7D X`09flag := false;`09`7B Set to true when y,x are out-of-bounds`7D X`09t1 := 2*dun_str_rng + 1;`09`7B Constants`09`7D X`09t2 := dun_str_rng + 1; X`09repeat X`09 for i1 := 1 to dun_str_den do X`09 begin X`09 ty := y + randint(t1) - t2; X`09 tx := x + randint(t1) - t2; X`09 if (in_bounds(ty,tx)) then X`09 with cave`5Bty,tx`5D do X`09`09 if (fval = rock_wall1.ftval) then X`09`09 begin X`09`09 fval := rock.ftval; X`09`09 fopen := rock.ftopen; X`09`09 if (randint(treas_chance) = 1) then X`09`09 place_gold(ty,tx); X`09`09 end; X`09 end; +-+-+-+-+-+-+-+- END OF PART 29 +-+-+-+-+-+-+-+-