-+-+-+-+-+-+-+-+ START OF PART 15 -+-+-+-+-+-+-+-+ X with fg.object`5Bfg_slot`5D do X while (n <= obj_layers) and (not done) do X if obj_map`5Bloc.x,loc.y,n`5D = 0 then X begin X done := true; X obj_map`5Bloc.x,loc.y,n`5D := fg_slot; X end X else n := n + 1; X end; X Xbegin X if f_num = 0 then X begin X f_start := 1; X f_end := maxobjs; X end X else X begin X f_start := f_num; X f_end := f_num; X end; X for fg_slot := f_start to f_end do X if fg.object`5Bfg_slot`5D.object.num <> 0 then plot_object; Xend; X X`5Basynchronous`5D Xfunction foreground_found(x,y,feet,head,looking_for:integer; X`09`09`09var fg_slot:integer):boolean; Xvar X i:integer; Xbegin X foreground_found := false; X fg_slot := 0; X for i := 1 to fg_layers do X if fg.map`5Bx,y,i`5D > 0 then X with fg.effect`5Bfg.map`5Bx,y,i`5D`5D do X if (kind = looking_for) and overlap(base,altitude,feet,head) then X begin X foreground_found := true; X fg_slot := fg.map`5Bx,y,i`5D; X end; Xend; X Xfunction object_location(var x,y:integer; closest:boolean := false):boolean; Xvar X found:boolean := false; X i:integer := 1; X current:integer := 100; X X function find_object(slot:integer):boolean; X var X moron:integer; X begin X find_object := false; X if fg.object`5Bslot`5D.object.num <> 0 then X begin X x := fg.object`5Bslot`5D.loc.x; X y := fg.object`5Bslot`5D.loc.y; X if not foreground_found(x,y,pl`5Bnow`5D.attrib_ex`5Bst_base`5D, X pl`5Bnow`5D.attrib_ex`5Bat_size`5D,fg_shop,moron) then find_object := V true; X end; X end; X Xbegin X if closest then X begin X for i := 1 to maxobjs do X if fg.object`5Bi`5D.object.num <> 0 then X if distance(fg.object`5Bi`5D.loc.x,fg.object`5Bi`5D.loc.y, X pl`5Bnow`5D.where.x,pl`5Bnow`5D.where.y) < current then X begin X found := find_object(i); X if found then current := distance(x,y,pl`5Bnow`5D.where.x,pl`5Bnow`5D. Vwhere.y); X end; X end; X while (i < 1000) and (not found) do X begin X found := find_object(rnum(maxobjs)); X i := i + 1; X end; X if not found then X begin X i := 1; X while (i < maxobjs) and (not found) do X if not find_object(i) then i := i + 1; X end; X object_location := found; Xend; X Xfunction foreground_location(fg_kind:integer; var x,y:integer):boolean; Xvar X fg_slot,tries:integer := 1; X found,done:boolean := false; Xbegin X x := 1; X y := 1; X while (fg_slot < fg_max) and (not found) do X if fg.effect`5Bfg_slot`5D.kind = fg_kind then found := true X else fg_slot := fg_slot + 1; X if found then X while (tries < 5000) and (not done) do X begin X tries := tries + 1; X x := rnum(here.size.x); X y := rnum(here.size.y); X if foreground_found(x,y,0,10,fg_kind,fg_slot) then done := true; X end; X if not done then X begin X y := 0; X while (y < here.size.y) and not done do X begin X y := y + 1; X x := 1; X while (x < here.size.x) and not done do X if foreground_found(x,y,0,10,fg_kind,fg_slot) then done := true X else x := x + 1; X end; X end; X foreground_location := done; Xend; X X`5Basynchronous`5D Xprocedure map_foreground(fg_slot:integer; X`09`09`09 geometry,geo1,geo2,geo3,geo4:integer := 0; X`09`09`09 add_fg:boolean := true); Xvar X x,y,dist,sx,sy,ex,ey:integer; X dx,dy:integer; X bitmap:array`5B1..maxhoriz,1..maxvert`5D of boolean; X X procedure clear_bitmap; X begin X for x := 1 to maxhoriz do X for y := 1 to maxvert do bitmap`5Bx,y`5D := false; X end; X X procedure plot_bitmap; X var X i,j,n:integer; X done:boolean; X X function fg_exists:boolean; X var X int:integer; X begin X fg_exists := false; X for int := 1 to fg_layers do X if fg.map`5Bi,j,int`5D = fg_slot then fg_exists := true; X end; X X begin X for j := 1 to maxvert do X for i := 1 to maxhoriz do X if bitmap`5Bi,j`5D then X begin X n := 1; X done := false; X X if (not add_fg) and fg_exists then X for n := 1 to fg_layers do X if fg.map`5Bi,j,n`5D = fg_slot then fg.map`5Bi,j,n`5D := 0; X X if add_fg and (not fg_exists) then X while (n <= fg_layers) and (not done) do X if fg.map`5Bi,j,n`5D = 0 then X begin X`09done := true; X`09fg.map`5Bi,j,n`5D := fg_slot; X end X else n := n + 1; X end; X end; X Xbegin X if fg.effect`5Bfg_slot`5D.kind <> 0 then X begin X clear_bitmap; X case geometry of Xg_rectangle: X for x := geo1 to geo3 do X for y := geo2 to geo4 do bitmap`5Bx,y`5D := true; Xg_line: X begin X`09dist := distance(geo1,geo2,geo3,geo4); X`09dx := geo3 - geo1; X`09dy := geo4 - geo2; X`09for x := 0 to dist do X bitmap`5Bround(geo1 + (x * dx)/dist), X`09 round(geo2 + (x * dy)/dist)`5D := true; X end; Xg_point: X bitmap`5Bgeo1,geo2`5D := true; Xg_circle: X`09 begin X`09 sx := geo1 - geo4; X`09 if sx < 1 then sx := 1; X`09 sy := geo2 - geo4; X`09 if sy < 1 then sy := 1; X`09 ex := geo1 + geo4; X`09 if ex > maxhoriz then ex := maxhoriz; X`09 ey := geo2 + geo4; X`09 if ey > maxvert then ey := maxvert; X`09 for x := sx to ex do X`09 for y := sy to ey do X`09 begin X`09 dist := distance(geo1,geo2,x,y); X`09 if (dist <= geo4) and (dist >= geo3) then bitmap`5Bx,y`5D := true; X`09 end; X`09 end; X end; X plot_bitmap; X end; Xend; X X`5Basynchronous`5D Xprocedure center_x(var didcenterx:boolean); Xvar X newoffsetx:integer; Xbegin X newoffsetx := pl`5Bnow`5D.where.x-(vpsizex div 2); X if newoffsetx < 1 then newoffsetx := 1; X if newoffsetx +vpsizex > here.size.x then newoffsetx := here.size.x - vpsi Vzex + 1; X if newoffsetx <> vpoffsetx then didcenterx := true else didcenterx := fals Ve; X vpoffsetx := newoffsetx; Xend; X X`5Basynchronous`5D Xprocedure center_y(var didcentery:boolean); Xvar X newoffsety:integer; Xbegin X newoffsety := pl`5Bnow`5D.where.y - (vpsizey div 2); X if newoffsety < 1 then newoffsety := 1; X if newoffsety + vpsizey-1 > here.size.y then newoffsety := here.size.y - v Vpsizey + 1; X if newoffsety <> vpoffsety then didcentery := true else didcentery := fals Ve; X vpoffsety := newoffsety; Xend; X X`5Basynchronous`5D Xprocedure center_me(mandatory:boolean := false); Xvar X didcenterx,didcentery:boolean; Xbegin X didcenterx := false; X didcentery := false; X if (pl`5Bnow`5D.where.x-vpoffsetx < vpsizex div scrollratio) or`20 X (vpoffsetx+vpsizex-pl`5Bnow`5D.where.x <= vpsizex div scrollratio) or X mandatory then center_x(didcenterx); X if (pl`5Bnow`5D.where.y-vpoffsety < vpsizey div scrollratio) or X (vpoffsety+vpsizey-pl`5Bnow`5D.where.y <= vpsizey div scrollratio) or X didcenterx or X mandatory then center_y(didcentery); X if didcentery and (not didcenterx) then center_x(didcenterx); X if didcenterx or didcentery or mandatory then X smg$change_viewport(gwind,vpoffsety,vpoffsetx,vpsizey,vpsizex); Xend; X X`5Basynchronous`5D Xprocedure draw_screen(sameroom:boolean := false); Xbegin X X`7BSet viewport as large as I can, or to the room size if smaller.`7D X X vpsizex := min(myvpmaxx,here.size.x); X vdoffsetx := (vpmaxx - vpsizex) div 2; X X vpsizey := min(myvpmaxy,here.size.y); X vdoffsety := (vpmaxy - vpsizey) div 2; X X center_me(true); X if not sameroom then X begin X map_objects; X fix_room(pl`5Bnow`5D.attrib_ex`5Bst_base`5D + myview); X smg$label_border(gwind,name`5Bna_room`5D.id`5Bhere.valid`5D); X end; X smg$repaste_virtual_display(gwind,pasteboard,vdoffsety+2,vdoffsetx+2); X smg$end_pasteboard_update(pasteboard); Xend; X X`5Basynchronous`5D Xprocedure turn_on_fg(fg_slot:integer; do_act:boolean := true); Xbegin X with fg.effect`5Bfg.effect`5Bfg_slot`5D.fparm1`5D do X if not on then X begin X if do_act then act_out(plr`5Bnow`5D.log,e_turn_on,fg_slot); X on := true; X fix_room(pl`5Bnow`5D.attrib_ex`5Bst_base`5D + myview); X end; Xend; X X`5Basynchronous`5D Xprocedure turn_off_fg(fg_slot:integer; do_act:boolean := true); Xbegin X with fg.effect`5Bfg.effect`5Bfg_slot`5D.fparm1`5D do X if on then X begin X if do_act then act_out(plr`5Bnow`5D.log,e_turn_off,fg_slot); X on := false; X fix_room(pl`5Bnow`5D.attrib_ex`5Bst_base`5D + myview); X end; Xend; X X`5Basynchronous`5D Xprocedure toggle_fg(fg_slot:integer; do_act:boolean := true); Xbegin X if fg.effect`5Bfg.effect`5Bfg_slot`5D.fparm1`5D.on then turn_off_fg(fg_slo Vt,do_act) X else turn_on_fg(fg_slot,do_act); Xend; X X`5Basynchronous`5D Xprocedure toggle_door(x,y,fg_slot:integer; do_act:boolean := false); Xbegin X wl('It is a pleasure to open for you.'); X if do_act then act_out(plr`5Bnow`5D.log,e_open,x,y,fg_slot); X map_foreground(fg_slot,g_point,x,y,,,false); X with fg.effect`5Bfg_slot`5D do X if fparm1 in `5B1..maxfg`5D then X map_foreground(fparm1,g_point,x,y); X fix_scenery(x,y); Xend; X X`5Basynchronous`5D Xprocedure g_plot(geo,geo1,geo2,geo3,geo4,base,altitude:integer; icon:char; X`09`09rendition:unsigned := 0); Xvar X sx,sy,ex,ey,x,y,dist,dx,dy,z:integer; X slot,map_type:integer := 0; X s:varying`5Bmaxhoriz`5D of char; X X procedure plot_icon; X `7Bif icon = chr(0), we plot the background, X otherwise plot the character based on priority`7D X var X lower:boolean; X begin X if (icon = chr(0)) or X ((base + altitude <`20 X`09 highest_priority(x,y,pl`5Bnow`5D.attrib_ex`5Bst_base`5D+myview,slot,map_ Vtype)) X`09 and (map_type <> map_background)) then fix_scenery(x,y) X else smg$put_chars(gwind,icon,y,x,,rendition); X end; X X procedure check_limits; X begin X if sx < 1 then sx := 1; X if sy < 1 then sy := 1; X if ex > maxhoriz then ex := maxhoriz; X if ey > maxvert then ey := maxvert; X end; X Xbegin X if human then X begin X if geo <> g_blip then smg$begin_display_update(gwind); X case geo of Xg_circle: X begin X sx := geo1 - geo4; X sy := geo2 - geo4; X ex := geo1 + geo4; X ey := geo2 + geo4; X check_limits; X for y := sy to ey do X for x := sx to ex do X begin X`09dist := distance(geo1,geo2,x,y); X`09if (dist <= geo4) and (dist >= geo3) then plot_icon; X end; X end; X Xg_rectangle: X begin X sx := geo1; X sy := geo2; X ex := geo3; X ey := geo4; X check_limits; X for y := sy to ey do X for x := sx to ex do plot_icon; X end; X Xg_line,g_blip: X begin X dist := distance(geo1,geo2,geo3,geo4); X if dist > 0 then X begin X`09dx := geo3 - geo1; X`09dy := geo4 - geo2; X`09for z := 0 to dist do X`09begin X`09 x := round(geo1 + z * dx / dist); X`09 y := round(geo2 + z * dy / dist); X`09 plot_icon; X`09 if geo = g_blip then fix_scenery(x,y); X`09end; X end; X end; X Xg_point: X begin X x := geo1; X y := geo2; X plot_icon; X end; X X end; X if geo <> g_blip then smg$end_display_update(gwind); X end; Xend; X Xprocedure clear_shot(x0,y0:integer; var x,y:integer; range:integer := 500); Xvar X dist,dx,dy,fg_slot:integer; X z:integer := 1; X ok:boolean := true; X s:string; Xbegin X dist := distance(x0,y0,x,y); X range := min(dist,range); X if range > 0 then X begin X dx := x - x0; X dy := y - y0; X while (z < range) and ok do X if foreground_found(round(x0 + z * dx / dist),round(y0 + z * dy / dist), X pl`5Bnow`5D.attrib_ex`5Bst_base`5D,pl`5Bnow`5D.attrib`5Bat_size`5D,fg_no Vrmal,fg_slot) then`20 X begin `20 X if (not fg.effect`5Bfg_slot`5D.walk_through) then ok := false X else z := z + 1; X end X else z := z + 1; X x := round(x0 + z * dx / dist); X y := round(y0 + z * dy / dist); X end X else X begin X range := 0; X x := x0; X y := y0; X end; Xend; X X`5Basynchronous`5D Xprocedure special_effect(geometry,geo1,geo2,x,y,x1,y1:integer; icon:char; X`09`09rendition:unsigned := 0); Xbegin X if human then X case geometry of Xg_circle: X begin X g_plot(g_line,x,y,x1,y1,0,5,icon,rendition); X g_plot(g_line,x,y,x1,y1,0,5,chr(0),rendition); X g_plot(geometry,x1,y1,geo1,geo2,0,5,icon,rendition); X g_plot(geometry,x1,y1,geo1,geo2,0,5,chr(0),rendition); X end; Xg_rectangle: X begin X g_plot(geometry,x1-geo1 div 2,y1-geo2 div 2, X`09`09`09 x1+geo1 div 2,y1+geo2 div 2,0,5,icon,rendition); X g_plot(geometry,x1-geo1 div 2,y1-geo2 div 2, X`09`09`09 x1+geo1 div 2,y1+geo2 div 2,0,5,chr(0),rendition); X end; Xg_point: X begin X g_plot(geometry,x1,y1,0,0,0,5,icon,rendition); X g_plot(geometry,x1,y1,0,0,0,5,chr(0),rendition); X end; Xg_blip: X g_plot(geometry,x,y,x1,y1,0,5,icon,rendition); Xg_line: X begin X g_plot(geometry,x,y,x1,y1,0,5,icon,rendition); X g_plot(geometry,x,y,x1,y1,0,5,chr(0),rendition); X end; X end; Xend; X Xend. $ CALL UNPACK SRMISC.PAS;1 1584194573 $ create 'f' X`5Binherit`20 X('srinit','srsys','srmisc','srother','srio','srmap','sys$library:starlet'), X environment('srmove')`5D X Xmodule srmove; X X`5BASYNCHRONOUS`5D FUNCTION lib$spawn ( X`09command_string : `5BCLASS_S`5D PACKED ARRAY `5B$l1..$u1:INTEGER`5D OF CHA VR := %IMMED 0; X`09input_file : `5BCLASS_S`5D PACKED ARRAY `5B$l2..$u2:INTEGER`5D OF CHAR := V %IMMED 0; X`09output_file : `5BCLASS_S`5D PACKED ARRAY `5B$l3..$u3:INTEGER`5D OF CHAR : V= %IMMED 0; X`09flags : UNSIGNED := %IMMED 0; X`09process_name : `5BCLASS_S`5D PACKED ARRAY `5B$l5..$u5:INTEGER`5D OF CHAR V := %IMMED 0; X`09VAR process_id : `5BVOLATILE`5D UNSIGNED := %IMMED 0; X`09%IMMED completion_status_address : $DEFPTR := %IMMED 0; X`09byte_integer_event_flag_num : $UBYTE := %IMMED 0; X`09%IMMED `5BUNBOUND, ASYNCHRONOUS`5D PROCEDURE AST_address := %IMMED 0; X`09%IMMED varying_AST_argument : `5BUNSAFE`5D INTEGER := %IMMED 0; X`09prompt_string : `5BCLASS_S`5D PACKED ARRAY `5B$l11..$u11:INTEGER`5D OF CH VAR := %IMMED 0; X`09cli : `5BCLASS_S`5D PACKED ARRAY `5B$l12..$u12:INTEGER`5D OF CHAR := %IMM VED 0) : INTEGER; EXTERNAL; X X`5BASYNCHRONOUS`5D FUNCTION lib$delete_file ( X`09filespec : `5BCLASS_S`5D PACKED ARRAY `5B$l1..$u1:INTEGER`5D OF CHAR; +-+-+-+-+-+-+-+- END OF PART 15 +-+-+-+-+-+-+-+-