%CONTROL 0

%DYNAMICROUTINESPEC CLEAR(%STRING(255)K)
%DYNAMICROUTINESPEC DEFINE(%STRING(255)K)
%EXTERNAL %ROUTINE %SPEC DESTROY (%STRING(255) PARM)
%EXTERNALROUTINESPEC PROMPT(%STRING(15)S)


%ROUTINE  SELECT (%STRING(255)K)
   %STRING(255) S
   %RETURNIF SEL= 1
   SEL = 1
   PRINTSTRING("Parameters ? - LP'S only.
")%ANDSTOPUNLESS K->(".LP").S
   DEFINE("39,".K)
   SELECTOUTPUT(39)
%END

%ROUTINE STARCOMM
   PRINTSTRING('The possible commands are designated by the
following numbers and code words.
 1  RANGE     (repeat last range and bearing
 2  PHASEF    (fire forward phasers
 3  PHASER    (fire rear phasers
 4  TORPF     (fire forward photon torpedoes
')
   PRINTSTRING(' 5  TORPR     (fire rear photon torpedoes
 6  PROBE     (fire an antimatter probe
 7  MOVE      (move forward
 8  TURN      (change direction of travel
 9  DAMAGE    (give damage report
10  SHIELDS   (set optimum shield
')
   PRINTSTRING('11  chances   (give firing probabilities
12  COMMANDS  (repeat this list
13  BLUFF     (attempt to bluff the klingon
14  WAIT      (let the klingon move next
15  SUICIDE   (blow up the enterprise
16  SURRENDER (surrender to the klingon
')
%END
%ROUTINESPEC STARINST(%STRING (63) K)
%DYNAMICSTRINGFNSPEC DATE
%DYNAMICSTRINGFNSPEC TIME
%DYNAMICLONGREALFNSPEC RANDOM(%INTEGERNAME I, %INTEGER J)

%EXTERNALROUTINE STARTREK (%STRING(255) ERCC RESTRICTION)

   %INTEGERFN TESTDRAINNREAD
   %INTEGER I
      %CYCLE
         I = NEXTSYMBOL
         %EXIT %IF '0' <= I <= '9' %OR I = '-'
         SKIPSYMBOL
      %REPEAT
      READ(I)
      %RESULT = I
   %END

   %INTEGERFN READLINE
   %INTEGER I, J, NO
      NO = 0
      I = 0
      %CYCLE
         %RESULT = TESTDRAINNREAD %IF NO = 0 %AND 0 < NEXTSYMBOL-'0' <10
         READSYMBOL(J)
         %RESULT = NO+I %IF J = NL %AND NO # 0
         I = I+1 %AND NO = NO<<8!J %IF J > ' '
      %REPEAT
   %END

   %INTEGERFN DATETIME
! THIS M/C DEPENDENDANT ON TIME & DATE AS STRINGS
! ALSO RELIES ON STRING RESOLUTION SO COMPILER DEPENDANT
! IF REQUIRED CAN BE FIXED AS AN OWN INTEGER
   %STRING (16) AS
   %CONSTBYTEINTEGERARRAY C(0 : 8) = %C
        16,15,13,12,10,9,8,7,5
   %INTEGER DT, I
      AS = DATE.TIME
      DT = 0
      %CYCLE I = 0,1,8
         DT = DT*10+CHARNO(AS,C(I))-'0'
      %REPEAT
      %RESULT = DT!!X'54321FED'
   %END

   %INTEGERFN MSIGN(%INTEGER R)
      %RESULT = 1 %IF R < 0
      %RESULT = -1
   %END

%INTEGERFNSPEC CHSHIELD(%INTEGER X)
%ROUTINESPEC AWD(%INTEGER I)
%ROUTINESPEC PRINTDES(%INTEGER I)
%ROUTINESPEC SPEED(%INTEGER SP)
%ROUTINESPEC KILL(%INTEGER I)
%ROUTINESPEC CHWEAP
%INTEGERFNSPEC ENTERHM
%REALFNSPEC TCHFN(%INTEGER I)
%ROUTINESPEC TO 90(%INTEGER B)
%INTEGERFNSPEC VEL(%INTEGER I)
%SWITCH SW(0 : 11)
%CONSTSTRING (16) %ARRAY WEAP(1 : 3) =    %C
'PHASERS','PHOTON TORPEDOES','PROBES'
%CONSTREAL U3 = 0.017453
%REAL A, X3, Y3, RAI, CS
%INTEGERARRAY ES, VS(0 : 1)
%INTEGERNAME S0, S1
%INTEGER M0, M1, B, R9, B0, RB1
%BYTEINTEGERARRAY PR, EX, FL(0 : 1), Z(1 : 8)
%BYTEINTEGERNAME X0, X1, P0, P1, X
%BYTEINTEGER C1, S, C, T1
%INTEGER K, I, C0, STARDATE, J, RAN, STD, R
%CONSTSTRING (10) %ARRAY N(0 : 1) =   %C
  'ENTERPRISE','KLINGON'
%CONSTINTEGER YES = M'YEV'
%CONSTBYTEINTEGERARRAY TST(0 : 4) =    80,60,45,35,0
%CONSTINTEGERARRAY CIS(0 : 15) =  %C
M'ANGJ',M'ASEL',M'ASEX',M'ORPK',M'ORPW',M'ROBJ',M'MOVI',M'TURR',
M'MAGK',M'ELDZ',M'NCEZ',M'AND[',M'LUFK',M'WAIX',M'CIDL',M'NDE['
!%CONSTSTRING (9) %ARRAY CS(1 : 17) =   %C
!'RANGE','PHASEF','PHASER','TORPF',
!'TORPR','PROBE','MOVE','TURN','DAMAGE','SHIELDS','CHANCES','COMMANDS',
!'BLUFF','WAIT','SUICIDE','SURRENDER',' '
%CONSTSTRING (20) COMPDIS = 'COMPLETELY DISABLED
'

   %REALFN RANDOMREAL
      %RESULT = RANDOM(RAN,1)
   %END

   %INTEGERFN MODRAN(%INTEGER I, J)
      %RESULT = INT(RANDOMREAL*I)+J
   %END

   %ROUTINE PR100(%INTEGER I)
      PRINT(I/100,5,2)
   %END
! INITIALISING SECTION
! STARTING RANDOMISER
   PRINTSTRING('Enter your 3-digit lucky number
')
   I = TEST DRAIN N READ %UNTIL 99 < I < 1000
   RAN = DATETIME!!I!1
   RAN = 500001 %IF RAN>50001
   A = RANDOM(RAN,0)
   %CYCLE I = 1,1,I
      A = RANDOMREAL
   %REPEAT
!STARTING GAME
   STD = MODRAN(I*10,571500)
   PRINTSTRING('You are in command of the Enterprise
do you want a description of the game
')
   PROMPT('? :')
   STARINST('') %IF READLINE = YES
   S0 == ES(0)
   S1 == ES(1)
   X0 == EX(0)
   X1 == EX(1)
   P0 == PR(0)
   P1 == PR(1)
!STARTING INDIVIDUAL ACTION
   %UNTIL I # YES %CYCLE
      STARDATE = STD
      P0 = 10
      S = 0
      S0 = 400
      X0 = 0
      Z(1) = 100
      Z(2) = 100
      Z(3) = 100
      Z(4) = 100
! STARTING INITIALISING OF EACH CONTACT
      PRINTSYMBOL('a')
      %CYCLE
         PRINTSTRING(' Klingon ship is approaching
')
         R = MODRAN(50,-25)
         VS(0) = -R
         VS(1) = R
         B0 = R*4                       ;! FOR CONVENIENCE
         T1 = 0
         S1 = 400
         X1 = 0
         C0 = 8
         P1 = 10
         R = MODRAN(-500,2000)
         FL(0) = 0
         FL(1) = 0
         Z(5) = 100
         Z(6) = 100
         Z(7) = 100
         Z(8) = 100
! RETURN POINT FOR EACH KLINGON MOVE
         %WHILE R < 2000 %CYCLE
RETURN:

            PRINTSTRING('Bearing')
            WRITE(B0,4)
            PRINTSTRING(' Degrees. Range')
            WRITE(R,5)
            PRINTSTRING(' MGM  Star Date')
            PR100(STARDATE)
            NEWLINE
! RETURN POINT FOR EACH MOVE
NEXTCOMM:
!COMMAND DECODING
            STARDATE = STARDATE+5
            PROMPT('Orders:')
            K = READLINE
            %IF K!16 = ';' %THEN C = C0-1 %ELSESTART
                                        ! READLINE(':') = ;
               %IF K < 17 %THEN C = K-1 %ELSESTART
                  C = 0
                  C = C+1 %WHILE C < 16 %AND K # CIS(C)
               %FINISH
               C0 = C+1
            %FINISH
            %IF C0 > 16 %START
COM:
               PRINTSTRING('what ??
')
               C = 0
            %FINISH
            -> SW(C) %IF 6 <= C <= 11
            -> KLSM %IF C > 0
            -> RETURN
!TURN
SW(7):
            %IF X0 < 4 %START
               PROMPT('Degrees:')
               J = TESTDRAINN READ
               -> COM %IF IMOD(J) > 180
               B0 = B0+J
               B0 = B0+360*MSIGN(B0) %IF IMOD(B0) > 180
               -> RETURN
            %FINISH
SW(10):
!CHANCES
            TO 90 (B0)
            I = X0
            R9 = R
            %WHILE I < 3 %CYCLE
               I = I+1
               PRINTSTRING(WEAP(I))
               PRINTSTRING(' =')
               PRINT(TCHFN(I)*100,1,2)
               NEWLINE
            %REPEAT
            -> NEXTCOMM %IF X0 < 4
SW(6):
! MOVE
            PRINTSTRING(COMPDIS) %AND -> NEXTCOMM %IF X0 = 4
            SPEED(0)
            PROMPT('MGM ?')
            K = TESTDRAIN N READ
            I = READLINE %IF NEXTSYMBOL # NL
            -> NEXTCOMM %IF K < 0
            K = K*50 %IF I = 'X'
                                        ! 'X' IS READLINE ('W')
            M0 = K
            M0 = J %IF M0 > J
            -> KLD
SW(11):
! COMMAND
            STARCOMM
            -> NEXTCOMM
SW(9):
! SHIELDS
            S = CHSHIELD(1)
            %IF S = 0 %THEN PRINTSTRING( %C
               'unable to set shields') %ELSE %START
               PRINTSTRING('Shield')
               WRITE(S,3)
            %FINISH
            NEWLINE
            -> NEXTCOMM
SW(8):
! DAMAGES
            PRINTSTRING('
shield strength

SHIELD  ENTERPRISE  KLINGON
')
            %CYCLE I = 1,1,4
               WRITE(I,3)
               WRITE(Z(I),9)
               WRITE(Z(I+4),10)
               NEWLINE
            %REPEAT
            PRINTSTRING('index')
            WRITE(S0//4,8)
            WRITE(S1//4,10)
            PRINTSTRING('
approx R')
            WRITE(S0+100,5)
            WRITE(S1+100,10)
            PRINTSTRING('

Weapon and engine status

')
            %CYCLE I = 0,1,1
               PRINTSTRING('-----')
               PRINTSTRING(N(I))
               PRINTSTRING('-----

')
               K = EX(I)
               %IF K = 4 %THEN PRINTSTRING(COMPDIS) %ELSE %START
                  J = K
                  AWD(J) %AND J = J-1 %WHILE J # 0
                  SPEED(I)
                  %IF K < 3 %START
                     WRITE(PR(I),2)
                     PRINTSTRING(' Probes remaining

')
                  %FINISH
               %FINISH
            %REPEAT
            -> RETURN
! SUICIDE OR SURRENDER
KLSM:
            PROMPT('Sure?')
            -> RETURN %IF C0 > 14 %AND READLINE # YES
                                        ! KLINGON DECISION SECTION
            M0 = 25
KLD:
            M1 = VEL(1)
            M1 = 25 %IF M1 < 25
            C1 = 4
            RB1 = -1
            %IF X1 > 1 %START
               %IF X1 > 2 %START
                  %IF R < S1+50 %THEN C1 = 0 %ELSE %START
                     %IF X1 = 4 %THEN M1 = 0 %ELSE %START
                        RB1 = 1 %IF R >= 700
                     %FINISH
                  %FINISH
               %FINISH %ELSE %START
                  %IF R >= 800 %THEN %START
                     T1 = MODRAN(2,0) %IF T1 = 0
                     RB1 = 1 %IF T1 = 2
                  %FINISH %ELSE %START
                     T1 = 0
                     C1 = 3
                  %FINISH
               %FINISH
            %FINISH %ELSE CHWEAP
            M1 = 25 %UNLESS C1 = 4
            I = B0
            I = I+360 %IF I < 0
            CS = I*U3
            I = M1*RB1
            A = 1
            %CYCLE
               RAI = R+A*I
               X3 = RAI*COS(CS)-A*M0
               Y3 = RAI*SIN(CS)
               B = INT(ARCTAN(X3,Y3)/U3)
               R9 = INT(SQRT(X3*X3+Y3*Y3))
               %EXIT %IF A # 1
               B0 = B
               J = R9
               A = RANDOMREAL
            %REPEAT
            R = J
            STARDATE = MODRAN(10,STAR DATE+20)
            -> SW(ENTERHM)
SW(0):
            PRINTSTRING('He missed
')
SW(1):
            %CYCLE I = 0,1,1
               X == EX(I)
               %IF ES(I) <= TST(X)*4 %START
                  X = X+1
                  PRINTSTRING(N(I))
                  SPACE
                  %IF X < 4 %THEN AWD(X) %ELSE PRINTSTRING(COMPDIS)
               %FINISH
               X = 3 %IF X = 2 %AND PR(I) = 0
            %REPEAT
         %REPEAT
SW(2):
         PRINTSTRING('
Contact with klingon broken
')
         -> FINISH %IF RANDOMREAL >= .2
         PRINTSTRING('another')
      %REPEAT
SW(3):

      KILL(0)
      -> ESUI %IF C1 # 0
      C0 = 0
SW(4):

      PRINTSTRING('Klingon is initiating self-destruction
') %C
         %IF C1 = 0
      KILL(1)
ESUI: PRINTDES(J) %IF C0 # 0 %AND R >= R9*100
SW(5):

FINISH:

      PRINTSTRING('
 The game is at an end
The engagement lasted')
      PR100(STARDATE-STD)
      PRINTSTRING(' hrs
')
      PROMPT('Again:')
      I = READLINE %WHILE YES # I # M'NQ'
      STD = MODRAN(5000,STARDATE)
   %REPEAT
!***********************************************************************
!************   END OF MAIN PROGRAM LEVEL *****************************
!***********************************************************************

   %ROUTINE SPEED(%INTEGER S)
      J = VEL(S)
      PRINTSTRING('Maximum speed')
      WRITE(J,4)
      PRINTSTRING(' MGM/move
')
   %END

   %ROUTINE AWD(%INTEGER I)
      PRINTSTRING('all ') %IF I < 3
      PRINTSTRING(WEAP(I))
      PRINTSTRING(' dead
')
   %END

   %ROUTINE PRINTDES(%INTEGER I)
      NEWLINE
      PRINTSTRING(N(I))
      PRINTSTRING(' destroyed')
      PRINTSTRING('..you are dead.') %IF I = 0
   %END

   %ROUTINE KILL(%INTEGER I)
      PRINTDES(I)
      PRINTSTRING('
explosion radius')
      R = MODRAN(10000,125*ES(I))
      PR100(R)
      PRINTSTRING(' MGM
')
      J = I!!1
   %END

   %ROUTINE TO 90(%INTEGER BR)
      B = IMOD(BR-INT(BR/90)*90)
   %END

   %INTEGERFN VEL(%INTEGER I)
      %RESULT = (ES(I)-140)*(400+VS(I))//260
   %END

   %REALFN TCHFN(%INTEGER C)
   %INTEGER R
   %REAL CS
      %IF C = 3 %START
         CS = (1500-R9)/2500
         %RESULT = CS*CS*CS %IF CS >= 0
      %FINISH
      R = R9-300*C+100
      %RESULT = 0 %IF IMOD(R) >= 200
      %RESULT = (1-R*R/40000)*SIN((90-B)*U3)*(1-(B//45)/(2*C+1))
   %END

   %INTEGERFN CHSHIELD(%INTEGER L)
      C = 50
      %CYCLE I = L,1,L+3
         J = Z(I)
         L = I %AND C = J %IF C < J
      %REPEAT
      %RESULT = 0 %IF C = 50
      %RESULT = L
   %END

   %INTEGERFN ENTERHM

      %INTEGERFN HOWHIT(%INTEGER C, I, K)
         %RESULT = 0 %IF C = 6
         K = MODRAN(3,1) %IF K <= 0
         X == Z(K+I*4)
         PRINTSYMBOL('A')
         %IF RANDOMREAL < .2 %THEN J = 2 %C
            %AND PRINTSTRING(' direct') %ELSE J = 1
         PRINTSTRING(' hit on shield')
         WRITE(K,1)
         %RESULT = 0 %IF X = 0
         J = (3+I)*(7-C)*J
         J = INT(J*(RANDOMREAL+.1))
         J = X %AND PRINTSTRING(' which is gone') %IF X < J
         X = X-J
         ES(I) = ES(I)-J
         NEWLINE
         %RESULT = 1
      %END
   %CONSTSTRING (35) %ARRAY NSI(0 : 1) =  %C
'klingon withdrawing at top speed !!','Klingon accepted surrender'
   %CONSTSTRING (18) %ARRAY SI(0 : 1) =  %C
 'bluff failed
','surrender ignored
'
   %SWITCH SW(0 : 4)
      %IF C0 > 6 %START
         I = C0//15
         %IF C0&2 # 0 %START
            %RESULT = 3 %IF I # 0
         %FINISH %ELSE %START
            %RESULT = 4 %IF C1 = 0
            %IF FL(I) = 0 %START
               FL(I) = 1
               %IF I = 0 %AND X1 = 4 %THEN PRINTSTRING( %C
                  'Klingon cannot move ') %ELSE %START
                  K = I*3+2
                  PRINTSTRING(NSI(I)) %AND %RESULT = K %C
                     %IF MODRAN(-10,K) > 0
               %FINISH
            %FINISH
            PRINTSTRING(SI(I))
         %FINISH
      %FINISH %ELSE %START
         C = C0//2
         %IF X0 >= C %THEN AWD(C) %ELSE %START
            %IF C = 3 %START
               %IF P0 = 0 %THEN PRINTSTRING('no more probes
') %C
                  %AND C = 0 %ELSE P0 = P0-1
            %FINISH %ELSE %START
               B = IMOD(B+180*MSIGN(B)*(C0&1))
               PRINTSTRING('incorrect angle
') %AND C = 0 %C
                  %IF B >= 90
            %FINISH
            %IF C # 0 %START
               %IF RANDOMREAL < TCHFN(C) %START
                  %RESULT = 4 %IF HOWHIT(C0,1,CHSHIELD(5)-4) = 0
               %FINISH %ELSE PRINTSTRING('you missed
')
            %FINISH
         %FINISH
      %FINISH
      -> SW(C1)
SW(0): %RESULT = 4
SW(3):P1 = P1-1
SW(1):

SW(2):TO 90(B)
      PRINTSTRING('Klingon firing ')
      PRINTSTRING(WEAP(C1))
      NEWLINE
      %RESULT = 0 %IF RANDOMREAL >= TCHFN(C1)
      %RESULT = 3 %IF HOWHIT(C1*2,0,S) = 0
SW(4): %RESULT = 1
   %END

   %ROUTINE CHWEAP
   %SWITCH KL(0 : 3)
      -> KL(X0&3)
KL(0):
      %IF R <= 1000 %START
         %IF R > 350+X1*50 %THEN C1 = 2 %ELSE %START
            %IF X1 = 0 %THEN C1 = 1 %ELSE RB1 = 1
         %FINISH
      %FINISH
      %RETURN
KL(1):
      %IF X1 # 0 %START
         %IF 300 <= R <= 1000 %THEN C1 = 2 %ELSE %START
            RB1 = 1 %IF RANDOMREAL < .5
         %FINISH
      %FINISH %ELSE %START
         C1 = 2 %IF 125+S0 < R <= 700
         C1 = 1 %IF R < 125
      %FINISH
      %RETURN
KL(2):
      %IF R < 450 %THEN RB1 = 1 %ELSE %START
         %IF R <= 750 %THEN C1 = 2 %ELSE %START
            K = R-550
            M1 = K %IF K < M1
         %FINISH
      %FINISH
      %RETURN
KL(3):
      %IF X1 = 0 %THEN K = S0+50 %ELSE K = 375
      %IF R < K %THEN RB1 = 1 %ELSE %START
         %IF R < 375 %THEN C1 = 1 %ELSE %START
            %IF 550 < R < 725 %OR R < X1*450 %START
               %IF (RANDOMREAL-.3)*P1 < 0 %THEN C1 = 3 %ELSE C1 = 2
            %FINISH
         %FINISH
      %FINISH
   %END
%END


%EXTERNALROUTINE STARINST(%STRING (63) K)
   K = '.OUT' %IF K = ''
   DEFINE('01,'.K)
   SELECTOUTPUT(1)


PRINTSTRING(%C
"This game simulates a battle between the starship Enterprise and one or
more Klingon starships. The object of the game is to destroy the
Klingon ship with as little damage to the Enterprise as possible.
Likewise, the Klingon is trying to destroy the Ente")
PRINTSTRING("rprise with as
little damage to his own ship as possible. Both ships have equal
weapons and approximately equal top speed.  Defensive abilities are
also roughly equal.  Weapons and defenses are described below:

                     WEAPONS


Type      ")
PRINTSTRING("ange(MGM)   effective   relative    # shots
                        angle     strength   available
Phaser    0-400       MOD(A)<90      5       Infinite
phaser    0-400       MOD(A)>90      4       Infinite
torpedo   300-700     MOD(A)<90      3       Inf")
PRINTSTRING("inite
torpedo   300-700     MOD(A)>90      2       Infinite
probe     0-1500         all      Infinite      10

Phaser and Torpedo hits are more likely when the range is nearest to 200
and 500 MGM, respectively, and when the bearing of the Klingon is
near")
PRINTSTRING(%C
"est to 0, -180, or 180 degrees. The possibility of a probe hit
depends only on the range. (A probe hit always results in total
destruction of the ship it hits and may destroy the other ship).
 The radius of the explosion resulting from either a suicide or")
PRINTSTRING(" a probe
hit is roughly proportional to the average shield strength of the
destroyed vessel.  Since it may be as large as 600 MGM, both ships may
be destroyed by the same explosion.

                     DEFENSES

Each ship has four shields which absorb t")
PRINTSTRING("he energy to the severity of
the hit.  A direct hit is twice as powerful as the average hit.
The shield which is hit is determined randomly unless the shields
command has been given.  This command causes the strongest shield to be
placed toward the Klingo")
PRINTSTRING("n and to be kept facing the Klingon until
another shields command is given.  A hit on a zero strength shield
results in total destruction.

                     MOVEMENT

Each vessel moves in the direction it is pointing up to the maximum
distance possibl")
PRINTSTRING("e for it. (Maximum movement distance depends on average
shield strength).  This usually causes no problem since a ship may be
turned any number of degrees without penalty.  However, a ship may not
move and fire in the same turn.  Also, when a ship does no")
PRINTSTRING("t move
voluntarily, inertia carries it 25 MGM per turn in the direction it is
facing.

                     COMMANDS

The commands RANGE (1), TURN (8), DAMAGE (9), SHIELDS (10), CHANCES
(11), AND COMMANDS (12) are free moves, that is, the Klingon does not")
PRINTSTRING("
take his turn after one of these commands is given. All other commands
cost a turn. The BLUFF (13) and the SURRENDER (16) commands always fail
when they are given more than once in a game. If you wish to repeat a
command, type a '*'. If you give the MOVE")
PRINTSTRING(" (7) command and decide that
you really want to give a different command, type any negative number
and then type the correct command. If you type the value followed by a
'W' this warp factor is converted to MGM  1 W = 50 MGM.


")

STARCOMM
SELECTOUTPUT(0)
CLOSESTREAM(1)
CLEAR("1")
%END

%ENDOFFILE