home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0950.lha / BBDoors / BBDoors65.lha / rexxDoors / StarTrek.rexx < prev    next >
OS/2 REXX Batch file  |  1993-08-24  |  36KB  |  1,462 lines
  1. /*  STAR TREK - THE FINAL FRONTIER  - Online BBS Game
  2.     Written By Steve Berry
  3.     Rev A - 4/24/87 IBM 370
  4.     Rev B - 5/21/88
  5.          modified to run on Amiga                          
  6.     Rev C - 10/23/91
  7.          modified to run from CLI or BBBBS
  8.          also updated enemy from Klingons to Romulans
  9.     Mods for Atredes by Bob Hassel and Michael Cox
  10.     ANSI version & other enhancements by Michael Cox
  11.     BBBBS mods by Richard Lee Stockton
  12.     3 bugs fixed August 24,1993 by Charles Johnston
  13.     (1) Saved games would not survive a reload - FIXED
  14.     (2) After torpedos were used up one could continue firing them - FIXED
  15.     (3) After phasers were used up one could continue firing them -FIXED
  16. */
  17.  
  18. CALL TIME('R')
  19. SIGNAL ON BREAK_C
  20. bbspath=GETCLIP('BBS_path')
  21. PARSE ARG UName . . . secs .
  22. IF secs='' THEN secs=3600
  23. gamepath=''
  24. IF UName~='' & bbspath~='' THEN gamepath=bbspath'rexxDoors/Data/'
  25. maxtime=5000
  26. justcleared='true'
  27. highest=0
  28. highname=0
  29. HOM='H'
  30. RESET=''
  31. POS='0H'
  32. CLS='H'
  33. CLR=''
  34. CLL=''
  35. WHITEONBLUE=''
  36. REDONBLUE=''
  37. YELLOWONBLUE=''
  38. CYANONBLACK=''
  39. YELLOWONBLACK=''
  40. MAGENTAONBLACK=''
  41. BLUEONBLACK=''
  42. REDONYELLOW=''
  43. WHITE=''
  44. RED=''
  45. YELLOW=''
  46. BLACK=''
  47. GREEN=''
  48. CYAN=''
  49. MAGENTA=''
  50. BLUE=''
  51. IF ADDRESS()~='BAUD' THEN
  52.   DO
  53.     BLUE=GREEN
  54.     WHITEONBLUE=''
  55.     REDONBLUE=''
  56.     YELLOWONBLUE=''
  57.   END
  58. call time 'R'           /* reset timer */
  59. do i=1 to 10
  60.  highscore.i=0
  61.  highname.i=' '
  62. end
  63. stardate=time('E')
  64. junk=randu(time('S'))
  65. blanks='                                 '
  66.  
  67. call old_highest
  68. CALL mess CLS
  69. CALL mess BLUE||'                           Welcome to STARTREK!'
  70. CALL mess
  71. CALL mess YELLOW||'                             TOP TEN PLAYERS'
  72. CALL mess WHITE
  73. do i=1 to 10
  74.    if highscore.i=0 then iterate
  75.    CALL mess substr(blanks,1,20) highname.i substr(blanks,1,30-length(highname.i)) RIGHT(highscore.i,6)
  76. end
  77.  
  78. CALL mess CYAN
  79. CALL mess '         (You need an ANSI-compatible terminal to play this game.)'
  80. CALL mess 
  81. OPTIONS PROMPT '               Do you need instructions (y/N)? '
  82. PULL res
  83.  if res='Y' then
  84.    call instructions
  85.   else
  86.   do                             /* Anyone ever heard of BRACKETS? */
  87.    CALL mess
  88.    CALL mess 'You can get the instructions at any time by entering the word HELP.'
  89.    OPTIONS PROMPT 'Hit [RETURN] to continue: '
  90.    PULL res
  91.   end
  92. CALL mess CLS
  93. CALL mess 
  94. CALL mess
  95. OPTIONS PROMPT 'Load and play an old game (y/N)? '
  96. PULL fn
  97. CALL mess CLS
  98.  
  99. mission=1
  100.  
  101. /* Are we playing an OLD Game? */
  102.  
  103. if fn='Y' then
  104.     call load_old_game fn
  105. else
  106.  
  107. newmission:
  108.  CALL mess 'Please stand by... universe under construction'
  109.  select
  110.   when mission=1 then call init_variables_1
  111.   when mission=2 then call init_variables_2
  112.   when mission=3 then call init_variables_3
  113.   when mission=4 then call init_variables_4
  114.   when mission=5 then call init_variables_5
  115.   when mission=6 then call init_variables_6
  116.   when mission=7 then call init_variables_7
  117.   when mission=8 then call init_variables_8
  118.   when mission=9 then call init_variables_9
  119.   when mission=10 then call init_variables_10
  120. /*  otherwise */
  121.  end
  122.  
  123.  
  124. /* ********** */
  125. /* Main do loop */
  126. /* ************ */
  127.  
  128. main: /* added this function name so 'load_old_game:' could signal to it*/
  129.  
  130. starttime=stardate
  131. CALL mess CLS
  132. do until energy=0
  133. CALL checkBBS()
  134. CALL mess HOM
  135.  call print_quadrent x,y,ex,ey
  136.  t0=time('R')
  137.  
  138. /* get user input and parse the commands */
  139.  if stardate - starttime > maxtime then call toolong
  140.  OPTIONS PROMPT 'Your command, Captain? '
  141.  PULL instring
  142.  rc=parse_command(instring)
  143.  
  144. /* process the commands */
  145.  
  146.   if rc=0 then do
  147.     do loop=1 to 3
  148.      if arg1.loop='' then leave
  149.      call process_command arg1.loop,arg2.loop
  150.      if alive='no' | energy <= 0 then leave
  151.     end
  152.    end
  153.   else CALL mess "Command not understood. Enter HELP for reminder."
  154.  
  155. /* Check for illegal input */
  156.  
  157.   if missstat='completed' then do
  158.     CALL mess CLS
  159.     CALL mess
  160.     CALL mess ' CONGRATULATIONS !!! You have completed the mission!'
  161.     CALL mess
  162.      exit 0
  163.     end
  164.  
  165. /* Did player kill himself? */
  166.  
  167.  If alive='no' | energy <= 0 then do
  168.    CALL mess CLS
  169.    CALL mess
  170.    CALL mess
  171.    CALL mess
  172.    CALL mess
  173.    CALL mess ' Suicide is not in the BEST interests of the FEDERATION.'
  174.    CALL mess
  175.    CALL mess ' But you did get 'points' points.'
  176.    CALL mess
  177.    CALL mess
  178.    CALL mess
  179.    CALL mess 'Game over.'
  180.    CALL mess
  181.    CALL mess
  182.    exit
  183.   end
  184.  
  185. /* Time for a little wear and tear on the enterprize */
  186.  
  187.  call wear_and_tear
  188.  
  189. /* Is the Enterprize DEAD in Space? */
  190.  
  191.  If alive='no' then do
  192.    CALL mess CLS
  193.    CALL mess
  194.    CALL mess
  195.    CALL mess
  196.    CALL mess
  197.    CALL mess ' Sorry but you let the Enterprise deteriorate into '
  198.    CALL mess ' into a rusting hunk of space debris.'
  199.    CALL mess
  200.    CALL mess ' But you did get 'points' points.'
  201.    CALL mess
  202.    CALL mess
  203.    CALL mess
  204.    CALL mess 'Game over.'
  205.    CALL mess
  206.    CALL mess
  207.    exit
  208.   end
  209.  
  210. /* Ok. now it's the Bad guy's turn */
  211.  
  212. /* now call mission specific routine */
  213. /* for bad guy routine and points awarded */
  214.  
  215.  select
  216.   when mission=1 then call mission1
  217.   when mission=2 then call mission2
  218.   when mission=3 then call mission3
  219.   when mission=4 then call mission4
  220.   when mission=5 then call mission5
  221.   when mission=6 then call mission6
  222.   when mission=7 then call mission7
  223.   when mission=8 then call mission8
  224.   when mission=9 then call mission9
  225.   when mission=10 then call mission10
  226.  end
  227.  
  228. /* Is the Enterprize KILLED? KRUSHED? DESTROYED? */
  229.  
  230.  If alive='no' then do
  231.    CALL mess
  232.    CALL mess
  233.    CALL mess
  234.    CALL mess
  235.    CALL mess ' Sorry but you let your crew and the Federation down.'
  236.    CALL mess ' Perhaps you should consider another career.'
  237.    CALL mess
  238.    CALL mess ' But you did get 'points' points.'
  239.    CALL mess
  240.    CALL mess
  241.    CALL mess
  242.    CALL mess 'Game over.'
  243.    CALL mess
  244.    CALL mess
  245.    exit
  246.   end
  247.  
  248. /* end of the loop - now go print the screen */
  249. end
  250.  
  251.  
  252. /* ********************************************** */
  253. /* ********************************************** */
  254. /*          SUBROUTINE SECTION                    */
  255. /* ********************************************** */
  256. /* ********************************************** */
  257.  
  258.  
  259.  
  260. /* ********************************************** */
  261. /* ********************************************** */
  262. /*          SUBROUTINE LOAD_OLD_GAME              */
  263. /*  PASSED VALUES - fn                            */
  264. /* ********************************************** */
  265. /* ********************************************** */
  266.  
  267. load_old_game:
  268.  
  269.  
  270. bstr='   |o| * <->(B))\_ # '
  271. missstat='not yet'
  272. CALL mess 'Loading your previously saved game...'
  273. /* get variables */
  274.  if ~Open(fnn,gamepath||UName,'R') then
  275.  
  276. do
  277. CALL mess "Can't find a saved game for you! Exiting STARTREK."
  278. exit
  279. end
  280.  inn=Readln(fnn)
  281.  parse var inn stardate mission energy points x y ex ey shields klshields docked kltot
  282.  inn=Readln(fnn)
  283.  parse var inn status.0 status.1 status.2 status.3 status.4 status.5
  284.  
  285. /* start interval timer */
  286.  
  287. stardate=stardate + time('E')
  288.  
  289. /* Load galactic map */
  290.  
  291.  do l=0 to 9
  292.   inn1=Readln(fnn)
  293.   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
  294.   
  295.  end
  296.  
  297.  do l=0 to 9
  298.   inn1=Readln(fnn)
  299.   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
  300.  end
  301. alive='yes'
  302. junk=Close(fnn)
  303. signal main /* bug fix so old game is loaded properly and not overwritten as fresh game*/
  304. return
  305.  
  306. /* ********************************************** */
  307. /* ********************************************** */
  308. /*          SUBROUTINE INIT_VARIABLES_1           */
  309. /*  PASSED VALUES - none                          */
  310. /* ********************************************** */
  311. /* ********************************************** */
  312.  
  313. init_variables_1:
  314.  
  315. bstr='   |o| * <->(B))\_ # '
  316. alive='yes'
  317. energy=1000000
  318. x=0
  319. y=0
  320. points=0
  321. mission=1
  322. shields='down'
  323. kltot=0
  324. missstat='not yet'
  325.  
  326. do a=0 to 9
  327.  do b=0 to 9
  328.    map.a.b=random(0,1) * 100 + random(0,1)*10 + random(0,9)
  329.    if map.a.b > 99 then kltot=kltot + 1
  330.  end
  331. end
  332.  
  333. klshields=5000
  334. status.0=0
  335. status.1=0
  336. status.2=0
  337. status.3=0
  338. status.4=0
  339. status.5=0
  340. ex=5
  341. ey=4
  342.  
  343.  
  344. newscreen:
  345. /* initialize quadrent matrix */
  346.  
  347. enemies=map.x.y%100
  348. bases=(map.x.y - enemies * 100)%10
  349. stars=map.x.y - enemies * 100 - bases * 10
  350.  
  351. /* zero quad matrix */
  352.  
  353. do i=0 to 9
  354.  do j=0 to 9
  355.   quad.i.j=0
  356.  end
  357. end
  358.  
  359. /* locate the enterprize */
  360.  
  361. quad.ex.ey=1
  362.  
  363. /* put the stars in */
  364.  
  365. do a=0 to stars - 1
  366.  rx=random(0,9)
  367.  ry=random(0,9)
  368.  if quad.rx.ry=0 then quad.rx.ry=2
  369.  else a=a-1
  370. end
  371.  
  372. /* enemies? */
  373.  
  374. if enemies ~= 0 then do
  375.  do a=0 to enemies - 1
  376.    rx=random(0,9)
  377.    ry=random(0,9)
  378.    if quad.rx.ry=0 then quad.rx.ry=3
  379.    else a=a-1
  380.  end
  381. end
  382. /* bases ? */
  383.  
  384. if bases ~= 0 then do
  385.  do a=0 to bases - 1
  386.    rx=random(0,9)
  387.    ry=random(0,9)
  388.    if quad.rx.ry=0 then quad.rx.ry=4
  389.    else a=a-1
  390.  end
  391. end
  392. docked='no'
  393.  
  394. return
  395.  
  396. /* ********************************************** */
  397. /* ********************************************** */
  398. /*          SUBROUTINE PRINT_QUARDENT             */
  399. /*  PASSED VALUES - x, y ,ex ,ey                  */
  400. /* ********************************************** */
  401. /* ********************************************** */
  402.  
  403. print_quadrent:
  404.  
  405. call dock?  /* check to see if the Enterprize is docked */
  406.  
  407. stardate=stardate + time('E')
  408.  
  409. if status.5 < 1 | docked='yes' then astr=bstr
  410. else   astr='XXX|o|XXXXXXXXXXXXXXX'
  411. CALL mess RESET
  412. do i0=0 to 9
  413.  line='         '|| WHITEONBLUE
  414.  do j0=0 to 9
  415.   select
  416.     when quad.i0.j0=0 then line=line || substr(astr,quad.i0.j0 * 3 + 1,3)
  417.     when quad.i0.j0=1 then line=line || WHITE || substr(astr,quad.i0.j0 * 3 + 1,3)
  418.     when quad.i0.j0=2 then line=line || YELLOW || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  419.     when quad.i0.j0=3 then line=line || RED || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  420.     when quad.i0.j0=4 then line=line || GREEN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  421.     when quad.i0.j0=5 then line=line || CYAN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  422.     when quad.i0.j0=6 then line=line || MAGENTA || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  423.   otherwise nop
  424.   end
  425.  end
  426.  select
  427.   when i0=0 then line=line || YELLOWONBLACK ||'  Stardate: 'stardate'    '
  428.   when i0=1 then
  429.   do
  430.    if energy > 10000 then line=line || YELLOWONBLACK ||'  Energy: 'energy'    '
  431.    else
  432.    line=line || YELLOWONBLACK ||'  Energy: '||REDONYELLOW||energy'    '
  433.   end
  434.   when i0=2 then line=line || YELLOWONBLACK ||'  Quadrant:' y',' x'    '
  435.   when i0=3 then line=line || YELLOWONBLACK ||'  Sector:  ' ex',' ey '  '
  436.   when i0=4 & docked='yes' then line=line || YELLOWONBLACK || '  Condition: '||GREEN||'DOCKED'
  437.   when i0=4 & map.x.y > 99 & docked='no' then line=line || YELLOWONBLACK ||'  Condition: '||RED||'RED    '
  438.   when i0=4 & map.x.y < 100 & docked='no' then line=line || YELLOWONBLACK || '  Condition: '||GREEN||'Green    '
  439.   when i0=5 then
  440.  
  441.    do
  442.     if shields='UP' then line=line || YELLOWONBLACK ||'  Shields:' CYANONBLACK||'Up    '
  443.     else
  444.     line=line || YELLOWONBLACK ||'  Shields:' MAGENTAONBLACK||'Down    '
  445.    end
  446.   when i0=6 then line=line || YELLOWONBLACK ||'  Romulans left:' kltot'    '
  447.   when i0=7 then line=line || YELLOWONBLACK ||'  Points:' points'    '
  448.   otherwise line=line || RESET||'                       '
  449.  end
  450.  if (line ~= oldline.i0)|(justcleared='true') then CALL mess line; else CALL mess ""
  451.  oldline.i0=line
  452. end
  453. CALL mess RESET
  454. call clearbottom
  455. justcleared='false'
  456. return
  457.  
  458. /* ********************************************** */
  459. /* ********************************************** */
  460. /*           SUBROUTINE PARSE_COMMAND             */
  461. /*  PASSED VALUES - INSTRING                      */
  462. /* ********************************************** */
  463. /* ********************************************** */
  464.  
  465. parse_command:
  466.  
  467. parse arg arg1.1 arg2.1 arg1.2 arg2.2 arg1.3 arg2.3 .
  468.  
  469. /* string for recognition of commands */
  470.  
  471. comstr='COMFIRTORPHADISMAPSHOSENLONRAILOWSHIWARIMPLAUPROCAPLOGTRASHIDOWSAVGAMINSQUIDRISTAHELPOWSCASEE'
  472.  
  473. /* Check for no input */
  474.  
  475. if arg1.1='' then return -1
  476. if arg1.1='#' then
  477.   do
  478.   exit
  479.   end
  480.  
  481. /* trash all but the first three letters of each command */
  482.  
  483. do i=1 to 3
  484.  arg1.i=left(arg1.i,3)
  485.  arg2.i=left(arg2.i,3)
  486.  if arg1.i='' then leave
  487.  do j=0 to 30
  488.   if arg1.i=substr(comstr,j * 3 + 1,3) then leave
  489.  end
  490.  if j > 30  then return -1
  491.  if arg2.i='' then return 0
  492.   do j=0 to 30
  493.    if arg2.i=substr(comstr,j * 3 + 1,3) then leave
  494.   end
  495.  if j > 30  then return -1
  496. end
  497.  
  498. return 0
  499.  
  500. /* ********************************************** */
  501. /* ********************************************** */
  502. /*           SUBROUTINE PROCESS_COMMAND           */
  503. /*  PASSED VALUES - word1 , word2                 */
  504. /* ********************************************** */
  505. /* ********************************************** */
  506.  
  507. process_command:
  508.  
  509. arg word1,word2
  510. select
  511.   when word1='FIR' then call weapon_control word2
  512.   when word1='COM' then call compute word2
  513.   when word2='SEN' then call sensors word1
  514.   when word2='SCA' then call sensors word1
  515.   when word1='SEN' then call sensors word1
  516.   when word1='SCA' then call sensors word1
  517.   when word2='SHI' then call shield_control word1
  518.   when word2='DRI' then call engine_control word1
  519.   when word2='POW' then call engine_control word1
  520.   when word1='INS' then call instructions
  521.   when word2='INS' then call instructions
  522.   when word1='HEL' then call instructions
  523.   when word1='SAV' then call save_game word2
  524.   when word1='DIS' then call display_info word2
  525.   when word1='SEE' then call display_info word2
  526.   when word1='STA' then call display_info word2
  527.   when word1='LAU' then call launch_probe word2
  528.   when word1='CAP' then call captains_log word2
  529.   when word1='QUI' then
  530.   do
  531.   call new_highest
  532.   CALL mess 'Exiting STARTREK... play again soon!'
  533. exit
  534.   end
  535.   otherwise CALL mess 'Sorry - not understood'
  536. end
  537.  
  538. return
  539.  
  540. /* ********************************************** */
  541. /* ********************************************** */
  542. /*           SUBROUTINE WEAPON_CONTROL            */
  543. /*  PASSED VALUES - weapon                        */
  544. /* ********************************************** */
  545. /* ********************************************** */
  546.  
  547. weapon_control:
  548.  
  549. arg weapon
  550.  
  551. if (weapon ~= 'PHA') & (weapon ~= 'TOR') then do
  552.    CALL mess
  553.    CALL mess 'Weapon does not exist.'
  554.    return
  555.   end
  556.  
  557. /* Phasers section */
  558.  
  559. if weapon='PHA' then do
  560.   if map.x.y < 100 then do
  561.     CALL mess 'No targets to fire on.   '
  562.     return
  563.    end
  564.  
  565.  /* compute the distance  between Enterprize and Romulan */
  566.  
  567.  kx=0
  568.  ky=0
  569.  do i=0 to 9
  570.   do j=0 to 9
  571.    if quad.i.j=3 then do
  572.      kx=i
  573.      ky=j
  574.     end
  575.   end
  576.  end
  577. /* compute the distance (rough approximation) */
  578.  distance=((ex-kx)**2 + (ey-ky)**2)
  579.  do i=1 to 13 by .5
  580.   t0=distance/i
  581.   if t0 < i then leave
  582.  end
  583.  distance=i
  584.  energy=energy - 5000
  585.  hit=(1 - status.1)* 5000 - (distance * 500)
  586.  if hit < 0 then hit=0
  587.  klshields=klshields - hit
  588.  if hit=0 then
  589.    do  /* Bug fix for when out of phasers, old code let keep shooting endlessly*/
  590.     call mess 'Sorry Captain you have exhausted the Phaser Banks!'
  591.     call delay(100)
  592.     return
  593.    end
  594.  CALL mess
  595.  CALL mess 'PHASERS LOCKED ON TARGET '
  596.  CALL mess 'Phasers fired -'
  597.  if klshields <= 0 then do
  598.     CALL mess 'ROMULAN HIT WITH' hit ' units of energy'
  599.     CALL mess '*** ROMULAN DESTROYED! ***'
  600.     points=points + 50
  601.     klshields=5000
  602.     quad.kx.ky=0
  603.     map.x.y=map.x.y - 100
  604.     kltot=kltot - 1
  605.    end
  606.  else
  607.    do
  608.     CALL mess 'KILINGON HIT WITH' hit ' units of energy'
  609.     CALL mess 'The Romulan ship is still alive, Captain!'
  610.    end
  611.  end /* end of phaser routine */
  612. else do
  613.   /* Torpedo routine */
  614.     if weapon='TOR' & status.2 >.9 then  
  615.     do /* bug fix for when out of torpedos, old code let you shoot endlessly*/
  616.      call mess 'Sorry Captain we are all out of torpedos!'
  617.      call delay(100)
  618.      return
  619.     end
  620.      CALL mess 'Torpedos ready Captain.'
  621.      do until c=0
  622.       OPTIONS PROMPT 'X vector, Captain (-1=left, 0=middle, 1=right)? '
  623.       PULL dy
  624.       OPTIONS PROMPT 'Y vector, Captain (-1=up, 0=middle, 1=down)? '
  625.       PULL dx
  626.       if dx='' then dx=0
  627.       if dy='' then dy=0
  628.       if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
  629.       else
  630.        do
  631.         c=1
  632.         CALL mess 'Invalid vectors. Valid range for each is -1 to 1.'
  633.        end
  634.      end
  635.     tx=ex
  636.     ty=ey
  637.     do lp=0 to 9
  638.      t0=tx+dx
  639.      t1=ty+dy
  640.      if (t0 < 0) | (t0 > 9) | (t1 < 0) | (t1 > 9) then do
  641.        CALL mess ' Torpedo missed!'
  642.        return
  643.       end
  644.      space=quad.t0.t1
  645.      if space ~= 0 then select
  646.        when space=2 then do
  647.          CALL mess '*** Torpedo hits a STAR ***'
  648.          return
  649.         end
  650.        when space=3 then do
  651.          CALL mess '*** Torpedo hits a ROMULAN ***'
  652.          CALL mess '*** ROMULAN DESTROYED ***'
  653.          CALL mess 'Good shot, Captain!'
  654.          quad.t0.t1=0
  655.          map.x.y=map.x.y - 100
  656.          kltot=kltot - 1
  657.          points=points + 100
  658.          return
  659.         end
  660.        when space=4 then do
  661.          CALL mess '*** Torpedo hits a BASE ***'
  662.          CALL mess 'COURT MARTIAL IS IMMINENT!'
  663.          return
  664.         end
  665.        otherwise do
  666.          CALL mess '*** Torpedo hits the DEATHSTAR ***'
  667.          CALL mess 'Torpedo seems to have no effect!'
  668.          return
  669.         end
  670.        end
  671.       quad.t0.t1=6
  672.       tx=t0
  673.       ty=t1
  674.       CALL mess HOM
  675.       call print_quadrent
  676.       quad.tx.ty=0
  677.      end
  678.  end /* end of Torpedo routine */
  679. return
  680.  
  681. /* ********************************************** */
  682. /* ********************************************** */
  683. /*           SUBROUTINE WEAR_AND_TEAR             */
  684. /*  PASSED VALUES - none                          */
  685. /* ********************************************** */
  686. /* ********************************************** */
  687.  
  688. wear_and_tear:
  689.  
  690. pick=random(0,5)
  691. if docked='yes' then
  692.  if status.pick=0 then return
  693.  else status.pick=status.pick - .1
  694. else if status.pick < 1 then do
  695.   status.pick=status.pick + .1
  696.   if status.pick=1 then do
  697.     CALL mess 'Status report sir -'
  698.     select
  699.      when pick=0 then CALL mess 'Computer is in need of repair!'
  700.      when pick=1 then CALL mess 'Phasers are in need of repair!'
  701.      when pick=2 then CALL mess 'Torpedos are in need of repair!'
  702.      when pick=3 then CALL mess 'Warp Drive is in need of repair!'
  703.      when pick=4 then CALL mess 'Impulse Drive is in need of repair!'
  704.      when pick=5 then CALL mess 'Sensors are out of order!'
  705.     end
  706.    if status.3 > .9 & status.4 > .9 then do
  707.      CALL mess 'Captain sir ... we seem to be dead in space!'
  708.      CALL mess 'The warp drive and the impulse drive are out!'
  709.      alive='no'
  710.     end
  711.   end
  712.  end
  713. return
  714.  
  715.  
  716. /* ********************************************** */
  717. /* ********************************************** */
  718. /*           SUBROUTINE engine_control            */
  719. /*  PASSED VALUES - power                         */
  720. /* ********************************************** */
  721. /* ********************************************** */
  722.  
  723. engine_control:
  724.  
  725. arg power
  726.  
  727. CALL mess 'Scotty here captain.'
  728. if power='WAR' then do
  729.   if status.3 > 1.2 then
  730.   do
  731.   CALL mess 'Sorry Captain, warp drive is out of commission!'
  732.   return
  733.   end
  734.   OPTIONS PROMPT 'What Warp factor Captain? '
  735.   PULL warp
  736.   if warp='' then warp=0
  737.   do forever
  738.    OPTIONS PROMPT 'Destination X vector (0-9)? '
  739.    PULL dy
  740.    OPTIONS PROMPT 'Destination Y vector (0-9)? '
  741.    PULL dx
  742.    if datatype(dx,'W') & datatype(dy,'W') then leave
  743.    CALL mess 'Where?'
  744.   end
  745.    if x > 9 | y < 0 | x  < 0 | y > 9 then do
  746.     energy=energy - 5000
  747.     CALL mess 'Captain, the warp drive is in a bad way'
  748.     CALL mess 'and we are losing energy fast!'
  749.    end
  750.  /* if warp drive damaged degrade efficiency of energy consumption */
  751.   energy=energy - ((((dx-x)**2 + (dy-y)**2)/2.5)*1000+status.3*5000)
  752.   if dx > 9 | dy < 0 | dx < 0 | dy > 9 then do
  753.      CALL mess
  754.      CALL mess 'Warping out of the galaxy is not a good idea. Range 0-9 please.'
  755.      CALL mess
  756.      if shields='down' then do
  757.         CALL mess ' SHIELDS are DOWN --- the ENTERPRISE is caught, in the void of intergalatic space'
  758.         CALL mess ' Damage control report - WARP drive damaged, Impulse drive damaged, sensors out!'
  759.         status.3=status.3 + 1
  760.         status.4=status.4 + 1
  761.         status.5=1.1
  762.       end
  763.      else energy=energy - 5000
  764.     end
  765.   x=dx
  766.   y=dy
  767.   if x > -1 & x < 10 & y > -1 & y < 10 then call newscreen
  768.   end
  769.  else
  770.   do
  771.    if power ~= 'IMP' | status.4 > .9 then do
  772.      CALL mess 'Sorry Captain, impulse power is out of commission!'
  773.      return
  774.     end
  775.    else
  776.     do
  777.      CALL mess 'Aye Captain - Impulse power it is'
  778.      OPTIONS PROMPT 'What factor, Captain? '
  779.      do forever      
  780.        PULL factor
  781.        if datatype(factor,'W') then leave
  782.        CALL mess 'Whats that, Captain? '
  783.      end
  784.      if factor <= 0 & num='yes' then return
  785.      do until c=0
  786.       OPTIONS PROMPT ' X vector (-1=left, 0=middle, 1=right)? '
  787.       PULL dy
  788.       OPTIONS PROMPT ' Y vector (-1=up, 0=middle, 1=down)? '
  789.       PULL dx
  790.       if dx='' then dx=0
  791.       if dy='' then dy=0
  792.       if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
  793.       else
  794.        do
  795.         c=1
  796.         CALL mess 'Invalid vectors - valid range for each is -1 to 1.'
  797.        end
  798.      end
  799.     do i=0 to factor - 1
  800.      if ((ex+dx) < 0) | ((ex+dx) > 9) | ((ey+dy) < 0) |((ey+dy) > 9) then
  801.       do
  802.        CALL mess ' You have to use the Warp drive to exit the quadrant.'
  803.        return
  804.       end
  805.      t0=ex+dx
  806.      t1=ey+dy
  807.      space=quad.t0.t1
  808.      if space ~= 0 then select
  809.        when space=2 then do
  810.          CALL mess '*** COLLISION with STAR ***'
  811.          alive='no'
  812.         end
  813.        when space=3 then do
  814.          CALL mess '*** COLLISION with ROMULAN ***'
  815.          alive='no'
  816.         end
  817.        when space=4 then do
  818.          CALL mess '*** COLLISION with BASE ***'
  819.          alive='no'
  820.         end
  821.        otherwise do
  822.          CALL mess '*** SWALLOWED BY THE DEATHSTAR ***'
  823.          alive='no'
  824.         end
  825.        end
  826.       quad.ex.ey=0
  827.       quad.t0.t1=1
  828.       ex=t0
  829.       ey=t1
  830.       if alive='yes' then do
  831.         CALL mess HOM
  832.         call print_quadrent
  833.       end
  834.      end
  835.     end
  836.    end
  837.  
  838. /* Got to check to see if Enterprize is docked */
  839. dock?:
  840.  
  841. docked='no'
  842. do i1=-1 to 1
  843.  do j1=-1 to 1
  844.   if i1+ex > -1 & i1+ex < 10 & j1+ey > -1 & j1+ey < 10 then do
  845.     ta=i1+ex
  846.     tb=j1+ey
  847.     if quad.ta.tb=4 then do
  848.  
  849.      docked='yes'
  850.      t=status.0 + status.1 + status.2 + status.3 + status.4 + status.5
  851.      stardate=stardate + t
  852.      status.0=0
  853.      status.1=0
  854.      status.2=0
  855.      status.3=0
  856.      status.4=0
  857.      status.5=0
  858.     end
  859.    end
  860.  end
  861. end
  862. if kltot=0 then missstat='completed'
  863.  
  864. return
  865.  
  866. /* ********************************************** */
  867. /* ********************************************** */
  868. /*           SUBROUTINE SAVE_GAME                 */
  869. /*  PASSED VALUES - filename                      */
  870. /* ********************************************** */
  871. /* ********************************************** */
  872.  
  873. save_game:
  874.  
  875.  
  876.  
  877. missstat='not yet'
  878.  
  879. /* save variables */
  880.  
  881.  
  882.  if ~Open(fnn,gamepath||UName,'W') then do
  883.   CALL mess '***Open return code=' rc 'on 'bbspath'rexxDoors/Data/'||UName
  884.   CALL mess 'File may be in use, or is unable to be opened. Try again.'
  885.   return
  886.  end
  887. CALL mess 'Storing your game...'
  888. if Writeln(fnn,stardate mission energy points x y ex ey shields klshields docked kltot) < 1 then
  889.  do
  890. exit
  891. end
  892. if Writeln(fnn, status.0 status.1 status.2 status.3 status.4 status.5) < 1 then
  893.  do
  894. exit
  895. end
  896.  
  897. /* Save galactic map */
  898.  
  899.  do l=0 to 9
  900.   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
  901.   do
  902.     exit
  903.   end
  904.  end
  905.  
  906.  do l=0 to 9
  907. 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
  908.   do
  909.   exit
  910.   end
  911.  end
  912.  if ~Close(fnn) then
  913.   do
  914. exit
  915. end
  916. return
  917.  
  918. /* ********************************************** */
  919. /* ********************************************** */
  920. /*           SUBROUTINE SENSORS                   */
  921. /*  PASSED VALUES - type                          */
  922. /* ********************************************** */
  923. /* ********************************************** */
  924.  
  925. sensors:
  926.  
  927. arg type
  928.  
  929. if status.5 < 1.1 then do
  930.   do i=-1 to 1
  931.    CALL mess '-------------------'
  932.    line=': '
  933.    do j=-1 to 1
  934.      t0=x+i
  935.      t1=y+j
  936.      if t0 < 0 | t0 > 9 | t1 < 0 | t1 > 9 then line=line || 'XXX :'
  937.      else
  938.       do
  939.        if map.t0.t1 < 100 & map.t0.t1 > 9 then line=line || ' '
  940.        if map.t0.t1 < 10 then line=line || '  '
  941.        line=line || map.t0.t1 || ' :'
  942.       end
  943.    end
  944.    CALL mess line
  945.   end
  946. end
  947. else
  948.   if status.5 > 1 then do
  949.     CALL mess ' Long-range sensors are out, captain!'
  950.     CALL mess
  951.   end
  952.  CALL mess '-------------------'
  953.  CALL mess
  954.  OPTIONS PROMPT 'Hit RETURN to resume: '
  955.  PULL res
  956.  call clearbottom
  957. return
  958.  
  959.  
  960. /* ********************************************** */
  961. /* ********************************************** */
  962. /*           SUBROUTINE SHIELD_CONTROL            */
  963. /*  PASSED VALUES - direction                     */
  964. /* ********************************************** */
  965. /* ********************************************** */
  966.  
  967. shield_control:
  968.  
  969. arg direction
  970.  
  971. if direction='RAI' then
  972.  if shields='UP' then do
  973.    CALL mess 'Shields are already up.'
  974.   end
  975.  else
  976.   do
  977.    shields='UP'
  978.    CALL mess 'Shields up, Captain.'
  979.    energy=energy - 3000
  980.   end
  981. else
  982.  if direction='LOW' then
  983.   if shields='down' then do
  984.     CALL mess 'Shields are already down.'
  985.    end
  986.   else
  987.    do
  988.     shields='down'
  989.     CALL mess 'Shields down, Captain.'
  990.     energy=energy + 3000
  991.    end
  992.  else
  993.   do
  994.    CALL mess ' I am confused by that order, Captain.'
  995.    return
  996.   end
  997. return
  998.  
  999. /* ********************************************** */
  1000. /* ********************************************** */
  1001. /*           SUBROUTINE DISPLAY_INFO              */
  1002. /*  PASSED VALUES - what                          */
  1003. /* ********************************************** */
  1004. /* ********************************************** */
  1005.  
  1006. display_info:
  1007.  
  1008. arg what
  1009.  
  1010.   CALL mess CLS
  1011.   CALL mess
  1012.   CALL mess ' Status report for Enterprise - Stardate ' stardate
  1013.   CALL mess ' ----------------------------------'
  1014.   c=100 - status.0*100
  1015.   CALL mess ' Computer      status ' c'%'
  1016.   CALL mess ' ----------------------------------'
  1017.   c=100 - status.1*100
  1018.   CALL mess ' Phasers       status ' c'%'
  1019.   CALL mess ' ----------------------------------'
  1020.   c=100 - status.2*100
  1021.   CALL mess ' Torpedos      status ' c'%'
  1022.   CALL mess ' ----------------------------------'
  1023.   c=100 - status.3*100
  1024.   CALL mess ' Warp drive    status ' c'%'
  1025.   CALL mess ' ----------------------------------'
  1026.   c=100 - status.4*100
  1027.   CALL mess ' Impulse drive status ' c'%'
  1028.   CALL mess ' ----------------------------------'
  1029.   c=100 - status.5*100
  1030.   CALL mess ' Sensors       status ' c'%'
  1031.   CALL mess ' ----------------------------------'
  1032.   OPTIONS PROMPT 'Hit RETURN to resume: '
  1033.   PULL res
  1034. CALL mess CLS
  1035. justcleared='true'
  1036. return
  1037.  
  1038. /* ********************************************** */
  1039. /* ********************************************** */
  1040. /*           SUBROUTINE INSTRUCTIONS              */
  1041. /*  PASSED VALUES - none                          */
  1042. /* ********************************************** */
  1043. /* ********************************************** */
  1044.  
  1045. instructions:
  1046.  
  1047. CALL mess CLS
  1048. CALL mess 'Welcome to STARTREK.'
  1049. CALL mess
  1050. CALL mess 'This version of STARTREK is very simple and has been heavily'
  1051. CALL mess 'modified for better playability. The universe consists of a 10 by 10'
  1052. CALL mess 'grid of quadrants, each quadrant also consisting of a 10 by 10 grid.'
  1053. CALL mess '0,0 is the top left corner; Y is vertical and X is horizontal.'
  1054. CALL mess
  1055. CALL mess 'The object is to destroy all the Romulan ships in the galaxy.'
  1056. CALL mess
  1057. CALL mess 'You will see several objects as you play; the most common ones are:'
  1058. CALL mess
  1059. CALL mess '   |o|=the Enterprise'
  1060. CALL mess '   <->=Romulans'
  1061. CALL mess '   (B)=a Starbase'
  1062. CALL mess '    * =a star'
  1063. CALL mess
  1064. OPTIONS PROMPT 'Hit [RETURN] to continue: '
  1065. PULL res
  1066. CALL mess CLS
  1067. CALL mess 'COMMANDS'
  1068. CALL mess
  1069. CALL mess 'The command line takes two-word combinations. You can abbreviate'
  1070. CALL mess 'words to 3 letters. The most common commands are'
  1071. CALL mess
  1072. CALL mess '   RAISE SHIELDS (hint!)'
  1073. CALL mess '   LOWER SHIELDS'
  1074. CALL mess '   FIRE PHASERS'
  1075. CALL mess '   FIRE TORPEDOS'
  1076. CALL mess '   IMPULSE POWER'
  1077. CALL mess '   WARP DRIVE'
  1078. CALL mess '   SCANNERS (or SENSORS)'
  1079. CALL mess '   STATUS'
  1080. CALL mess '   SAVE (Saves game WITHOUT exiting)'
  1081. CALL mess '   QUIT (Exit game entirely)'
  1082. CALL mess '   HELP (Gives you this file again)'
  1083. CALL mess
  1084. OPTIONS PROMPT 'Hit [RETURN] to continue: '
  1085. PULL res
  1086. CALL mess CLS
  1087. CALL mess 'VECTORS: When firing torpedoes or moving the ship you are asked'
  1088. CALL mess 'for X and Y vectors. Each of these can be -1, 0, or 1. This'
  1089. CALL mess 'indicates the X or Y direction. For instance, if X=0 and Y=1,'
  1090. CALL mess 'this indicates a vector straight down. If both are -1, this would'
  1091. CALL mess 'indicate an upper-left direction.'
  1092. CALL mess
  1093. CALL mess 'IN ORDER TO STAY ALIVE you must NOT run out of energy, exceed'
  1094. CALL mess 'Stardate 5000.0, or be caught with your shields down.'
  1095. CALL mess
  1096. CALL mess 'The Enterprise will from time to time need maintenance. Do this'
  1097. CALL mess 'by pulling up next to a Starbase.'
  1098. CALL mess
  1099. OPTIONS PROMPT 'Hit [RETURN] to continue: '
  1100. PULL res
  1101. CALL mess CLS
  1102. justcleared='true'
  1103. return
  1104.  
  1105. /* ********************************************** */
  1106. /* ********************************************** */
  1107. /*           SUBROUTINE CAPTAINS_LOG              */
  1108. /*  PASSED VALUES - word2                         */
  1109. /* ********************************************** */
  1110. /* ********************************************** */
  1111.  
  1112. captains_log:
  1113.  
  1114. CALL mess 'Sorry, not implemented'
  1115.  
  1116. return
  1117.  
  1118. /* ********************************************** */
  1119. /* ********************************************** */
  1120. /*           SUBROUTINE LAUNCH_PROBE              */
  1121. /*  PASSED VALUES - word2                         */
  1122. /* ********************************************** */
  1123. /* ********************************************** */
  1124.  
  1125. launch_probe:
  1126.  
  1127. CALL mess 'Sorry, not implemented'
  1128.  
  1129. return
  1130.  
  1131. /* ********************************************** */
  1132. /* ********************************************** */
  1133. /*           SUBROUTINE COMPUTE                   */
  1134. /*  PASSED VALUES - word2                         */
  1135. /* ********************************************** */
  1136. /* ********************************************** */
  1137.  
  1138. compute:
  1139. CALL mess 'Sorry, not implemented'
  1140.  
  1141.  
  1142. return
  1143.  
  1144. /* ********************************************** */
  1145. /* ********************************************** */
  1146. /*           SUBROUTINE MISSION1                  */
  1147. /*  PASSED VALUES - none                          */
  1148. /* ********************************************** */
  1149. /* ********************************************** */
  1150.  
  1151. mission1:
  1152.  
  1153. /* make the Romulans active aggressors */
  1154. /* Mission 1 - WAR with the ROMULANS! */
  1155.  
  1156. /* Any Romulans in the sector? */
  1157. if map.x.y > 99 then do
  1158.   do i=0 to 9     /* locate the Romulan in the quadrent */
  1159.    do j=0 to 9
  1160.     if quad.i.j=3 then
  1161.      do
  1162.       tx=i
  1163.       ty=j
  1164.      end
  1165.    end
  1166.   end
  1167.  
  1168.  /* got him - now move and fire */
  1169.  if tx > ex then t0=-1
  1170.  if tx=ex then t0=0
  1171.  if tx < ex then t0=1
  1172.  if ty > ey then t1=-1
  1173.  if ty=ey then t1=0
  1174.  if ty < ey then t1=1
  1175.  /* now how much? */
  1176.  factor=((tx-ex)**2 + (ty-ey)**2)
  1177.  do i=1 to 13 by .5
  1178.   tm=factor/i
  1179.   if tm < i then leave
  1180.  end
  1181.  factor=i%1
  1182.  /* now move him */
  1183.  
  1184. kl='yes'
  1185.  do i=0 to factor - 1
  1186.   if factor < 1 then leave
  1187.   t2=tx+t0
  1188.   t3=ty+t1
  1189.   if t2 < 0 | t2 > 9 | t3 < 0 | t3 > 9 then leave
  1190.   space=quad.t2.t3
  1191.   if space=1 then leave
  1192.   if space ~= 0 & kl='yes' then select
  1193.     when space=2 then do
  1194.       CALL mess '*** ROMULAN COLLIDES with STAR ***'
  1195.       quad.tx.ty=0
  1196.       map.x.y=map.x.y - 100
  1197.       kltot=kltot - 1
  1198.       kl='no'
  1199.      end
  1200.     when space=3 then do
  1201.       CALL mess '*** ROMULAN COLLIDES with ROMULAN ***'
  1202.       quad.tx.ty=0
  1203.       quad.t2.t3=0
  1204.       map.x.y=map.x.y - 200
  1205.       kltot=kltot - 2
  1206.       kl='no'
  1207.      end
  1208.     when space=4 then do
  1209.       CALL mess '*** ROMULAN COLLIDES with BASE ***'
  1210.       quad.tx.ty=0
  1211.       quad.t2.t3=0
  1212.       map.x.y=map.x.y - 100
  1213.       kltot=kltot - 1
  1214.       kl='no'
  1215.      end
  1216.     otherwise
  1217.      do
  1218.       CALL mess space
  1219.       CALL mess '*** ROMULAN EATEN FOR LUNCH! ***'
  1220.       points=points + 50
  1221.       quad.tx.ty=0
  1222.       map.x.y=map.x.y - 100
  1223.       kltot=kltot - 1
  1224.       kl='no'
  1225.      end
  1226.    end
  1227.   if kl='yes' then do
  1228.     quad.tx.ty=0
  1229.     quad.t2.t3=3
  1230.     tx=t2
  1231.     ty=t3
  1232.     CALL mess HOM
  1233.     call print_quadrent
  1234.    end
  1235.  end
  1236. if docked='yes' then return
  1237. /* now fire */
  1238. if kl='yes' then do
  1239.   amount=klshields/5000 * random(100,500) * 10
  1240.   if amount > 1000 & shields='down' then do
  1241.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1242.    CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
  1243.    CALL mess '*** ENTERPRISE HIT with 'amount ' UNITS OF ENERGY ***'
  1244.    CALL mess '*** ENTERPRISE DESTROYED ***'
  1245.    alive='no'
  1246.   end
  1247.   if amount < 3000 & shields='UP' then do
  1248.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1249.    CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
  1250.    CALL mess '*** Shields absorb impact --- no damage ***'
  1251.    energy=energy - amount
  1252.   end
  1253.   if amount > 3000 & shields='UP' then do
  1254.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1255.    CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
  1256.    hit=amount - 3000
  1257.    CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
  1258.    energy=energy - amount
  1259.    do i=0 to hit/100
  1260.     call wear_and_tear
  1261.    end
  1262.   end
  1263.   if amount < 1001 & shields='down' then do
  1264.     CALL mess '--- ROMULAN FIRES PHASERS ---'
  1265.     CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
  1266.     hit=amount
  1267.     CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
  1268.     do i=0 to hit/100
  1269.      call wear_and_tear
  1270.     end
  1271.    end
  1272.   end
  1273. end
  1274.  
  1275. /* end for Romulans in sector ... if < 3 here go get some */
  1276.  
  1277. if map.x.y < 299 & alive='yes' then do
  1278.  found='no'
  1279.  
  1280.   do i=-1 to 1     /* locate a Romulan in the Galaxy */
  1281.    do j=-1 to 1
  1282.      tx=i+x
  1283.      ty=j+y
  1284.      if (tx > -1) & (tx < 10) & (ty > -1) & (ty < 10) then do
  1285.        if (map.tx.ty > 99) & ((i ~=0 )|(j ~=0 )) then do
  1286.          found='yes'
  1287.          i=1
  1288.          j=1
  1289.         end
  1290.       end
  1291.    end
  1292.   end
  1293. if found='yes' then do
  1294.   CALL mess 'CAPTAIN! A Romulan warship has just warped into the quadrant!'
  1295.   map.tx.ty=map.tx.ty - 100
  1296.   map.x.y=map.x.y + 100
  1297.   do until a=1
  1298.    rx=random(0,9)
  1299.    ry=random(0,9)
  1300.    if quad.rx.ry=0 then do
  1301.      quad.rx.ry=3
  1302.      a=1
  1303.     end
  1304.    else a=0
  1305.   end
  1306.  end
  1307. end
  1308. if kltot=0 then missstat='completed'
  1309. return
  1310.  
  1311. /* MISSION 2 */
  1312.  
  1313. init_variables_2:
  1314.  
  1315. return
  1316.  
  1317.  
  1318. mission2:
  1319.  
  1320. return
  1321.  
  1322. /* MISSION3 */
  1323.  
  1324. init_variables_3:
  1325.  
  1326. return
  1327.  
  1328. mission3:
  1329.  
  1330.  
  1331. /* MISSION4 */
  1332.  
  1333. init_variables_4:
  1334.  
  1335. return
  1336.  
  1337. mission4:
  1338.  
  1339.  
  1340. /* MISSION5 */
  1341.  
  1342. init_variables_5:
  1343.  
  1344. return
  1345.  
  1346. mission5:
  1347.  
  1348. /* MISSION6 */
  1349.  
  1350. init_variables_6:
  1351.  
  1352. return
  1353.  
  1354. mission6:
  1355.  
  1356. /* MISSION7 */
  1357.  
  1358. init_variables_7:
  1359.  
  1360. return
  1361.  
  1362. mission7:
  1363.  
  1364. /* MISSION8 */
  1365.  
  1366. init_variables_8:
  1367.  
  1368. return
  1369.  
  1370. mission8:
  1371.  
  1372. /* MISSION9 */
  1373.  
  1374. init_variables_9:
  1375.  
  1376. return
  1377.  
  1378. mission9:
  1379.  
  1380. return
  1381.  
  1382. old_highest:
  1383.  if ~Open(fnn,gamepath'HighScore','R') then return
  1384.  do i=1 to 10
  1385.   highname.i=Readln(fnn)
  1386.   highscore.i=Readln(fnn)
  1387.  end
  1388.  junk=Close(fnn)
  1389. return
  1390.  
  1391.  
  1392.  
  1393. new_highest:
  1394.  if UName='' then return  /* saves from screwups from running offline */
  1395.  if points <= highscore.10 then return
  1396.  CALL mess 'CONGRATULATIONS!'
  1397.  CALL mess 'You are in the top 10! Saving your name and score for posterity...'
  1398.  highscore.10=points
  1399.  highname.10=UName
  1400.  do forever
  1401.    changes=0
  1402.    do i=1 to 9
  1403.     ihatearexx=i+1
  1404.     if highscore.ihatearexx > highscore.i then
  1405.      do
  1406.       temp=highscore.i
  1407.       tempname=highname.i
  1408.       highscore.i=highscore.ihatearexx          /* Bubblehead sort */
  1409.       highname.i=highname.ihatearexx
  1410.       highscore.ihatearexx=temp
  1411.       highname.ihatearexx=tempname
  1412.       changes=1
  1413.      end
  1414.    end
  1415.    if changes=0 then leave
  1416.  end
  1417.    if ~Open(fnn,gamepath'HighScore','W') then return
  1418.    do i=1 to 10
  1419.      if Writeln(fnn,highname.i) < 1 then return
  1420.      if Writeln(fnn,highscore.i) < 1 then return
  1421.    end
  1422.    junk=Close(fnn)
  1423. return
  1424.  
  1425.  
  1426. clearbottom:
  1427.  CALL mess POS
  1428.  CALL mess CLR
  1429. return
  1430.  
  1431.  
  1432. toolong:
  1433. CALL mess ''
  1434. CALL mess 'Sorry, time up for this round.'
  1435. OPTIONS PROMPT 'Would you like to SAVE your game before exiting (Y/N)? '
  1436. PULL choice
  1437. if choice='Y' then call save_game
  1438. if points > highest then call new_highest
  1439.  
  1440. BREAK_C:
  1441. CALL mess 'Exiting STARTREK... play again soon!'
  1442. exit
  1443. return
  1444.  
  1445.  
  1446. checkBBS:
  1447. IF ADDRESS()~='BAUD' THEN RETURN 0
  1448. IF TIME('E')>secs THEN SIGNAL toolong
  1449. dcd
  1450. IF RC=0 THEN EXIT
  1451. temp=secs-TIME('E')
  1452. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR 
  1453. RETURN 0
  1454.  
  1455.  
  1456. mess:
  1457. PARSE ARG string
  1458. SAY string'0D'x
  1459. RETURN
  1460.  
  1461. /* end */
  1462.