-+-+-+-+-+-+-+-+ START OF PART 41 -+-+-+-+-+-+-+-+ X function get_jpi_path : path; X var X status : integer; X user: path; X jpirec : rec_jpi; X`20 X`7B GETJPI definition `7D X `5Basynchronous,external(SYS$GETJPI)`5D function $getjpi( X %immed p1: integer := %immed 0; X %immed p2: integer := %immed 0; X %immed p3: integer := %immed 0; X var itmlst : rec_jpi; X %immed p4: integer := %immed 0; X %immed p5: integer := %immed 0; X %immed p6: integer := %immed 0) : integer; X external; X`20 X BEGIN X with jpirec do X BEGIN X pathinfo.pathlen:= 128; `7B Image length `7D X pathinfo.jpi$_imagname:= %x207; `7B Image path `7D X new (ptr_path); X new (ptr_pathlen); X ptr_pathlen`5E := 0; X ENDlist := 0; X END; X status := $getjpi(itmlst:=jpirec); X if (not(odd(status))) then X BEGIN X clear(1,1); X put_buffer('Error in retrieving image path.',1,1); X exit; X END X else X get_jpi_path := jpirec.ptr_path`5E; X END; X`20 X BEGIN X tmp_str := get_jpi_path; X i1 := 0; X flag := false; X image_path := ''; X repeat X i1 := i1 + 1; X if (tmp_str`5Bi1`5D = '`5D') then`20 X if (tmp_str`5Bi1+1`5D = '`5B') then X i1 := i1 + 2 X else X `09 begin X `09 flag := true; X `09 image_path := image_path + '.DAT';`09 X `09 end; X image_path := image_path + tmp_str`5Bi1`5D; X until(flag); X BOSS_HOU := image_path + 'HOURS.DAT'; X BOSS_MOR := image_path + 'MESSAGE.DAT'; X BOSS_MAS := image_path + 'BOSSCHR.DAT'; X BOSS_TOP := image_path + 'BOSSTOP.DAT'; X BOSS_HLP := image_path + 'BOSSHLP.HLB'; X BOSS_MON := image_path + 'MONSTERS.DAT'; X BOSS_OBJ := image_path + 'OBJECTS.DAT'; X BOSS_INV := image_path + 'INVENT.DAT'; X BOSS_LOS := image_path + 'LOSER.DAT'; X BOSS_ANNOY:=image_path + 'PUTZS.DAT'; X BOSS_WIZ := image_path + 'WIZARD.DAT'; X BUS_PIC := image_path + 'BUS.DAT'; X QUOTES := image_path + 'QUOTES.DAT'; X SKILLS := image_path + 'SKILLS.DAT'; X END; $ CALL UNPACK [.INC]IO.INC;1 1980660068 $ create 'f' X `7BMain game module X The code in this section has gone through many revisions, and X some of it could stand some more hard work. - no kidding `7D X X `7B `5Binherit('boss.env')`5D module Dungeon; `7D X X`5Bpsect(moria$code)`5D procedure dungeon; X var X dir_val `09 : integer; `7B For movement `7D X y,x,moves`09 : integer; `7B For movement `7D X i1,i2,tmp1`09 : integer; `7B Temporaries `7D X old_chp,old_cmana : integer; `7B Detect change `7D X regen_amount`09 : real; `7B Regenerate hp and mana`7D X command`09`09 : char; `7B Last command `7D X out_val`09`09 : vtype; `7B For messages `7D X moria_flag`09 : boolean; `7B Next level when true`7D X reset_flag`09 : boolean; `7B Do not move creatures `7D X search_flag`09 : boolean; `7B Player is searching `7D X teleport_flag`09 : boolean; `7B Handle telport traps`7D X player_light`09 : boolean; `7B Player carrying light `7D X save_msg_flag`09 : boolean; `7B Msg flag after INKEY`7D X`09unleashed_doom`09 : boolean; `7B The Doom is still buggy `7D X`09doomy,doomx`09 : integer;`20 X`09temp_char`09 : char; X`09temp_dtype`09 : dtype;`20 X X Xprocedure make_boss_stronger; XVar X num `09 : integer; X out_val : ctype; X XBEGIN X with c_list`5Bmax_creatures`5D do X Begin X num := total_winner_num + 1; X writev(out_val,'Boss ',num:1); X name := out_val; X ac := ac + 10; X mexp := mexp + 2000; X speed := speed + 2; X End; XEND; X`20 X`20 X`7B Pre-declaration of MOVE_CHAR `7D X`5Bpsect(creature$code)`5D procedure move_char(dir : integer); X forward; X`20 X`20 X`7B Pre-declaration of CREATURES`7D X procedure creatures(attack : boolean);`20 X forward; X X`7B Pre-declaration of explosion. `7D X procedure explosion(typ,y,x,dam_hp,radius : integer; X`09`09`09 painful`09 : boolean; X`09`09 descrip`09 : ctype); X forward;`20 X`20 X`7B Changes stats up or down for magic items `7D X procedure change_stat(var stat : byteint; amount,factor : integer); X var X i1,i2,i3 : integer; X BEGIN X i2 := amount * factor; X i3 := abs(amount); X for i1 := 1 to i3 do X if (i2 < 0) then X stat := de_statt(stat) X else X stat := in_statt(stat); X END; X`20 X`20 X`7B Changes speed of monsters relative to player X Note: When the player is sped up or slowed down, I simply X change the speed of all the monsters. This greatly X simplified the logic.`7D X procedure change_speed(num : integer); X var X i1 : integer; X BEGIN X py.flags.speed := py.flags.speed + num; X i1 := muptr; X while (i1 <> 0) do X BEGIN X m_list`5Bi1`5D.cspeed := m_list`5Bi1`5D.cspeed + num; X i1 := m_list`5Bi1`5D.nptr; X END; X END; X`20 X`20 X`7B Player bonuses X When an item is worn or taken off, this re-adjusts the player X bonuses. Factor=1 : wear; Factor=-1 : removed `7D X procedure py_bonuses(tobj : treasure_type; factor : integer); X var X item_flags : unsigned; X i1,old_dis_ac : integer; X BEGIN X with py.flags do X BEGIN X if (slow_digest) then X food_digested := food_digested + 1; X if (regenerate) then X food_digested := food_digested - 3; X see_inv := false; X teleport := false; X free_act := false; X slow_digest := false; X aggravate := false; X sustain_str := false; X sustain_int := false; X sustain_wis := false; X sustain_con := false; X sustain_dex := false; X sustain_chr := false; X`09 resist_gas := false; `7Bnot really a flag yet`7D X fire_resist := false; X acid_resist := false; X cold_resist := false; X regenerate := false; X lght_resist := false; X ffall := false; X END; X`20 X if (uand(%X'00000001',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.cstr,tobj.p1,factor); X change_stat(py.stat.str,tobj.p1,factor); X print_stat := uor(%X'0001',print_stat); X END; X if (uand(%X'00000002',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.cdex,tobj.p1,factor); X change_stat(py.stat.dex,tobj.p1,factor); X print_stat := uor(%X'0002',print_stat); X END; X if (uand(%X'00000004',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.ccon,tobj.p1,factor); X change_stat(py.stat.con,tobj.p1,factor); X print_stat := uor(%X'0004',print_stat); X END; X if (uand(%X'00000008',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.cint,tobj.p1,factor); X change_stat(py.stat.int,tobj.p1,factor); X print_stat := uor(%X'0008',print_stat); X END; X if (uand(%X'00000010',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.cwis,tobj.p1,factor); X change_stat(py.stat.wis,tobj.p1,factor); X print_stat := uor(%X'0010',print_stat); X END; X if (uand(%X'00000020',tobj.flags) <> 0) then X BEGIN X change_stat(py.stat.cchr,tobj.p1,factor); X change_stat(py.stat.chr,tobj.p1,factor); X print_stat := uor(%X'0020',print_stat); X END; X if (uand(%X'00000040',tobj.flags) <> 0) then X BEGIN X py.misc.srh := py.misc.srh + (tobj.p1 * 10 * factor); X py.misc.perc := py.misc.perc + (tobj.p1 * 10 * factor); X END; X if (uand(%X'00000100',tobj.flags) <> 0) then X py.misc.stl := py.misc.stl + 2*factor; X if (uand(%X'00001000',tobj.flags) <> 0) then X BEGIN X i1 := tobj.p1*factor; X change_speed(-i1); X END; X if (uand(%X'08000000',tobj.flags) <> 0) then X if (factor > 0) then X py.flags.blind := py.flags.blind + 1000; X if (uand(%X'10000000',tobj.flags) <> 0) then X if (factor > 0) then X py.flags.afraid := py.flags.afraid + 50; X if (uand(%X'40000000',tobj.flags) <> 0) then X py.flags.see_infra := py.flags.see_infra + (tobj.p1 * factor); X with py.misc do X BEGIN X old_dis_ac := dis_ac; X ptohit := tohit_adj; `7B Real To Hit `7D X ptodam := todam_adj; `7B Real To Dam `7D X ptoac:= toac_adj; `7B Real To AC `7D X pac := 0; `7B Real AC `7D X dis_th := ptohit; `7B Display To Hit `7D X dis_td := ptodam; `7B Display To Dam `7D X dis_ac := 0; `7B Display To AC `7D X dis_tac := ptoac; `7B Display AC `7D X for i1 := 23 to equip_max-1 do X with equipment`5Bi1`5D do X if (tval > 0) then X BEGIN X if (uand(%X'80000000',flags) = 0) then X BEGIN X pac := pac + ac; X dis_ac := dis_ac + ac; X END; X ptohit := ptohit + tohit; X ptodam := ptodam + todam; X ptoac := ptoac + toac; X if (index(name,'`5E') = 0) then X BEGIN X dis_th := dis_th + tohit; X dis_td := dis_td + todam; X dis_tac := dis_tac + toac; X END; X END; X dis_ac := dis_ac + dis_tac; X`20 X`7B Add in temporary skill increases `7D X with py.flags do X BEGIN X if (blessed > 0) then X BEGIN X pac := pac + 2; X dis_ac := dis_ac + 2; X END; X if (detect_inv > 0) then X see_inv := true; X END; X`20 X if (old_dis_ac <> dis_ac) then X print_stat := uor(%X'0040',print_stat); X`20 X item_flags := 0; X for i1 := 23 to equip_max-1 do X with equipment`5Bi1`5D do X item_flags := uor(item_flags,flags); X if (uand(%X'00000080',item_flags) <> 0) then X py.flags.slow_digest := true; X if (uand(%X'00000200',item_flags) <> 0) then X py.flags.aggravate := true; X if (uand(%X'00000400',item_flags) <> 0) then X py.flags.teleport := true; X if (uand(%X'00000800',item_flags) <> 0) then X py.flags.regenerate := true; X if (uand(%X'00040000',item_flags) <> 0) then X resist_gas := true; X if (uand(%X'00080000',item_flags) <> 0) then X py.flags.fire_resist := true; X if (uand(%X'00100000',item_flags) <> 0) then X py.flags.acid_resist := true; X if (uand(%X'00200000',item_flags) <> 0) then X py.flags.cold_resist := true; X if (uand(%X'00800000',item_flags) <> 0) then X py.flags.free_act := true; X if (uand(%X'01000000',item_flags) <> 0) then X py.flags.see_inv := true; X if (uand(%X'02000000',item_flags) <> 0) then X py.flags.lght_resist := true; X if (uand(%X'04000000',item_flags) <> 0) then X py.flags.ffall := true; X`20 X for i1 := 23 to equip_max-1 do X with equipment`5Bi1`5D do X if (uand(%X'00400000',flags) <> 0) then X CASE p1 of X 1 : py.flags.sustain_str := true; X 2 : py.flags.sustain_int := true; X 3 : py.flags.sustain_wis := true; X 4 : py.flags.sustain_con := true; X 5 : py.flags.sustain_dex := true; X 6 : py.flags.sustain_chr := true; X otherwise ; X END; X`20 X with py.flags do X BEGIN X if (slow_digest) then X food_digested := food_digested - 1; X if (regenerate) then X food_digested := food_digested + 3; X END; X END; X END; X X`7BThe Witching Hour!!`7D X procedure midnight; X BEGIN X turn := turn - 17280; X day := day + 1; X act_bal := act_bal + trunc(act_bal * iod_val / 7); X principal := principal + trunc(principal * iol_val / 7); X store_maint; X if (day = day_limit) then time_out; X END; X`20 X X`7B I may have written the town level code, but I'm not exactly X proud of it. Adding the stores required some real slucky X hooks which I have not had time to re-think. `7D X`09%INCLUDE 'BOSS_INCLUDE:DISPLAY.INC' X %INCLUDE 'BOSS_INCLUDE:TRAIN.INC' X %INCLUDE 'BOSS_INCLUDE:STORE2.INC' X`20 X`20 X`7B Calculates current boundries `7D X procedure panel_bounds; X BEGIN X panel_row_min := (trunc(panel_row*(screen_height/2)) + 1); X panel_row_max := panel_row_min + screen_height - 1; X panel_row_prt := panel_row_min - 2; X panel_col_min := (trunc(panel_col*(screen_width/2)) + 1); X panel_col_max := panel_col_min + screen_width - 1; X panel_col_prt := panel_col_min - 15; X END; X`20 X`20 X`7B Given an row (y) and col (x), this routine detects X when a move off the screen has occurred and figures new borders`7D X function get_panel(y,x : integer) : boolean; X var X prow,pcol : integer; X BEGIN X prow := panel_row; X pcol := panel_col; +-+-+-+-+-+-+-+- END OF PART 41 +-+-+-+-+-+-+-+-