home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
COMMANDS.E
< prev
next >
Wrap
Text File
|
1993-06-08
|
6KB
|
293 lines
-- commands.e
-- process user commands
global positive_int nchars
positive_int pen
type keycode(integer x) -- input keyboard code
return x >= -1 and x < 512
end type
keycode curcom
direction dir
type digit_char(integer x)
return x >= '0' and x <= '9'
end type
procedure echo(char com)
-- echo first char of new command
set_bk_color(WHITE)
set_color(BLUE)
position(CMD_LINE, CMD_POS)
puts(CRT, com)
puts(CRT, " ")
end procedure
procedure dircom(digit_char dir)
-- process direction change commands
nchars = 0
if dir != '9' then
echo(dir)
end if
if reptime[GUIDANCE] then
errbeep()
msg("GUIDANCE SYSTEM DAMAGED")
elsif dir = '1' then
exi = 3
eyi = 0
esym = esymr
elsif dir = '2' then
exi = 3
eyi = -1
esym = esymr
elsif dir = '3' then
exi = 0
eyi = -1
elsif dir = '4' then
exi = -3
eyi = -1
esym = esyml
elsif dir = '5' then
exi = -3
eyi = 0
esym = esyml
elsif dir = '6' then
exi = -3
eyi = 1
esym = esyml
elsif dir = '7' then
exi = 0
eyi = 1
elsif dir = '8' then
exi = 3
eyi = 1
esym = esymr
end if
end procedure
function docom(keycode com, keycode chr)
-- process commands
positive_int t
set_bk_color(WHITE)
set_color(BLUE)
if com = 'p' then -- phasor
if nchars = 0 then
echo(chr)
nchars = 1
elsif nchars = 1 then
position(CMD_LINE, CMD_POS+2)
pen = 100 * (chr - '0')
printf(CRT, "%s00", chr)
nchars = 2
elsif nchars = 2 then
position(CMD_LINE, CMD_POS+6)
printf(CRT, "%s.", chr)
dir = chr - '0'
nchars = 3
else
position(CMD_LINE, CMD_POS+8)
puts(CRT, chr)
if reptime[PHASORS] then
errbeep()
msg("PHASORS DAMAGED")
else
dir = dir + (chr - '0')/10
p_energy(-pen)
esetpt(dir)
weapon(W_PHASOR, pen)
end if
nchars = 0
end if
elsif com = 'w' then -- warp change
if nchars = 0 then
echo(chr)
nchars = 1
else
if chr < '6' then
position(CMD_LINE, CMD_POS+2)
puts(CRT, chr)
nchars = 0
if wlimit then
position(WARP_LINE, 8)
puts(CRT, chr)
setwarp(chr - '0')
else
errbeep()
msg("ALL ENGINES DAMAGED")
end if
end if
end if
elsif com = 't' then -- torpedo
if nchars = 0 then
echo(chr)
nchars = 1
elsif nchars = 1 then
position(CMD_LINE, CMD_POS+2)
printf(CRT, "%s.", chr)
dir = chr - '0'
nchars = 2
else
position(CMD_LINE, CMD_POS+4)
puts(CRT, chr)
dir = dir + (chr - '0')/10
if reptime[TORPEDOS] then
errbeep()
msg("TORPEDO LAUNCHER DAMAGED")
else
t = f[ENTERPRISE][F_TORP]
if t then
t = t - 1
f[ENTERPRISE][F_TORP] = t
ts = ts[2..length(ts)]
wtext()
esetpt(dir)
weapon(W_TORPEDO, 4000)
else
errbeep()
msg("OUT OF TORPEDOS")
end if
end if
nchars = 0
end if
elsif com = 'g' then -- galaxy scan
chr = ' '
echo(chr)
if scanon then
setg1()
else
if reptime[GALAXY_SENSORS] then
errbeep()
msg("SENSORS DAMAGED")
else
set_bk_color(BLUE)
set_color(WHITE)
BlankScreen(FALSE)
scanon = TRUE
for r = 1 to G_SIZE do
for c = 1 to G_SIZE do
gquad(r, c)
end for
end for
gtext()
dsyms()
gsbox(qrow, qcol)
set_bk_color(0)
end if
end if
nchars = 0
elsif com = 'a' then -- antimatter pod
if nchars = 0 then
echo(chr)
nchars = 1
elsif nchars = 1 then
position(CMD_LINE, CMD_POS+2)
printf(CRT, "%s.", chr)
dir = chr - '0'
nchars = 2
else
position(CMD_LINE, CMD_POS+4)
puts(CRT, chr)
dir = dir + (chr - '0')/10
if length(ps) > 0 then
ps = ps[2..length(ps)]
wtext()
esetpt(dir)
weapon(W_POD, 1500)
else
errbeep()
msg("OUT OF PODS")
end if
nchars = 0
end if
elsif com = '$' then -- shuttlecraft
echo(chr)
if not gal then
sounde(15, 20, 1)
if esym[1] = esymr[1] then
esym = SHUTTLE_R
else
esym = SHUTTLE_L
end if
esyml = SHUTTLE_L
esymr = SHUTTLE_R
otype[G_EN] = "SHUTTLE"
write_screen(f[ENTERPRISE][F_X], f[ENTERPRISE][F_Y], esym)
for r = 1 to NSYS do
if reptime[r] then
reptime[r] = 0
repair(r)
end if
end for
f[ENTERPRISE][F_DEFL] = 1
ds = repeat(DEFLECTOR, 1)
f[ENTERPRISE][F_TORP] = 0
f[ENTERPRISE][F_EN] = 5000
ts = ""
ps = ""
wtext()
puts(CRT, " ")
gal = TRUE
p_energy(0)
end if
elsif com = 'x' then -- cancel
chr = ' '
echo(chr)
nchars = 0
elsif com = '@' then -- pause
while get_key() != 'x' do
end while
-- need to adjust scheduler time to avoid
-- all tasks being ready to go ?
nchars = 0
else
return FALSE
end if
return TRUE
end function
without warning
global procedure t1keyb()
-- task 1: check the keyboard for input - perform the command
boolean x
positive_int tempchars
keycode chr
while TRUE do
chr = get_key()
if not char(chr) then
exit
end if
if chr >= '0' and chr <= '9' then
if nchars then
x = docom(curcom, chr)
else
dircom(chr)
end if
else
tempchars = nchars
nchars = 0
if docom(chr, chr) then
curcom = chr
else
nchars = tempchars
end if
end if
end while
end procedure
with warning