home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
DAMAGE.E
< prev
next >
Wrap
Text File
|
1993-06-08
|
8KB
|
347 lines
-- damage.e
-- compute effects of damage
global function tholian_target(valid_f_row r)
-- select target for tholian at row r
sequence flive
flive = {ENTERPRISE}
for i = fb1 to fnext-1 do
if i != r and f[i][F_TYPE] then
flive = flive & i
end if
end for
return flive[rand(length(flive))]
end function
procedure setrmt(valid_f_row newtarg)
-- set Romulan target
rtarg = newtarg
if rstat = TRUCE then
if rtarg = ENTERPRISE or f[rtarg][F_TYPE] = G_BS then
truce_broken = TRUE
sched(TASK_RSTAT, 2.5)
end if
end if
for row = fr1 to fnext-1 do
if f[row][F_TYPE] = G_RM then
f[row][F_TARG] = rtarg
end if
end for
end procedure
procedure setnt()
-- target is dead - pick new target
positive_int t -- object_type t or t = 0
valid_f_row targ
for row = fb1 to fnext-1 do
if f[row][F_TARG] = victim then
t = f[row][F_TYPE]
if t = G_BS then
f[row][F_FRATE] = 0
else
if t = G_TH then
targ = tholian_target(row)
else
targ = ENTERPRISE
end if
f[row][F_TARG] = targ
end if
end if
end for
if victim = rtarg then
rtarg = ENTERPRISE
end if
end procedure
global procedure repair(subsystem sys)
-- repair a subsystem
if sys = ENGINES then
wlimit = 5
set_bk_color(WHITE)
set_color(BLACK)
position(WARP_LINE, 8)
printf(CRT, "%d ", curwarp)
end if
ndmg = ndmg - 1
end procedure
procedure edmg(positive_atom blast)
-- Enterprise damage
subsystem sys
if blast > rand(256) * 60 then
sys = rand(NSYS)
if reptime[sys] = 0 then
sounde(11, 12, 5)
reptime[sys] = rand(81) + 9
if sys = GALAXY_SENSORS then
setg1()
end if
msg("")
if sys = ENGINES then
wlimit = rand(4) - 1
if curwarp > wlimit then
setwarp(wlimit)
msg("")
if wlimit = 0 then
puts(CRT, "ALL ")
end if
end if
end if
printf(CRT, "%s DAMAGED", {dtype[sys]})
wait[TASK_DAMAGE] = 2.0
ndmg = ndmg + 1
sched(TASK_DAMAGE, 2.0)
end if
end if
end procedure
global procedure drep()
-- damage report update
set_bk_color(GREEN)
set_color(BRIGHT_WHITE)
position(WARP_LINE, 50)
puts(CRT, repeat(' ', 13))
position(WARP_LINE+1, 50)
puts(CRT, repeat(' ', 13))
position(WARP_LINE, 51)
printf(CRT, "P%d T%d S%d", {reptime[PHASORS],
reptime[TORPEDOS],
reptime[GALAXY_SENSORS]})
position(CMD_LINE, 51)
printf(CRT, "G%d E%d", {reptime[GUIDANCE], reptime[ENGINES]})
if reptime[ENGINES] > 0 then
printf(CRT, ":%d", wlimit)
end if
end procedure
global procedure t9dmg()
-- task 9: damage countdown
if ndmg = 0 then
wait[TASK_DAMAGE] = 0
set_bk_color(WHITE)
position(WARP_LINE, 50)
puts(CRT, repeat(' ', 13))
position(WARP_LINE+1, 50)
puts(CRT, repeat(' ', 13))
else
for i = 1 to NSYS do
if reptime[i] then
reptime[i] = reptime[i] - 1
if reptime[i] = 0 then
sounde(6, 20, 1)
repair(i)
msg("")
printf(CRT, "%s REPAIRED", {dtype[i]})
end if
end if
end for
drep()
end if
end procedure
global function fstart(object_type t)
-- choose a starting point for f search
if t <= G_JM then
return fk1
elsif t = G_RM then
return fr1
elsif t = G_TH then
return ft1
elsif t = G_PL then
return ENTERPRISE + 1
else
return fb1
end if
end function
global function flook(h_coord x, v_coord y, boolean src_chk)
-- map (x,y) screen coordinate to f array row
-- src_chk is true when we just want to see if we are docking
extended_h_coord ix
extended_v_coord iy
positive_int t, len, xend
xend = x + length(esym) - 1
for i = ENTERPRISE + src_chk to fnext-1 do
ix = f[i][F_X]
iy = f[i][F_Y]
t = f[i][F_TYPE]
if t = G_BS then
if x >= ix and x < ix + length(BASE) and
y >= iy and y < iy + 2 then
return i
end if
if src_chk then
-- check other end of Enterprise too
-- (assumes base is reasonably wide)
if xend >= ix and xend < ix + length(BASE) and
y >= iy and y < iy + 2 then
return i
end if
end if
elsif t = G_PL then
if x >= ix and x < ix + length(PLANET_MIDDLE) and
y >= iy and y < iy + 3 then
return i
end if
if src_chk then
-- check other end of Enterprise too
-- (assumes planet is reasonably wide)
if xend >= ix and xend < ix + length(PLANET_MIDDLE) and
y >= iy and y < iy + 3 then
return i
end if
end if
elsif t then
if i = ENTERPRISE then
len = length(esym)
else
len = length(ship[t][1])
end if
if x >= ix and x < ix + len and y = iy then
return i
end if
if src_chk then
-- check other end too
if xend >= ix and xend < ix + len and y = iy then
return i
end if
end if
end if
end for
end function
procedure dead(valid_f_row row)
-- process a dead object
object_type t
h_coord x
v_coord y
pb_row pbx
positive_int len
t = f[row][F_TYPE]
if row = ENTERPRISE then
-- Enterprise destroyed !
f[ENTERPRISE][F_EN] = 0
p_energy(-1)
else
sounde(10,3,1)
urt = t
ur = 0
nobj[t] = nobj[t] - 1
g[qrow][qcol][urt] = g[qrow][qcol][urt] - 1
x = f[row][F_X]
y = f[row][F_Y]
set_bk_color(BLACK)
set_color(BRIGHT_WHITE)
if t >= G_PL then
pbx = f[row][F_PBX]
pb[pbx][P_EXIST] = DESTROYED
if scanon then
dsyms()
end if
if t = G_BS then
len = length(BASE)
for i = 0 to 1 do
display_screen(x, y + i, repeat('*', len))
wipeout = append(wipeout, {x, y + i, len})
end for
else
len = length(PLANET_MIDDLE)
for i = 0 to 2 do
display_screen(x, y + i, repeat('*', len))
wipeout = append(wipeout, {x, y + i, len})
end for
end if
else
len = length(ship[t][1])
display_screen(x, y, repeat('*', len))
wipeout = append(wipeout, {x, y, len})
if nkl() = 0 then
gameover = TRUE
end if
end if
f[row][F_TYPE] = 0 -- indicates dead guy
f[row][F_X] = HSIZE + 1
f[row][F_Y] = VSIZE + 1
setnt()
sched(TASK_UREM, 1.0)
sched(TASK_DEAD, 1.6)
end if
explosion_sound()
if scanon then
upg(qrow, qcol)
gsbox(qrow, qcol)
gtext()
end if
end procedure
global procedure dodmg(positive_atom blast, boolean wtorp)
-- damage a struck object
object_type t
positive_int d
positive_atom ven
msg("")
t = f[victim][F_TYPE]
if t = G_RM then
setrmt(shooter)
else
f[victim][F_TARG] = shooter
end if
if wtorp then
-- torpedo
d = f[victim][F_DEFL]
if d then
puts(CRT, "DEFLECTED")
f[victim][F_DEFL] = d-1
ds = repeat(DEFLECTOR, f[ENTERPRISE][F_DEFL])
wtext()
blast = 0
end if
end if
if blast then
if t <= G_TH then
printf(CRT, "%d UNIT HIT ON %s", {blast, otype[t]})
end if
ven = f[victim][F_EN]
if blast >= ven then
dead(victim)
else
ven = ven - blast
f[victim][F_EN] = ven
if t <= G_TH then
if victim = ENTERPRISE then
p_energy(0)
edmg(blast)
else
ur = ven
sched(TASK_UREM, 1.0)
end if
end if
end if
end if
end procedure
global constant ASPECT_RATIO = 3 -- roughly
global function bcalc(positive_atom energy)
-- calculate amount of phasor blast
atom xdiff, ydiff
xdiff = f[victim][F_X] - f[shooter][F_X]
ydiff = (f[victim][F_Y] - f[shooter][F_Y]) * ASPECT_RATIO
return 200 * energy / (5 + sqrt(xdiff * xdiff + ydiff * ydiff))
end function