home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
DISPLAY.E
< prev
next >
Wrap
Text File
|
1993-06-09
|
8KB
|
350 lines
-- display.e
-- graphics, sound and text display on screen
global sequence ship
global sequence ds -- Enterprise deflectors
global sequence ts -- Enterprise torpedos
global sequence ps -- Enterprise anti-matter pods (roughed in)
global function nkl()
-- number of Klingons left
return nobj[G_SK] + nobj[G_BK] + nobj[G_JM]
end function
type negative_atom(atom x)
return x <= 0
end type
global procedure p_energy(negative_atom delta)
-- print Enterprise energy
atom energy
energy = f[ENTERPRISE][F_EN] + delta
f[ENTERPRISE][F_EN] = energy
if energy < 0 then
energy = 0
gameover = TRUE
end if
position(WARP_LINE, 74)
set_bk_color(WHITE)
if energy < 5000 then
set_color(RED+BLINKING)
else
set_color(BLACK)
end if
printf(CRT, "%d ", floor(energy))
end procedure
global procedure msg(sequence text)
-- print a message on the bottom line
set_bk_color(WHITE)
set_color(RED)
position(MSG_LINE, 16)
puts(CRT, BLANK_LINE[1..50])
position(MSG_LINE, 16)
puts(CRT, text)
end procedure
global procedure show_warp()
-- show current speed (with warning)
set_bk_color(WHITE)
set_color(BLACK)
position(WARP_LINE, 3)
puts(CRT, "WARP:")
if curwarp > wlimit then
set_color(RED+BLINKING)
end if
printf(CRT, "%d", curwarp)
end procedure
constant warp_time = {0, 20, 4.5, 1.5, .67, .25}
global procedure setwarp(warp new)
-- establish a new warp speed for the Enterprise
if new != curwarp then
wait[TASK_EMOVE] = warp_time[new+1]
eat[TASK_EMOVE] = (5-new)/20 + 0.05
sched(TASK_EMOVE, wait[TASK_EMOVE])
curwarp = new
show_warp()
end if
end procedure
global procedure gtext()
-- print text portion of galaxy scan
set_bk_color(BLUE)
position(1, 36)
set_color(LIGHT_RED)
puts(CRT, "C ")
set_color(BROWN)
puts(CRT, "P ")
set_color(YELLOW)
puts(CRT, "B")
set_color(WHITE)
position(2, 7)
for i = 1 to 7 do
printf(CRT, "%8d", i)
end for
for i = 1 to 7 do
position(2*i + 1, 9)
printf(CRT, "%d.", i)
end for
position(17, 35)
set_color(BRIGHT_WHITE)
printf(CRT, "C: %d ", nkl())
position(18,22)
set_color(WHITE)
printf(CRT, "Planets: %d BASIC: %d", {nobj[G_PL], nobj[G_RM]})
if rstat = TRUCE then
puts(CRT, " TRUCE ")
elsif rstat = HOSTILE then
puts(CRT, " HOSTILE ")
else
puts(CRT, " CLOAKING")
end if
position(19,22)
printf(CRT, "Bases: %d Fortran: %d ", {nobj[G_BS], nobj[G_TH]})
end procedure
function g_screen_pos(g_index qrow, g_index qcol)
-- compute position on screen to display a galaxy scan quadrant
return {4 + qcol * 8, qrow * 2 + 1}
end function
global procedure gquad(g_index qrow, g_index qcol)
-- print one galaxy scan quadrant
positive_int nk, np, nb
sequence quad_info
screen_pos gpos
gpos = g_screen_pos(qrow, qcol)
position(gpos[2], gpos[1])
quad_info = g[qrow][qcol]
if quad_info[1] then
nk = quad_info[G_SK] + quad_info[G_BK] + quad_info[G_JM]
np = quad_info[G_PL]
nb = quad_info[G_BS]
set_color(LIGHT_RED)
printf(CRT, "%d ", nk)
set_color(BROWN)
printf(CRT, "%d ", np)
set_color(YELLOW)
printf(CRT, "%d", nb)
set_color(WHITE)
else
puts(CRT, "*****")
end if
end procedure
global procedure upg(g_index qrow, g_index qcol)
-- update galaxy scan quadrant
if scanon then
set_bk_color(BLUE)
set_color(WHITE)
gquad(qrow, qcol)
end if
end procedure
sequence prev_box
prev_box = {}
global procedure gsbox(g_index qrow, g_index qcol)
-- indicate current quadrant on galaxy scan
screen_pos gpos
if scanon then
set_bk_color(BLUE)
if length(prev_box) = 2 then
-- clear the previous "box" (could be gone already)
position(prev_box[2], prev_box[1]-1)
puts(CRT, ' ')
position(prev_box[2], prev_box[1]+5)
puts(CRT, ' ')
end if
set_color(WHITE)
gquad(qrow, qcol)
gpos = g_screen_pos(qrow, qcol)
position(gpos[2], gpos[1]-1)
set_color(BRIGHT_WHITE)
puts(CRT, '[')
position(gpos[2], gpos[1]+5)
puts(CRT, ']')
prev_box = gpos
end if
end procedure
global procedure dsyms()
-- print docking symbols for planets and bases
screen_pos gpos
return -- for now
for i = 1 to PROWS do
gpos = g_screen_pos(pb[i][P_QR], pb[i][P_QC])
position(gpos[2], gpos[1])
puts(CRT, ' ')
end for
for i = 1 to PROWS do
if pb[i][P_EXIST] = DOCKED_WITH then
--- TO BE CONTINUED
end if
end for
for i = 1 to PROWS do
if pb[i][P_EXIST] = NEVER_DOCKED then
end if
end for
end procedure
global procedure wtext()
-- print torpedos, pods, deflectors in text window
set_bk_color(WHITE)
set_color(BLACK)
position(WARP_LINE, 34)
printf(CRT, "%s %s ", {ts, ds, ps}) -- don't show pods yet
end procedure
global procedure stext()
-- print text window info
position(QUAD_LINE, 1)
set_bk_color(CYAN)
set_color(MAGENTA)
printf(CRT,
"--------------------------------- QUADRANT %d.%d ---------------------------------"
,{qrow, qcol})
set_bk_color(WHITE)
set_color(BLACK)
show_warp()
wtext()
position(WARP_LINE, 67)
printf(CRT, "ENERGY:%d ", floor(f[ENTERPRISE][F_EN]))
position(CMD_LINE, 3)
puts(CRT, "COMMAND(1-8 w p t g $ @ x): ")
end procedure
procedure pxx(valid_f_row row)
-- print a base or planet
h_coord x
v_coord y
x = f[row][F_X]
y = f[row][F_Y]
if f[row][F_TYPE] = G_PL then
write_screen(x, y, PLANET_TOP)
write_screen(x, y+1, PLANET_MIDDLE)
write_screen(x, y+2, PLANET_BOTTOM)
else
write_screen(x, y, BASE)
write_screen(x, y+1, BASE)
end if
end procedure
procedure p_ship(valid_f_row row)
-- reprint a ship to get color
h_coord x
v_coord y
object_type t
sequence shape
x = f[row][F_X]
y = f[row][F_Y]
t = f[row][F_TYPE]
shape = read_screen({x, length(ship[t][1])}, y)
write_screen(x, y, shape)
end procedure
procedure refresh_obj()
-- reprint objects with correct color after a galaxy scan
for i = 1 to fnext-1 do
if f[i][F_TYPE] = G_BS or f[i][F_TYPE] = G_PL then
pxx(i)
elsif f[i][F_TYPE] then
p_ship(i)
end if
end for
end procedure
global procedure setg1()
-- end display of galaxy scan
if scanon then
scanon = FALSE
ShowScreen()
refresh_obj()
end if
end procedure
constant PBP0 = 4
global procedure pobj()
-- print objects in a new quadrant
h_coord x
v_coord y
sequence c
positive_int len, pbi
object_type t
set_bk_color(BLACK)
set_color(WHITE)
BlankScreen(TRUE)
-- print stars
for i = 1 to 15 do
write_screen(rand(HSIZE), rand(VSIZE), STAR)
end for
-- print planets and bases
pbi = PBP0 - 1
for row = 2 to fr1 - 1 do
if row = fb1 then
pbi = 0
end if
while TRUE do
pbi = pbi + 1
if pb[pbi][P_EXIST] != DESTROYED then
if pb[pbi][P_QR] = qrow then
if pb[pbi][P_QC] = qcol then
x = pb[pbi][P_X]
y = pb[pbi][P_Y]
f[row][F_X] = x
f[row][F_Y] = y
f[row][F_PBX] = pbi
exit
end if
end if
end if
end while
pxx(row)
end for
-- print ships
for row = fr1 to fnext-1 do
len = length(ship[f[row][F_TYPE]][1])
while TRUE do
-- look for an empty place to put the ship
x = rand(HSIZE - len) + 1
y = rand(VSIZE - 2) + 1
c = read_screen({x, len}, y)
if not find(FALSE, c = ' ' or c = STAR) then
exit
end if
end while
f[row][F_UNDER] = c
f[row][F_X] = x
f[row][F_Y] = y
t = f[row][F_TYPE]
if x < f[ENTERPRISE][F_X] then
c = ship[t][2]
else
c = ship[t][1]
end if
write_screen(x, y, c)
end for
end procedure