home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d9xx
/
d950
/
bbdoors.lha
/
BBDoors
/
BBDoors65.lha
/
rexxDoors
/
StarTrek.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-08-24
|
36KB
|
1,462 lines
/* STAR TREK - THE FINAL FRONTIER - Online BBS Game
Written By Steve Berry
Rev A - 4/24/87 IBM 370
Rev B - 5/21/88
modified to run on Amiga
Rev C - 10/23/91
modified to run from CLI or BBBBS
also updated enemy from Klingons to Romulans
Mods for Atredes by Bob Hassel and Michael Cox
ANSI version & other enhancements by Michael Cox
BBBBS mods by Richard Lee Stockton
3 bugs fixed August 24,1993 by Charles Johnston
(1) Saved games would not survive a reload - FIXED
(2) After torpedos were used up one could continue firing them - FIXED
(3) After phasers were used up one could continue firing them -FIXED
*/
CALL TIME('R')
SIGNAL ON BREAK_C
bbspath=GETCLIP('BBS_path')
PARSE ARG UName . . . secs .
IF secs='' THEN secs=3600
gamepath=''
IF UName~='' & bbspath~='' THEN gamepath=bbspath'rexxDoors/Data/'
maxtime=5000
justcleared='true'
highest=0
highname=0
HOM='H'
RESET=''
POS='0H'
CLS='H'
CLR=''
CLL=''
WHITEONBLUE='
'
REDONBLUE='
'
YELLOWONBLUE='
'
CYANONBLACK='
'
YELLOWONBLACK='
'
MAGENTAONBLACK='
'
BLUEONBLACK='
'
REDONYELLOW='
'
WHITE='
'
RED='
'
YELLOW='
'
BLACK='
'
GREEN='
'
CYAN='
'
MAGENTA='
'
BLUE='
'
IF ADDRESS()~='BAUD' THEN
DO
BLUE=GREEN
WHITEONBLUE='
'
REDONBLUE='
'
YELLOWONBLUE='
'
END
call time 'R' /* reset timer */
do i=1 to 10
highscore.i=0
highname.i=' '
end
stardate=time('E')
junk=randu(time('S'))
blanks=' '
call old_highest
CALL mess CLS
CALL mess BLUE||' Welcome to STARTREK!'
CALL mess
CALL mess YELLOW||' TOP TEN PLAYERS'
CALL mess WHITE
do i=1 to 10
if highscore.i=0 then iterate
CALL mess substr(blanks,1,20) highname.i substr(blanks,1,30-length(highname.i)) RIGHT(highscore.i,6)
end
CALL mess CYAN
CALL mess ' (You need an ANSI-compatible terminal to play this game.)'
CALL mess
OPTIONS PROMPT ' Do you need instructions (y/N)? '
PULL res
if res='Y' then
call instructions
else
do /* Anyone ever heard of BRACKETS? */
CALL mess
CALL mess 'You can get the instructions at any time by entering the word HELP.'
OPTIONS PROMPT 'Hit [RETURN] to continue: '
PULL res
end
CALL mess CLS
CALL mess
CALL mess
OPTIONS PROMPT 'Load and play an old game (y/N)? '
PULL fn
CALL mess CLS
mission=1
/* Are we playing an OLD Game? */
if fn='Y' then
call load_old_game fn
else
newmission:
CALL mess 'Please stand by... universe under construction'
select
when mission=1 then call init_variables_1
when mission=2 then call init_variables_2
when mission=3 then call init_variables_3
when mission=4 then call init_variables_4
when mission=5 then call init_variables_5
when mission=6 then call init_variables_6
when mission=7 then call init_variables_7
when mission=8 then call init_variables_8
when mission=9 then call init_variables_9
when mission=10 then call init_variables_10
/* otherwise */
end
/* ********** */
/* Main do loop */
/* ************ */
main: /* added this function name so 'load_old_game:' could signal to it*/
starttime=stardate
CALL mess CLS
do until energy=0
CALL checkBBS()
CALL mess HOM
call print_quadrent x,y,ex,ey
t0=time('R')
/* get user input and parse the commands */
if stardate - starttime > maxtime then call toolong
OPTIONS PROMPT 'Your command, Captain? '
PULL instring
rc=parse_command(instring)
/* process the commands */
if rc=0 then do
do loop=1 to 3
if arg1.loop='' then leave
call process_command arg1.loop,arg2.loop
if alive='no' | energy <= 0 then leave
end
end
else CALL mess "Command not understood. Enter HELP for reminder."
/* Check for illegal input */
if missstat='completed' then do
CALL mess CLS
CALL mess
CALL mess ' CONGRATULATIONS !!! You have completed the mission!'
CALL mess
exit 0
end
/* Did player kill himself? */
If alive='no' | energy <= 0 then do
CALL mess CLS
CALL mess
CALL mess
CALL mess
CALL mess
CALL mess ' Suicide is not in the BEST interests of the FEDERATION.'
CALL mess
CALL mess ' But you did get 'points' points.'
CALL mess
CALL mess
CALL mess
CALL mess 'Game over.'
CALL mess
CALL mess
exit
end
/* Time for a little wear and tear on the enterprize */
call wear_and_tear
/* Is the Enterprize DEAD in Space? */
If alive='no' then do
CALL mess CLS
CALL mess
CALL mess
CALL mess
CALL mess
CALL mess ' Sorry but you let the Enterprise deteriorate into '
CALL mess ' into a rusting hunk of space debris.'
CALL mess
CALL mess ' But you did get 'points' points.'
CALL mess
CALL mess
CALL mess
CALL mess 'Game over.'
CALL mess
CALL mess
exit
end
/* Ok. now it's the Bad guy's turn */
/* now call mission specific routine */
/* for bad guy routine and points awarded */
select
when mission=1 then call mission1
when mission=2 then call mission2
when mission=3 then call mission3
when mission=4 then call mission4
when mission=5 then call mission5
when mission=6 then call mission6
when mission=7 then call mission7
when mission=8 then call mission8
when mission=9 then call mission9
when mission=10 then call mission10
end
/* Is the Enterprize KILLED? KRUSHED? DESTROYED? */
If alive='no' then do
CALL mess
CALL mess
CALL mess
CALL mess
CALL mess ' Sorry but you let your crew and the Federation down.'
CALL mess ' Perhaps you should consider another career.'
CALL mess
CALL mess ' But you did get 'points' points.'
CALL mess
CALL mess
CALL mess
CALL mess 'Game over.'
CALL mess
CALL mess
exit
end
/* end of the loop - now go print the screen */
end
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE SECTION */
/* ********************************************** */
/* ********************************************** */
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE LOAD_OLD_GAME */
/* PASSED VALUES - fn */
/* ********************************************** */
/* ********************************************** */
load_old_game:
bstr=' |o| * <->(B))\_ # '
missstat='not yet'
CALL mess 'Loading your previously saved game...'
/* get variables */
if ~Open(fnn,gamepath||UName,'R') then
do
CALL mess "Can't find a saved game for you! Exiting STARTREK."
exit
end
inn=Readln(fnn)
parse var inn stardate mission energy points x y ex ey shields klshields docked kltot
inn=Readln(fnn)
parse var inn status.0 status.1 status.2 status.3 status.4 status.5
/* start interval timer */
stardate=stardate + time('E')
/* Load galactic map */
do l=0 to 9
inn1=Readln(fnn)
parse var inn1 map.l.0 map.l.1 map.l.2 map.l.3 map.l.4 map.l.5 map.l.6 map.l.7 map.l.8 map.l.9
end
do l=0 to 9
inn1=Readln(fnn)
parse var inn1 quad.l.0 quad.l.1 quad.l.2 quad.l.3 quad.l.4 quad.l.5 quad.l.6 quad.l.7 quad.l.8 quad.l.9
end
alive='yes'
junk=Close(fnn)
signal main /* bug fix so old game is loaded properly and not overwritten as fresh game*/
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE INIT_VARIABLES_1 */
/* PASSED VALUES - none */
/* ********************************************** */
/* ********************************************** */
init_variables_1:
bstr=' |o| * <->(B))\_ # '
alive='yes'
energy=1000000
x=0
y=0
points=0
mission=1
shields='down'
kltot=0
missstat='not yet'
do a=0 to 9
do b=0 to 9
map.a.b=random(0,1) * 100 + random(0,1)*10 + random(0,9)
if map.a.b > 99 then kltot=kltot + 1
end
end
klshields=5000
status.0=0
status.1=0
status.2=0
status.3=0
status.4=0
status.5=0
ex=5
ey=4
newscreen:
/* initialize quadrent matrix */
enemies=map.x.y%100
bases=(map.x.y - enemies * 100)%10
stars=map.x.y - enemies * 100 - bases * 10
/* zero quad matrix */
do i=0 to 9
do j=0 to 9
quad.i.j=0
end
end
/* locate the enterprize */
quad.ex.ey=1
/* put the stars in */
do a=0 to stars - 1
rx=random(0,9)
ry=random(0,9)
if quad.rx.ry=0 then quad.rx.ry=2
else a=a-1
end
/* enemies? */
if enemies ~= 0 then do
do a=0 to enemies - 1
rx=random(0,9)
ry=random(0,9)
if quad.rx.ry=0 then quad.rx.ry=3
else a=a-1
end
end
/* bases ? */
if bases ~= 0 then do
do a=0 to bases - 1
rx=random(0,9)
ry=random(0,9)
if quad.rx.ry=0 then quad.rx.ry=4
else a=a-1
end
end
docked='no'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE PRINT_QUARDENT */
/* PASSED VALUES - x, y ,ex ,ey */
/* ********************************************** */
/* ********************************************** */
print_quadrent:
call dock? /* check to see if the Enterprize is docked */
stardate=stardate + time('E')
if status.5 < 1 | docked='yes' then astr=bstr
else astr='XXX|o|XXXXXXXXXXXXXXX'
CALL mess RESET
do i0=0 to 9
line=' '|| WHITEONBLUE
do j0=0 to 9
select
when quad.i0.j0=0 then line=line || substr(astr,quad.i0.j0 * 3 + 1,3)
when quad.i0.j0=1 then line=line || WHITE || substr(astr,quad.i0.j0 * 3 + 1,3)
when quad.i0.j0=2 then line=line || YELLOW || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
when quad.i0.j0=3 then line=line || RED || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
when quad.i0.j0=4 then line=line || GREEN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
when quad.i0.j0=5 then line=line || CYAN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
when quad.i0.j0=6 then line=line || MAGENTA || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
otherwise nop
end
end
select
when i0=0 then line=line || YELLOWONBLACK ||' Stardate: 'stardate' '
when i0=1 then
do
if energy > 10000 then line=line || YELLOWONBLACK ||' Energy: 'energy' '
else
line=line || YELLOWONBLACK ||' Energy: '||REDONYELLOW||energy' '
end
when i0=2 then line=line || YELLOWONBLACK ||' Quadrant:' y',' x' '
when i0=3 then line=line || YELLOWONBLACK ||' Sector: ' ex',' ey ' '
when i0=4 & docked='yes' then line=line || YELLOWONBLACK || ' Condition: '||GREEN||'DOCKED'
when i0=4 & map.x.y > 99 & docked='no' then line=line || YELLOWONBLACK ||' Condition: '||RED||'RED '
when i0=4 & map.x.y < 100 & docked='no' then line=line || YELLOWONBLACK || ' Condition: '||GREEN||'Green '
when i0=5 then
do
if shields='UP' then line=line || YELLOWONBLACK ||' Shields:' CYANONBLACK||'Up '
else
line=line || YELLOWONBLACK ||' Shields:' MAGENTAONBLACK||'Down '
end
when i0=6 then line=line || YELLOWONBLACK ||' Romulans left:' kltot' '
when i0=7 then line=line || YELLOWONBLACK ||' Points:' points' '
otherwise line=line || RESET||' '
end
if (line ~= oldline.i0)|(justcleared='true') then CALL mess line; else CALL mess ""
oldline.i0=line
end
CALL mess RESET
call clearbottom
justcleared='false'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE PARSE_COMMAND */
/* PASSED VALUES - INSTRING */
/* ********************************************** */
/* ********************************************** */
parse_command:
parse arg arg1.1 arg2.1 arg1.2 arg2.2 arg1.3 arg2.3 .
/* string for recognition of commands */
comstr='COMFIRTORPHADISMAPSHOSENLONRAILOWSHIWARIMPLAUPROCAPLOGTRASHIDOWSAVGAMINSQUIDRISTAHELPOWSCASEE'
/* Check for no input */
if arg1.1='' then return -1
if arg1.1='#' then
do
exit
end
/* trash all but the first three letters of each command */
do i=1 to 3
arg1.i=left(arg1.i,3)
arg2.i=left(arg2.i,3)
if arg1.i='' then leave
do j=0 to 30
if arg1.i=substr(comstr,j * 3 + 1,3) then leave
end
if j > 30 then return -1
if arg2.i='' then return 0
do j=0 to 30
if arg2.i=substr(comstr,j * 3 + 1,3) then leave
end
if j > 30 then return -1
end
return 0
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE PROCESS_COMMAND */
/* PASSED VALUES - word1 , word2 */
/* ********************************************** */
/* ********************************************** */
process_command:
arg word1,word2
select
when word1='FIR' then call weapon_control word2
when word1='COM' then call compute word2
when word2='SEN' then call sensors word1
when word2='SCA' then call sensors word1
when word1='SEN' then call sensors word1
when word1='SCA' then call sensors word1
when word2='SHI' then call shield_control word1
when word2='DRI' then call engine_control word1
when word2='POW' then call engine_control word1
when word1='INS' then call instructions
when word2='INS' then call instructions
when word1='HEL' then call instructions
when word1='SAV' then call save_game word2
when word1='DIS' then call display_info word2
when word1='SEE' then call display_info word2
when word1='STA' then call display_info word2
when word1='LAU' then call launch_probe word2
when word1='CAP' then call captains_log word2
when word1='QUI' then
do
call new_highest
CALL mess 'Exiting STARTREK... play again soon!'
exit
end
otherwise CALL mess 'Sorry - not understood'
end
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE WEAPON_CONTROL */
/* PASSED VALUES - weapon */
/* ********************************************** */
/* ********************************************** */
weapon_control:
arg weapon
if (weapon ~= 'PHA') & (weapon ~= 'TOR') then do
CALL mess
CALL mess 'Weapon does not exist.'
return
end
/* Phasers section */
if weapon='PHA' then do
if map.x.y < 100 then do
CALL mess 'No targets to fire on. '
return
end
/* compute the distance between Enterprize and Romulan */
kx=0
ky=0
do i=0 to 9
do j=0 to 9
if quad.i.j=3 then do
kx=i
ky=j
end
end
end
/* compute the distance (rough approximation) */
distance=((ex-kx)**2 + (ey-ky)**2)
do i=1 to 13 by .5
t0=distance/i
if t0 < i then leave
end
distance=i
energy=energy - 5000
hit=(1 - status.1)* 5000 - (distance * 500)
if hit < 0 then hit=0
klshields=klshields - hit
if hit=0 then
do /* Bug fix for when out of phasers, old code let keep shooting endlessly*/
call mess 'Sorry Captain you have exhausted the Phaser Banks!'
call delay(100)
return
end
CALL mess
CALL mess 'PHASERS LOCKED ON TARGET '
CALL mess 'Phasers fired -'
if klshields <= 0 then do
CALL mess 'ROMULAN HIT WITH' hit ' units of energy'
CALL mess '*** ROMULAN DESTROYED! ***'
points=points + 50
klshields=5000
quad.kx.ky=0
map.x.y=map.x.y - 100
kltot=kltot - 1
end
else
do
CALL mess 'KILINGON HIT WITH' hit ' units of energy'
CALL mess 'The Romulan ship is still alive, Captain!'
end
end /* end of phaser routine */
else do
/* Torpedo routine */
if weapon='TOR' & status.2 >.9 then
do /* bug fix for when out of torpedos, old code let you shoot endlessly*/
call mess 'Sorry Captain we are all out of torpedos!'
call delay(100)
return
end
CALL mess 'Torpedos ready Captain.'
do until c=0
OPTIONS PROMPT 'X vector, Captain (-1=left, 0=middle, 1=right)? '
PULL dy
OPTIONS PROMPT 'Y vector, Captain (-1=up, 0=middle, 1=down)? '
PULL dx
if dx='' then dx=0
if dy='' then dy=0
if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
else
do
c=1
CALL mess 'Invalid vectors. Valid range for each is -1 to 1.'
end
end
tx=ex
ty=ey
do lp=0 to 9
t0=tx+dx
t1=ty+dy
if (t0 < 0) | (t0 > 9) | (t1 < 0) | (t1 > 9) then do
CALL mess ' Torpedo missed!'
return
end
space=quad.t0.t1
if space ~= 0 then select
when space=2 then do
CALL mess '*** Torpedo hits a STAR ***'
return
end
when space=3 then do
CALL mess '*** Torpedo hits a ROMULAN ***'
CALL mess '*** ROMULAN DESTROYED ***'
CALL mess 'Good shot, Captain!'
quad.t0.t1=0
map.x.y=map.x.y - 100
kltot=kltot - 1
points=points + 100
return
end
when space=4 then do
CALL mess '*** Torpedo hits a BASE ***'
CALL mess 'COURT MARTIAL IS IMMINENT!'
return
end
otherwise do
CALL mess '*** Torpedo hits the DEATHSTAR ***'
CALL mess 'Torpedo seems to have no effect!'
return
end
end
quad.t0.t1=6
tx=t0
ty=t1
CALL mess HOM
call print_quadrent
quad.tx.ty=0
end
end /* end of Torpedo routine */
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE WEAR_AND_TEAR */
/* PASSED VALUES - none */
/* ********************************************** */
/* ********************************************** */
wear_and_tear:
pick=random(0,5)
if docked='yes' then
if status.pick=0 then return
else status.pick=status.pick - .1
else if status.pick < 1 then do
status.pick=status.pick + .1
if status.pick=1 then do
CALL mess 'Status report sir -'
select
when pick=0 then CALL mess 'Computer is in need of repair!'
when pick=1 then CALL mess 'Phasers are in need of repair!'
when pick=2 then CALL mess 'Torpedos are in need of repair!'
when pick=3 then CALL mess 'Warp Drive is in need of repair!'
when pick=4 then CALL mess 'Impulse Drive is in need of repair!'
when pick=5 then CALL mess 'Sensors are out of order!'
end
if status.3 > .9 & status.4 > .9 then do
CALL mess 'Captain sir ... we seem to be dead in space!'
CALL mess 'The warp drive and the impulse drive are out!'
alive='no'
end
end
end
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE engine_control */
/* PASSED VALUES - power */
/* ********************************************** */
/* ********************************************** */
engine_control:
arg power
CALL mess 'Scotty here captain.'
if power='WAR' then do
if status.3 > 1.2 then
do
CALL mess 'Sorry Captain, warp drive is out of commission!'
return
end
OPTIONS PROMPT 'What Warp factor Captain? '
PULL warp
if warp='' then warp=0
do forever
OPTIONS PROMPT 'Destination X vector (0-9)? '
PULL dy
OPTIONS PROMPT 'Destination Y vector (0-9)? '
PULL dx
if datatype(dx,'W') & datatype(dy,'W') then leave
CALL mess 'Where?'
end
if x > 9 | y < 0 | x < 0 | y > 9 then do
energy=energy - 5000
CALL mess 'Captain, the warp drive is in a bad way'
CALL mess 'and we are losing energy fast!'
end
/* if warp drive damaged degrade efficiency of energy consumption */
energy=energy - ((((dx-x)**2 + (dy-y)**2)/2.5)*1000+status.3*5000)
if dx > 9 | dy < 0 | dx < 0 | dy > 9 then do
CALL mess
CALL mess 'Warping out of the galaxy is not a good idea. Range 0-9 please.'
CALL mess
if shields='down' then do
CALL mess ' SHIELDS are DOWN --- the ENTERPRISE is caught, in the void of intergalatic space'
CALL mess ' Damage control report - WARP drive damaged, Impulse drive damaged, sensors out!'
status.3=status.3 + 1
status.4=status.4 + 1
status.5=1.1
end
else energy=energy - 5000
end
x=dx
y=dy
if x > -1 & x < 10 & y > -1 & y < 10 then call newscreen
end
else
do
if power ~= 'IMP' | status.4 > .9 then do
CALL mess 'Sorry Captain, impulse power is out of commission!'
return
end
else
do
CALL mess 'Aye Captain - Impulse power it is'
OPTIONS PROMPT 'What factor, Captain? '
do forever
PULL factor
if datatype(factor,'W') then leave
CALL mess 'Whats that, Captain? '
end
if factor <= 0 & num='yes' then return
do until c=0
OPTIONS PROMPT ' X vector (-1=left, 0=middle, 1=right)? '
PULL dy
OPTIONS PROMPT ' Y vector (-1=up, 0=middle, 1=down)? '
PULL dx
if dx='' then dx=0
if dy='' then dy=0
if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
else
do
c=1
CALL mess 'Invalid vectors - valid range for each is -1 to 1.'
end
end
do i=0 to factor - 1
if ((ex+dx) < 0) | ((ex+dx) > 9) | ((ey+dy) < 0) |((ey+dy) > 9) then
do
CALL mess ' You have to use the Warp drive to exit the quadrant.'
return
end
t0=ex+dx
t1=ey+dy
space=quad.t0.t1
if space ~= 0 then select
when space=2 then do
CALL mess '*** COLLISION with STAR ***'
alive='no'
end
when space=3 then do
CALL mess '*** COLLISION with ROMULAN ***'
alive='no'
end
when space=4 then do
CALL mess '*** COLLISION with BASE ***'
alive='no'
end
otherwise do
CALL mess '*** SWALLOWED BY THE DEATHSTAR ***'
alive='no'
end
end
quad.ex.ey=0
quad.t0.t1=1
ex=t0
ey=t1
if alive='yes' then do
CALL mess HOM
call print_quadrent
end
end
end
end
/* Got to check to see if Enterprize is docked */
dock?:
docked='no'
do i1=-1 to 1
do j1=-1 to 1
if i1+ex > -1 & i1+ex < 10 & j1+ey > -1 & j1+ey < 10 then do
ta=i1+ex
tb=j1+ey
if quad.ta.tb=4 then do
docked='yes'
t=status.0 + status.1 + status.2 + status.3 + status.4 + status.5
stardate=stardate + t
status.0=0
status.1=0
status.2=0
status.3=0
status.4=0
status.5=0
end
end
end
end
if kltot=0 then missstat='completed'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE SAVE_GAME */
/* PASSED VALUES - filename */
/* ********************************************** */
/* ********************************************** */
save_game:
missstat='not yet'
/* save variables */
if ~Open(fnn,gamepath||UName,'W') then do
CALL mess '***Open return code=' rc 'on 'bbspath'rexxDoors/Data/'||UName
CALL mess 'File may be in use, or is unable to be opened. Try again.'
return
end
CALL mess 'Storing your game...'
if Writeln(fnn,stardate mission energy points x y ex ey shields klshields docked kltot) < 1 then
do
exit
end
if Writeln(fnn, status.0 status.1 status.2 status.3 status.4 status.5) < 1 then
do
exit
end
/* Save galactic map */
do l=0 to 9
if Writeln(fnn,map.l.0 map.l.1 map.l.2 map.l.3 map.l.4 map.l.5 map.l.6 map.l.7 map.l.8 map.l.9) < 1 then
do
exit
end
end
do l=0 to 9
if Writeln(fnn,quad.l.0 quad.l.1 quad.l.2 quad.l.3 quad.l.4 quad.l.5 quad.l.6 quad.l.7 quad.l.8 quad.l.9) < 1 then
do
exit
end
end
if ~Close(fnn) then
do
exit
end
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE SENSORS */
/* PASSED VALUES - type */
/* ********************************************** */
/* ********************************************** */
sensors:
arg type
if status.5 < 1.1 then do
do i=-1 to 1
CALL mess '-------------------'
line=': '
do j=-1 to 1
t0=x+i
t1=y+j
if t0 < 0 | t0 > 9 | t1 < 0 | t1 > 9 then line=line || 'XXX :'
else
do
if map.t0.t1 < 100 & map.t0.t1 > 9 then line=line || ' '
if map.t0.t1 < 10 then line=line || ' '
line=line || map.t0.t1 || ' :'
end
end
CALL mess line
end
end
else
if status.5 > 1 then do
CALL mess ' Long-range sensors are out, captain!'
CALL mess
end
CALL mess '-------------------'
CALL mess
OPTIONS PROMPT 'Hit RETURN to resume: '
PULL res
call clearbottom
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE SHIELD_CONTROL */
/* PASSED VALUES - direction */
/* ********************************************** */
/* ********************************************** */
shield_control:
arg direction
if direction='RAI' then
if shields='UP' then do
CALL mess 'Shields are already up.'
end
else
do
shields='UP'
CALL mess 'Shields up, Captain.'
energy=energy - 3000
end
else
if direction='LOW' then
if shields='down' then do
CALL mess 'Shields are already down.'
end
else
do
shields='down'
CALL mess 'Shields down, Captain.'
energy=energy + 3000
end
else
do
CALL mess ' I am confused by that order, Captain.'
return
end
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE DISPLAY_INFO */
/* PASSED VALUES - what */
/* ********************************************** */
/* ********************************************** */
display_info:
arg what
CALL mess CLS
CALL mess
CALL mess ' Status report for Enterprise - Stardate ' stardate
CALL mess ' ----------------------------------'
c=100 - status.0*100
CALL mess ' Computer status ' c'%'
CALL mess ' ----------------------------------'
c=100 - status.1*100
CALL mess ' Phasers status ' c'%'
CALL mess ' ----------------------------------'
c=100 - status.2*100
CALL mess ' Torpedos status ' c'%'
CALL mess ' ----------------------------------'
c=100 - status.3*100
CALL mess ' Warp drive status ' c'%'
CALL mess ' ----------------------------------'
c=100 - status.4*100
CALL mess ' Impulse drive status ' c'%'
CALL mess ' ----------------------------------'
c=100 - status.5*100
CALL mess ' Sensors status ' c'%'
CALL mess ' ----------------------------------'
OPTIONS PROMPT 'Hit RETURN to resume: '
PULL res
CALL mess CLS
justcleared='true'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE INSTRUCTIONS */
/* PASSED VALUES - none */
/* ********************************************** */
/* ********************************************** */
instructions:
CALL mess CLS
CALL mess 'Welcome to STARTREK.'
CALL mess
CALL mess 'This version of STARTREK is very simple and has been heavily'
CALL mess 'modified for better playability. The universe consists of a 10 by 10'
CALL mess 'grid of quadrants, each quadrant also consisting of a 10 by 10 grid.'
CALL mess '0,0 is the top left corner; Y is vertical and X is horizontal.'
CALL mess
CALL mess 'The object is to destroy all the Romulan ships in the galaxy.'
CALL mess
CALL mess 'You will see several objects as you play; the most common ones are:'
CALL mess
CALL mess ' |o|=the Enterprise'
CALL mess ' <->=Romulans'
CALL mess ' (B)=a Starbase'
CALL mess ' * =a star'
CALL mess
OPTIONS PROMPT 'Hit [RETURN] to continue: '
PULL res
CALL mess CLS
CALL mess 'COMMANDS'
CALL mess
CALL mess 'The command line takes two-word combinations. You can abbreviate'
CALL mess 'words to 3 letters. The most common commands are'
CALL mess
CALL mess ' RAISE SHIELDS (hint!)'
CALL mess ' LOWER SHIELDS'
CALL mess ' FIRE PHASERS'
CALL mess ' FIRE TORPEDOS'
CALL mess ' IMPULSE POWER'
CALL mess ' WARP DRIVE'
CALL mess ' SCANNERS (or SENSORS)'
CALL mess ' STATUS'
CALL mess ' SAVE (Saves game WITHOUT exiting)'
CALL mess ' QUIT (Exit game entirely)'
CALL mess ' HELP (Gives you this file again)'
CALL mess
OPTIONS PROMPT 'Hit [RETURN] to continue: '
PULL res
CALL mess CLS
CALL mess 'VECTORS: When firing torpedoes or moving the ship you are asked'
CALL mess 'for X and Y vectors. Each of these can be -1, 0, or 1. This'
CALL mess 'indicates the X or Y direction. For instance, if X=0 and Y=1,'
CALL mess 'this indicates a vector straight down. If both are -1, this would'
CALL mess 'indicate an upper-left direction.'
CALL mess
CALL mess 'IN ORDER TO STAY ALIVE you must NOT run out of energy, exceed'
CALL mess 'Stardate 5000.0, or be caught with your shields down.'
CALL mess
CALL mess 'The Enterprise will from time to time need maintenance. Do this'
CALL mess 'by pulling up next to a Starbase.'
CALL mess
OPTIONS PROMPT 'Hit [RETURN] to continue: '
PULL res
CALL mess CLS
justcleared='true'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE CAPTAINS_LOG */
/* PASSED VALUES - word2 */
/* ********************************************** */
/* ********************************************** */
captains_log:
CALL mess 'Sorry, not implemented'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE LAUNCH_PROBE */
/* PASSED VALUES - word2 */
/* ********************************************** */
/* ********************************************** */
launch_probe:
CALL mess 'Sorry, not implemented'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE COMPUTE */
/* PASSED VALUES - word2 */
/* ********************************************** */
/* ********************************************** */
compute:
CALL mess 'Sorry, not implemented'
return
/* ********************************************** */
/* ********************************************** */
/* SUBROUTINE MISSION1 */
/* PASSED VALUES - none */
/* ********************************************** */
/* ********************************************** */
mission1:
/* make the Romulans active aggressors */
/* Mission 1 - WAR with the ROMULANS! */
/* Any Romulans in the sector? */
if map.x.y > 99 then do
do i=0 to 9 /* locate the Romulan in the quadrent */
do j=0 to 9
if quad.i.j=3 then
do
tx=i
ty=j
end
end
end
/* got him - now move and fire */
if tx > ex then t0=-1
if tx=ex then t0=0
if tx < ex then t0=1
if ty > ey then t1=-1
if ty=ey then t1=0
if ty < ey then t1=1
/* now how much? */
factor=((tx-ex)**2 + (ty-ey)**2)
do i=1 to 13 by .5
tm=factor/i
if tm < i then leave
end
factor=i%1
/* now move him */
kl='yes'
do i=0 to factor - 1
if factor < 1 then leave
t2=tx+t0
t3=ty+t1
if t2 < 0 | t2 > 9 | t3 < 0 | t3 > 9 then leave
space=quad.t2.t3
if space=1 then leave
if space ~= 0 & kl='yes' then select
when space=2 then do
CALL mess '*** ROMULAN COLLIDES with STAR ***'
quad.tx.ty=0
map.x.y=map.x.y - 100
kltot=kltot - 1
kl='no'
end
when space=3 then do
CALL mess '*** ROMULAN COLLIDES with ROMULAN ***'
quad.tx.ty=0
quad.t2.t3=0
map.x.y=map.x.y - 200
kltot=kltot - 2
kl='no'
end
when space=4 then do
CALL mess '*** ROMULAN COLLIDES with BASE ***'
quad.tx.ty=0
quad.t2.t3=0
map.x.y=map.x.y - 100
kltot=kltot - 1
kl='no'
end
otherwise
do
CALL mess space
CALL mess '*** ROMULAN EATEN FOR LUNCH! ***'
points=points + 50
quad.tx.ty=0
map.x.y=map.x.y - 100
kltot=kltot - 1
kl='no'
end
end
if kl='yes' then do
quad.tx.ty=0
quad.t2.t3=3
tx=t2
ty=t3
CALL mess HOM
call print_quadrent
end
end
if docked='yes' then return
/* now fire */
if kl='yes' then do
amount=klshields/5000 * random(100,500) * 10
if amount > 1000 & shields='down' then do
CALL mess '--- ROMULAN FIRES PHASERS ---'
CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
CALL mess '*** ENTERPRISE HIT with 'amount ' UNITS OF ENERGY ***'
CALL mess '*** ENTERPRISE DESTROYED ***'
alive='no'
end
if amount < 3000 & shields='UP' then do
CALL mess '--- ROMULAN FIRES PHASERS ---'
CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
CALL mess '*** Shields absorb impact --- no damage ***'
energy=energy - amount
end
if amount > 3000 & shields='UP' then do
CALL mess '--- ROMULAN FIRES PHASERS ---'
CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
hit=amount - 3000
CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
energy=energy - amount
do i=0 to hit/100
call wear_and_tear
end
end
if amount < 1001 & shields='down' then do
CALL mess '--- ROMULAN FIRES PHASERS ---'
CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
hit=amount
CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
do i=0 to hit/100
call wear_and_tear
end
end
end
end
/* end for Romulans in sector ... if < 3 here go get some */
if map.x.y < 299 & alive='yes' then do
found='no'
do i=-1 to 1 /* locate a Romulan in the Galaxy */
do j=-1 to 1
tx=i+x
ty=j+y
if (tx > -1) & (tx < 10) & (ty > -1) & (ty < 10) then do
if (map.tx.ty > 99) & ((i ~=0 )|(j ~=0 )) then do
found='yes'
i=1
j=1
end
end
end
end
if found='yes' then do
CALL mess 'CAPTAIN! A Romulan warship has just warped into the quadrant!'
map.tx.ty=map.tx.ty - 100
map.x.y=map.x.y + 100
do until a=1
rx=random(0,9)
ry=random(0,9)
if quad.rx.ry=0 then do
quad.rx.ry=3
a=1
end
else a=0
end
end
end
if kltot=0 then missstat='completed'
return
/* MISSION 2 */
init_variables_2:
return
mission2:
return
/* MISSION3 */
init_variables_3:
return
mission3:
/* MISSION4 */
init_variables_4:
return
mission4:
/* MISSION5 */
init_variables_5:
return
mission5:
/* MISSION6 */
init_variables_6:
return
mission6:
/* MISSION7 */
init_variables_7:
return
mission7:
/* MISSION8 */
init_variables_8:
return
mission8:
/* MISSION9 */
init_variables_9:
return
mission9:
return
old_highest:
if ~Open(fnn,gamepath'HighScore','R') then return
do i=1 to 10
highname.i=Readln(fnn)
highscore.i=Readln(fnn)
end
junk=Close(fnn)
return
new_highest:
if UName='' then return /* saves from screwups from running offline */
if points <= highscore.10 then return
CALL mess 'CONGRATULATIONS!'
CALL mess 'You are in the top 10! Saving your name and score for posterity...'
highscore.10=points
highname.10=UName
do forever
changes=0
do i=1 to 9
ihatearexx=i+1
if highscore.ihatearexx > highscore.i then
do
temp=highscore.i
tempname=highname.i
highscore.i=highscore.ihatearexx /* Bubblehead sort */
highname.i=highname.ihatearexx
highscore.ihatearexx=temp
highname.ihatearexx=tempname
changes=1
end
end
if changes=0 then leave
end
if ~Open(fnn,gamepath'HighScore','W') then return
do i=1 to 10
if Writeln(fnn,highname.i) < 1 then return
if Writeln(fnn,highscore.i) < 1 then return
end
junk=Close(fnn)
return
clearbottom:
CALL mess POS
CALL mess CLR
return
toolong:
CALL mess ''
CALL mess 'Sorry, time up for this round.'
OPTIONS PROMPT 'Would you like to SAVE your game before exiting (Y/N)? '
PULL choice
if choice='Y' then call save_game
if points > highest then call new_highest
BREAK_C:
CALL mess 'Exiting STARTREK... play again soon!'
exit
return
checkBBS:
IF ADDRESS()~='BAUD' THEN RETURN 0
IF TIME('E')>secs THEN SIGNAL toolong
dcd
IF RC=0 THEN EXIT
temp=secs-TIME('E')
IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
RETURN 0
mess:
PARSE ARG string
SAY string'0D'x
RETURN
/* end */