startrek.rou

STAR* Startrek Routines
 2-May-90, 14:30
STARCOM
STARCOM ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 3:16PM;
 W !
 I D(8)<0 W !,"COMPUTER DISABLED!",! G 1990^STARTR1
 I OPT'="" S A=OPT G 7320+1
7320 R !,"COMPUTER ACTIVE AND AWAITING COMMAND: ",A,!
 S H8=1 G:(A<1!(A>7)) 7360
 G @$P("7540,7900,^STARSUB,8500,8150^STARSUB,7400,2060^STARTR1",",",A)
7360 W !,"FUNCTIONS AVAILABLE FROM LIBRARY-COMPUTER:"
 W !,"   1 = CUMULATIVE GALACTIC REPORT"
 W !,"   2 = STATUS REPORT"
 W !,"   3 = PHOTON TORPEDO DATA"
 W !,"   4 = STARBASE NAV DATA"
 W !,"   5 = DIRECTION/DISTANCE CALCULATOR"
 W !,"   6 = GALAXY 'REGION NAME' MAP"
 W !,"   7 = NEW COMMAND",! G 7320
7400 S H8=0,G5=1 W #!!?25,"THE GALAXY" G 7550
 ;
7540 W #!!?9,"COMPUTER RECORD OF GALAXY FOR QUADRANT ",Q1,",",Q2
7550 W !!,?9 F I=1:1:8 W I,"     "
 S O1D="      +-----+-----+-----+-----+-----+-----+-----+-----+"
 W !,O1D F I=1:1:8 D LOOP W !,O1D
 W ! G 1990^STARTR1
LOOP W !?4,I I H8=0 G 7740
 F J=1:1:8 D LIN
 W " " Q
7740 S Z4=I,Z5=1 D 9030^STARSUB S J0=(19.9-(.5*$L(G2D)))\1 W ?6,"",?J0,G2D,?31,""
 S Z5=5 D 9030^STARSUB S J0=(44.9-(.5*$L(G2D)))\1 W ?J0,G2D,?56,"" Q
LIN W "   " I Z(I,J)=0 W "***" Q
 S SY2=Z(I,J)\10 I 'SY2 W "   " Q
 S SY1=SY2\10,SY2=SY2#10
 ;W $S(SY1=1&'SY2:"+K+",SY1&'SY2:"+"_SY1_"+",SY2&'SY1:">B<",SY1=1&SY2:"!K!",1:"!"_SY1_"!") Q
 I SY1=1 W $S(SY2:"!K!",1:"+K+") Q
 I SY1 W $S(SY2:"!"_SY1_"!",1:"+"_SY1_"+") Q
 W:SY2 ">B<" Q
 ;
7900 W !,"   STATUS REPORT:" S XD="" I K9>1 S XD="S"
 W !,"KLINGON",XD," LEFT: ",K9
 W !,"MISSION MUST BE COMPLETED IN ",.1*((T0+T9-T)*10\1)," STARDATES."
 S XD="S" I B9<2 S XD="" I B9<1 G 8010
 W !,"THE FEDERATION IS MAINTAINING ",B9," STARBASE",XD," IN THE GALAXY." G ^STARDAM
8010 W !,"YOUR STUPIDITY HAS LEFT YOU ON YOUR OWN IN"
 W !,"  THE GALAXY -- YOU HAVE NO STARBASES LEFT" G ^STARDAM
 ;
8500 I B3'=0 W "FROM THE U.S.S. ",SHNM," TO STARBASE" S W1=B4,X=B5 G 8120^STARSUB
 W "MR. SPOCK REPORTS,  'SENSORS SHOW NO STARBASES IN THIS"
 W " QUADRANT.'" G 1990^STARTR1 Q

STARDAM
STARDAM ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 3:12PM;
 W !
 I D(6)'<0 G 5910
 W !,"DAMAGE CONTROL REPORT NOT AVAILABLE!",! I D0=0 G 1990^STARTR1
5720 ;
 S D3=0 F I=1:1:8 I D(I)<0 S D3=D3+.1
 I D3=0 G 1990^STARTR1
 W ! S D3=D3+D4
 W !,"TECHNICIANS STANDING BY TO EFFECT REPAIRS TO YOUR SHIP;"
 W !,"ESTIMATED TIME TO REPAIR: ",.01*((100*D3)\1)," STARDATES."
 R !,"WILL YOU AUTHORIZE THE REPAIR ORDER (Y/N)? ",AD
 I AD'="Y" G 1990^STARTR1
 F I=1:1:8 I D(I)<0 S D(I)=0
 S T=T+D3+.1
5910 W !,"DEVICE",?20,"STATE OF REPAIR" F R1=1:1:8 D LOOP
 W ! I D0'=0 G 5720
 G 1990^STARTR1
LOOP W ! D 8790 W G2D,?25,D(R1)*100\1*0.01
 Q
8790 Q:(R1<1!(R1>8))  S G2D=$P($T(LIST+R1),";",2) Q
LIST ;
 ;WARP ENGINES
 ;SHORT RANGE SENSORS
 ;LONG RANGE SENSORS
 ;PHASER CONTROL
 ;PHOTON TUBES
 ;DAMAGE CONTROL
 ;SHIELD CONTROL
 ;LIBRARY-COMPUTER

STARDES
STARDES ;RLM,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;6AUG85 5:08PM;SELF DESTRUCT SEQUENCE
 W !,"SELF DESTRUCT SEQUENCE ENGAGED",*7,!!,"STANDBY FOR RETINA SCAN . . .  " H 3
 W ?32,"IDENTITY CONFIRMED, CAPTAIN.",!! H 2 W "TWENTY SECOND COUNTDOWN BEGINNING",!
 W ?5,"(SEQUENCE CANNOT BE ABORTED DURING FINAL FIVE SECONDS.)",!
 F LOOP=20:-1:6 W ?20,LOOP,! R TA#1:1 G:$T ABORT
 B 0
 F LOOP=5:-1:1 W ?20,LOOP,! H 1
 B 1 W ?25,"SEQUENCE COMPLETE",!!
BANG W "THE ",SHNM," EXPLODES... YOU SCREAM AS YOUR FACE MELTS PAINFULLY AND YOUR",!,"CREW SUCKS VACUUM. ",! H 2 S SHNM="" G:K3'=K9 MORE
 W "ALL REMAINING KLINGONS HAVE BEEN DESTROYED AND THE FEDERATION HAS BEEN SAVED!",!! H 1
 W "STAR FLEET IS BUILDING A STATUE IN YOUR HONOR",!
 W ?5,"(REST IN PEACE AND TRY NOT TO WORRY ABOUT PIGEONS.)",! H 2
 S K9=K9-K3 G 6400^STARXXX
MORE S K9=K9-K3 G 6240^STARXXX
ABORT W !,"SEQUENCE ABORTED",! G 1990^STARTR1

STARLRS
STARLRS ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 1:22PM;
 W !
 I D(3)<0 W !,"LONG RANGE SENSORS ARE INOPERABLE!",! G 1990^STARTR1
 W !,"LONG RANGE SCAN FOR QUADRANT ",Q1,",",Q2
 S O1D="-------------------" W !,O1D
 F I=Q1-1:1:Q1+1 S N(1)=-1,N(2)=-2,N(3)=-3 D 4120
 W ! G 1990^STARTR1
4120 F J=Q2-1:1:Q2+1 I (I>0)&(I<9)&(J>0)&(J<9) S (N(J-Q2+2),Z(I,J))=G(I,J)
 W ! F L=1:1:3 W ": " D 4190
 W ":",!,O1D Q
4190 I N(L)<0 W "*** " Q
 S NL=(N(L)+1000) W $E(NL,$L(NL)-2,$L(NL))," " Q

STARNAV
STARNAV ;STARNAV,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 12:18PM;
 G:OPT="" 2300 S C1=OPT S:C1=9 C1=1 I C1<1!(C1'<9) G 2330
 G:OPT2="" 2350 S W1=OPT2 G 2370
2300 R !,"COURSE (1-8) ",C1 G:C1="" 1990^STARTR1 I C1?1"?" D HELP G 2300
2330 I '((C1>0)&(C1<9)) W !!,"   MR. SULU REPORTS, 'INCORRECT COURSE DATA, SIR!'" W ! G 2300
2350 S XD="8" I D(1)<0 S XD="0.2"
 W !,"WARP FACTOR (0-",XD,") " R W1
2370 I (D(1)<0)&(W1>.2) G 2470
 I (W1>0)&(W1'>8) G 2490
 I W1=0!(W1="") W ! G 1990^STARTR1
 W !!?3,"CHIEF ENGINEER SCOTT REPORTS 'THE ENGINES WON'T TAKE"
 W " WARP ",W1,"!'" W ! G 1990^STARTR1
2470 W !!,"WARP ENGINES ARE DAMAGED.  MAXIMUM SPEED = WARP 0.2" W ! G 1990^STARTR1
2490 S N=W1*8+.5\1 I E-N'<0 W # G ^STARTR2 ;   MANEUVER ALLOWED
 W !!,"ENGINEERING REPORTS   'INSUFFICIENT ENERGY AVAILABLE"
 W !?20,"FOR MANEUVERING AT WARP ",W1,"!'"
 I (S<(N-E))!(D(7)<0) W ! G 1990^STARTR1
 W !,"DEFLECTOR CONTROL ROOM ACKNOWLEGES ",S," UNITS OF ENERGY"
 W !?20,"PRESENTLY DEPLOYED TO SHIELDS.",! G 1990^STARTR1
 ;
 ;   COURSE DIRECTIONS
HELP W !?10,"3",!
 W ?6,"4",?10,"|",?14,"2",!
 W ?8,"\ | /",!
 W ?4,"5 --- * --- 1",!
 W ?8,"/ | \",!
 W ?6,"6",?10,"|",?14,"8",!
 W ?10,"7",! Q

STARPHA
STARPHA ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 1:34PM;
 W !
 I D(4)<0 W !,"PHASERS INOPERATIVE!" G 1990^STARTR1
 I K3>0 G 4330
4270 W !,"SCIENCE OFFICER REPORTS  'SENSORS SHOW NO ENEMY SHIPS"
 W !,"                         IN THIS QUADRANT.'" G 1990^STARTR1
4330 I D(8)<0 W !,"COMPUTER FAILURE HAMPERS ACCURACY."
 I OPT'="" S X=OPT G 4370+1
 W !,"PHASERS LOCKED ON TARGET;  "
4360 W "ENERGY AVAILABLE = ",E," UNITS"
4370 R !,"NUMBER OF UNITS TO FIRE: ",X
 I X'>0 G 1990^STARTR1
 I E-X<0 W ! G 4360
 S E=E-X I D(8)<0 S X=$R(1000)/1000*X ;   COMPUTER FAILURE FACTOR
 S H1=X/K3\1,I=1
4450 I K(I,3)'>0 G 4670
 D FND^STARTREK S H=H1/FND*($R(1000)/1000+2)\1
 I H>(.15*K(I,3)) G 4530
 W !,"SENSORS SHOW NO DAMAGE TO ENEMY AT ",K(I,1),",",K(I,2),! G 4670
4530 S K(I,3)=K(I,3)-H W !,H," UNIT HIT ON KLINGON AT SECTOR ",K(I,1),","
 W K(I,2) I K(I,3)'>0 W !,*7,"*** KLINGON DESTROYED ***",*7,! G 4580
 W !,"   (SENSORS SHOW ",K(I,3)+.999\1," UNITS REMAINING)",! G 4670
4580 S K3=K3-1,K9=K9-1,Z1=K(I,1),Z2=K(I,2),AD="   " D INSRT^STARTR1
 S K(I,3)=0,G(Q1,Q2)=G(Q1,Q2)-100,Z(Q1,Q2)=G(Q1,Q2) I K9'>0 G 6370^STARXXX
4670 S I=I+1 I I<4 G 4450
 S GG=0 D 6000^STARTR2 Q:GG  G 1990^STARTR1

STARSHE
STARSHE ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;3MAR84 4:45PM;
 W !
5530 I D(7)<0 W !,"SHIELD CONTROL INOPERABLE!",! G 1990^STARTR1
 I OPT'="" S X=OPT G 5580
5560 W !,"ENERGY AVAIABLE = ",E+S\1,". NUMBERS OF UNITS TO SHIELDS: " R X
5580 I (X<0)!(S=X) W !,"      <SHIELDS UNCHANGED>",! G 1990^STARTR1
5590 I X'>(E+S) G 5630
5600 W !,"SHIELD CONTROL REPORTS  'THIS IS NOT THE FEDERATION TREASURY.'"
5610 W !,"      <SHIELDS UNCHANGED>",! G 1990^STARTR1
5630 S E=E+S-X,S=X W !,"DEFLECTOR CONTROL ROOM REPORT:"
5660 W !,"  'SHIELDS NOW AT ",S\1," UNITS PER YOUR COMMAND.'",! G 1990^STARTR1
 Q

STARSRS
STARSRS ;G,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 1:21PM;SHORT RANGE SENSORS
SRS W !! I CD="DOCKED" D 6720 G 2060^STARTR1
 D 6650 G 2060^STARTR1
 ;
 ;   CHECK FOR <*> NEXT TO >B< -- "DOCKED"
6430 S I=S1-1
6431 S J=S2-1
6450 I (I+.5)\1<1!((I+.5)\1>8)!((J+.5)\1<1)!((J+.5)\1>8) G 6540
 S AD=">B<",Z1=I,Z2=J D COMP^STARTR1 I Z3=1 G 6580
6540 S J=J+1 I J'>(S2+1) G 6450
 S I=I+1 I I'>(S1+1) G 6431
 S D0=0 G 6650
6580 S D0=1,CD="DOCKED",E=E0,P=P0
 W "SHIELDS DROPPED FOR DOCKING PURPOSES",! S S=0 G 6730
 ;
6650 S CD=$S(K3>0:"*RED*",E<(E0*.11):"YELLOW",1:"GREEN")
6720 D REPSRS
6730 I D(2)<0 W !!,"*** SHORT RANGE SENSORS ARE OUT ***",! Q
 ;   DISPLAY CURRENT SECTOR
 W !,?43,"STARDATE           ",T*10\1*.1,!
 W "  _________________________________"
 F I=1:1:8 D TAB
 W !,"  |_______________________________|",! S D(2)=D(2)+TEMP,TEMP=0 Q
 ;
TAB W !,"  |" F J=(I-1)*24+1:3:(I-1)*24+22 W $E(QD,J,J+2)," "
 W *8,"|" G @$P("6850,6900,6960,7020,7070,7120,7180,7240",",",I)
6850 W "        DATES REMAINING    " S TT=T0+T9-T W 10*TT\1/10,! D SEP
 I TT<K9!(TT<3) W *7 H 1
 Q
6900 W "        CONDITION          ",CD,! D SEP Q
6960 W "        QUADRANT            ",Q1,",",Q2,! D SEP Q
7020 W "        SECTOR              ",S1,",",S2,! D SEP Q
7070 W "        PHOTON TORPEDOES    ",P\1,! D SEP Q
7120 W "        TOTAL ENERGY        ",(E+S)\1,! D SEP Q
7180 W "        SHIELDS             ",S\1,! D SEP Q
7240 W "        KLINGONS REMAINING   ",K9\1 Q
SEP W "  |   .   .   .   .   .   .   .   |" Q
 ;
REPSRS Q:(D(2)>0!(D(2)=0))  S TEMP=D(2),D(2)=D(2)+$R(4) I D(2)<0 Q
 W !!,"MR. SPOCK MADE A TEMPORARY REPAIR OF THE SHORT RANGE SENSORS",! Q

STARSUB
STARSUB ;GSB,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 3:20PM;DIRECTION / DISTANCE CALCULATOR & QUADRANT NAMES
 I K3'>0 G 4270^STARPHA
 S XD="",H8=0,I=1 S:K3>1 XD="S" W "FROM THE U.S.S. ",SHNM," TO KLINGON BATTLE CRUISER",XD
8100 G:(K(I,3)'>0) 8480 S W1=K(I,1),X=K(I,2)
8120 S C1=S1,A=S2,X=X-A,A=C1-W1 G 8220
8150 W "DIRECTION/DISTANCE CALCULATOR:"
 W !,"YOU ARE IN SECTOR ",S1,",",S2," IN QUADRANT ",Q1,",",Q2
RS R !,"PLEASE ENTER FINAL SECTOR (X,Y): ",SVAR1 I SVAR1="" S SVAR1=S1_","_S2 W SVAR1
 I SVAR1'?1N1","1N G RS
RQ R " IN QUADRANT (X,Y) ",SVAR2 I SVAR2="" S SVAR2=Q1_","_Q2 W SVAR2
 I SVAR2'?1N1","1N W ! G RQ
 S A=8*Q1+S1-(8*$P(SVAR2,",",1)+$P(SVAR1,",",1))
 S X=8*$P(SVAR2,",",2)+$P(SVAR1,",",2)-(8*Q2+S2) K SVAR1,SVAR2
8220 S ABSA=A I A<0 S ABSA=-A
 S ABSX=X I X<0 S ABSX=-X
 I ABSA+ABSX=0 W !,"DIRECTION = ANY" G 8460+1
 I X<0 G 8350
 I A<0 G 8410
 I X>0 G 8280
 I A=0 S C1=5 G 8290
8280 S C1=1
8290 I ABSA'>ABSX G 8330
 W !,"DIRECTION = " S C1=C1+2-(ABSX/ABSA) G 8460
8330 W !,"DIRECTION = " S C1=C1+(ABSA/ABSX) G 8460
8350 I A>0 S C1=3 G 8420
 I X'=0 S C1=5 G 8290
8410 S C1=7
8420 I ABSA'<ABSX G 8450
 W !,"DIRECTION = " S C1=C1+2-(ABSA/ABSX) G 8460
8450 W !,"DIRECTION = " S C1=C1+(ABSX/ABSA)
8460 S:ABSA<ABSX ABSA=ABSX W 1000*C1+.5\1/1000
 W !,"DISTANCE = ",ABSA/8,! K ABSA,ABSX I H8=1 G 1990^STARTR1
8480 S I=I+1 G:(I>3) 1990^STARTR1 G 8100
 ;
9030 G:Z5>4 9120 G @$P("9040,9050,9060,9070,9080,9090,9100,9110",",",Z4)
9040 S G2D="POLARIS" G 9210 ;   URSA MINOR, THE LITTLE DIPPER
9050 S G2D="DENEB" G 9210 ;   CYGNUS, THE SWAN
9060 S G2D="VEGA" G 9210 ;   LYRA, THE LYRE
9070 S G2D="ARCTURUS" G 9210 ;   BOOTES, THE HERDSMAN
9080 S G2D="REGULUS" G 9210 ;   LEO, THE LION
9090 S G2D="PROCYON" G 9210 ;   CANIS MINOR, THE LITTLE DOG
9100 S G2D="RIGEL" G 9210 ;   ORION, THE HUNTER
9110 S G2D="ALDEBARAN" G 9210 ;   TAURUS, THE BULL
9120 G @$P("9130,9140,9150,9160,9170,9180,9190,9200",",",Z4)
9130 S G2D="FOMALHAUT" G 9210 ;   PISCIS AUSTRINUS, THE SOUTHERN FISH
9140 S G2D="ALTAIR" G 9210 ;   AQUILA, THE EAGLE
9150 S G2D="ANTARES" G 9210 ;   SCORPIUS, THE SCORPION
9160 S G2D="SPICA" G 9210 ;   VIRGO, THE VIRGIN
9170 S G2D="ALPHA, CRUX" G 9210 ;   CRUX, THE SOUTHERN CROSS
9180 S G2D="ALPHARD" G 9210 ;   HYDRA, THE WATER MONSTER
9190 S G2D="SIRIUS" G 9210 ;   CANIS MAJOR, THE BIG DOG
9200 S G2D="MIRA" ;   CETUS, THE WHALE
9210 S:(G5'=1) G2D=G2D_" "_$P("IV,I,II,III",",",Z5#4+1) Q

STARTOR
STARTOR ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 1:39PM;
 W !
 I D(5)<0 W !,"PHOTON TUBES ARE NOT OPERATIONAL!",! G 1990^STARTR1
 I P'>0 W !,"ALL PHOTON TORPEDOES EXPENDED!",! G 1990^STARTR1
 I OPT'="" S C1=OPT G 4770
4760 R !,"PHOTON TORPEDO COURSE (1-9) ",C1 I C1=9 S C1=1
 I C1="?" D HELP^STARNAV G 4760
4770 I C1'<1&(C1<9) G 4850
 W !,"ENSIGN CHEKOV REPORTS,  'INCORRECT COURSE DATA, SIR!",!
 G 1990^STARTR1
4850 S C1I=C1\1,X1=C(C1I,1)+((C(C1I+1,1)-C(C1I,1))*(C1-C1I)),E=E-2,P=P-1
 S X2=C(C1I,2)+((C(C1I+1,2)-C(C1I,2))*(C1-C1I)),X=S1,Y=S2
 W !,"TORPEDO TRACK:"
4920 S X=X+X1,Y=Y+X2,X3=X+.5\1,Y3=Y+.5\1
 I X3<1!(X3>8)!(Y3<1)!(Y3>8) G 5490
 W ?15,X3,",",Y3,! S AD="   ",Z1=X,Z2=Y D COMP^STARTR1
 I Z3'=0 G 4920
 S AD="+K+",Z1=X,Z2=Y D COMP^STARTR1 I Z3=0 G 5210
 W *7,"*** KLINGON DESTROYED ***",*7,! S K3=K3-1,K9=K9-1 I K9'>0 G 6370^STARXXX
 F I=1:1:3 I X3=K(I,1)&(Y3=K(I,2)) G 5190 ;   * * *  ?  * * *
 S I=3
5190 S K(I,3)=0 G 5430
5210 S AD=" * ",Z1=X,Z2=Y D COMP^STARTR1 I Z3=0 G 5280
 W !,"STAR AT ",X3,",",Y3," ABSORBED TORPEDO ENERGY.",! S GG=0 D 6000^STARTR2 Q:GG  G 1990^STARTR1
5280 S AD=">B<",Z1=X,Z2=Y D COMP^STARTR1 I Z3=0 G 4760
 W *7,"*** STARBASE DESTROYED ***",*7 S B3=B3-1,B9=B9-1
 I B9>0 G 5400
 W #!,"THAT DOES IT, CAPTAIN!!  YOU ARE HEREBY RELIEVED OF COMMAND"
 W !,"AND SENTENCED TO 99 STARDATES AT HARD LABOR ON CYGNUS 12!!",!
 G 6270^STARXXX
5400 W !,"STARFLEET COMMAND REVIEWING YOUR RECORD TO CONSIDER"
 W !,"COURT MARTIAL!",! S D0=0
5430 S Z1=X,Z2=Y,AD="   " D INSRT^STARTR1
 S G(Q1,Q2)=K3*100+(B3*10)+S3,Z(Q1,Q2)=G(Q1,Q2) S GG=0 D 6000^STARTR2 Q:GG  G 1990^STARTR1
5490 W !,"TORPEDO MISSED.",! S GG=0 D 6000^STARTR2 Q:GG  G 1990^STARTR1 Q

STARTR1
STARTR1 ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;21SEP85 6:37PM;
 S Z4=Q1,Z5=Q2,(K3,B3,S3,G5)=0,Z(Q1,Q2)=G(Q1,Q2) S D4=$R(5000)/1000 ;  0 TO 4
 I (Q1<1)!(Q1>8)!(Q2<1)!(Q2>8) G 1600
 D 9030^STARSUB W ! I T0'=T G 1490
 W "YOUR MISSION BEGINS WITH YOUR STARSHIP LOCATED"
 W !,"IN THE GALACTIC QUADRANT, '",G2D,"'.",!! G 1500
1490 W "NOW ENTERING ",G2D," QUADRANT . . .",!!
1500 S K3=G(Q1,Q2)\100,B3=G(Q1,Q2)\10-(10*K3)
 S S3=G(Q1,Q2)-(100*K3)-(10*B3) I K3=0 G 1590
 W "COMBAT AREA      CONDITION RED",*7,! W:S<200 ?3,"SHIELDS DANGEROUSLY LOW",!
1590 F I=1:1:3 S (K(I,1),K(I,2))=0
1600 F I=1:1:3 S K(I,3)=0
 S QD=ZD_ZD_ZD_ZD_ZD_ZD_ZD_$E(ZD,1,17) ;   CLEAR SECTOR
 S AD="<*>",Z1=S1,Z2=S2 D INSRT I K3<1 G 1820 ;   INSERT <*> STARSHIP
 F I=1:1:K3 D FIND S AD="+K+",Z1=R1,Z2=R2 D SUB ;   INSERT KLINGONS
1820 I B3>0 D FIND S AD=">B<",Z1=R1,B4=R1,Z2=R2,B5=R2 D INSRT ;   INSERT BASE
 F I=1:1:S3 D FIND S AD=" * ",Z1=R1,Z2=R2 D INSRT ;   INSERT STARS
 D 6430^STARSRS ;   DISPLAY CURRENT SECTOR
1990 I '(S+E>10)&((E>10)!(D(7)'<0)) G 2020^STARXXX
2060 R !,"COMMAND: ",ADPT S AD=$E(ADPT,1,3),OPT=$P(ADPT," ",2),OPT2=$P(ADPT," ",3) K ADPT
 S I=$F(A1D,AD)
 I (I-1)#3'=0!($L(AD)'=3) G 2160
 G:AD="LPP" 100^STARTREK S AD="^STAR"_AD G @AD
2160 W !!,"ENTER ONE OF THE FOLLOWING:",!
 W "  NAV  (TO SET COURSE)",!
 W "  SRS  (FOR SHORT RANGE SENSOR SCAN)",!
 W "  LRS  (FOR LONG RANGE SENSOR SCAN)",!
 W "  PHA  (TO FIRE PHASERS)",!
 W "  TOR  (TO FIRE PHOTON TORPEDOES)",!
 W "  SHE  (TO RAISE OR LOWER SHIELDS)",!
 W "  DAM  (FOR DAMAGE CONTROL REPORTS)",!
 W "  COM  (TO CALL ON LIBRARY COMPUTER)",!
 W "  DES  (SELF-DESTRUCT OF STARSHIP)",!
 W "  XXX  (TO RESIGN YOUR COMMAND)",!! G 1990
 ;
SUB D INSRT S K(I,1)=R1,K(I,2)=R2,K(I,3)=S9*($R(1000)/1000+.5) Q
FIND D FNR^STARTREK S (R1,Z1)=FNR D FNR^STARTREK S (R2,Z2)=FNR,AD="   "
 D COMP I Z3=0 G FIND
 Q
INSRT S S8=(Z2-.5)\1*3+((Z1-.5)\1*24)+1
 I $L(AD)'=3 W !,"ERROR" H
 I S8=1 S QD=AD_$E(QD,$L(QD)-188,$L(QD)) Q
 I S8=190 S QD=$E(QD,1,189)_AD Q
 S QD=$E(QD,1,S8-1)_AD_$E(QD,$L(QD)-(189-S8),$L(QD)) Q
COMP S Z1=(Z1+.5)\1,Z2=(Z2+.5)\1,S8=(Z2-1)*3+((Z1-1)*24)+1,Z3=0 I $E(QD,S8,S8+2)'=AD Q
 S Z3=1 Q

STARTR2
STARTR2 ;STARTR2,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1APR84 11:39AM;
 F I=1:1:K3 D SUB
 S (GG,D1)=0 D 6000 Q:GG  S D6=W1 I W1'<1 S D6=1
 F I=1:1:8 D SUB0
 I $R(10)>1 G 3070
 D FNR^STARTREK S R1=FNR I $R(10)>5 G 3000
 S D(R1)=D(R1)-($R(5000)/1000+1) G:D(6)<0 3070 D SUB1,SUB2
 D 8790^STARDAM W ?25,G2D,DA,! G 3070
3000 S D(R1)=D(R1)+($R(3000)/1000)+1 G:D(6)<0 3070 D SUB2
 D 8790^STARDAM W ?25,G2D," STATE OF REPAIR IMPROVED",!
3070 S AD="   ",Z1=S1\1,Z2=S2\1 D INSRT^STARTR1
 S X1=C(C1\1,1)+((C(C1\1+1,1)-C(C1\1,1))*(C1-(C1\1))),X=S1,Y=S2
 S X2=C(C1\1,2)+((C(C1\1+1,2)-C(C1\1,2))*(C1-(C1\1))),Q4=Q1,Q5=Q2,I=1
3170 S S1=S1+X1,S2=S2+X2 I (S1<1)!(S1'<9)!(S2<1)!(S2'<9) G ^STARTR3
 S S8=S1\1*24+(S2\1*3)-26 I $E(QD,S8,S8+1)="  " G 3360
 S S1=S1-X1\1,S2=S2-X2\1 W "WARP ENGINES SHUT DOWN AT "
 W "SECTOR ",S1,",",S2," DUE TO BAD NAVIGATION!",!! G 3370
3360 S I=I+1 I I'>N G 3170
 S S1=S1\1,S2=S2\1
3370 S AD="<*>",Z1=S1\1,Z2=S2\1 D INSRT^STARTR1,SUB3 S T8=1
 I W1<1 S T8=10*W1\1*.1
 S T=T+T8 I T>(T0+T9) G 6220^STARXXX
 D 6430^STARSRS G 1990^STARTR1
 ;
6000 I K3'>0 Q
 I D0'=0 W "STARBASE SHIELDS PROTECT THE U.S.S. ",SHNM,! Q
 S I=1
6040 I K(I,3)'>0 G 6200
 D FND^STARTREK S H=K(I,3)/FND*($R(1000)/1000+2)\1,S=S-H
 W !,H," UNIT HIT ON THE U.S.S. ",SHNM,"  FROM SECTOR ",K(I,1),",",K(I,2)
 S D1=0 I S'>0 S B9=0 H 3 D 6240^STARXXX S GG=1 Q
 W !,"      <SHIELDS DOWN TO ",S," UNITS>",! I H<20 G 6200
 I ($R(10)>5)!(H/S'>.02) G 6200 ;   BREAKS THINGS !!!
 D FNR^STARTREK S R1=FNR,D(R1)=D(R1)-(H/S)-($R(5000)/10000) D 8790^STARDAM
 G:D(6)<0 6200 D SUB1,SUB2 W ?25,G2D,DA," BY THE HIT",!
6200 S I=I+1 I I<4 G 6040
 Q
 ;
SUB I K(I,3)=0 Q
 S AD="   ",Z1=K(I,1),Z2=K(I,2) D INSRT^STARTR1,FIND^STARTR1
 S K(I,1)=Z1,K(I,2)=Z2,AD="+K+" D INSRT^STARTR1 Q
SUB0 I D(I)'<0 Q
 S D(I)=D(I)+D6 I (D(I)>-.1)&(D(I)<0) S D(I)=-.1 Q
 I D(I)<0 Q
 I D(6)<0 Q
 D SUB2 S R1=I D 8790^STARDAM W ?25,G2D," REPAIR COMPLETED",! Q
SUB1 S DA=" DAMAGED" S:D(R1)'<0 DA=" HURT" Q
SUB2 I D1=0 S D1=1 W "DAMAGE CONTROL REPORT:   " Q
 Q
SUB3 S E=E-N-10 I E'<0 Q
 W "SHIELD CONTROL SUPPLIES ENERGY TO COMPLETE MANEUVER.",! S S=S+E,E=0 I S'>0 S S=0
 Q

STARTR3
STARTR3 ;STARTR3,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;1SEP84 6:37AM;
 ;PRX;11Aug88 15:08;(c) Copyright 1986,1987 PRx, Inc. Concord, MA
 S X=8*Q1+X+(N*X1),Y=8*Q2+Y+(N*X2),Q1=X/8\1,Q2=Y/8\1,S1=X-(Q1*8)\1
 S S2=Y-(Q2*8)\1 I S1=0 S Q1=Q1-1,S1=8
 I S2=0 S Q2=Q2-1,S2=8
 S X5=0 I Q1<1 S X5=1,Q1=1,S1=1
 I Q1>8 S X5=1,Q1=8,S1=8
 I Q2<1 S X5=1,Q2=1,S2=1
 I Q2>8 S X5=1,Q2=8,S2=8
 I X5=0 G 3860
 W "LT. UHURA REPORTS MESSAGE FROM STARFLEET COMMAND:"
 W !,"  'PERMISSION TO ATTEMPT CROSSING OF GALACTIC PERIMETER"
 W !,"  IS HEREBY *DENIED*.  SHUT DOWN YOUR ENGINES.'" H 3
 W !,"CHIEF ENGINEER SCOTT REPORTS  'WARP ENGINES SHUT DOWN"
 W !,"  AT SECTOR ",S1,",",S2," OF QUADRANT ",Q1,",",Q2,".'",!
 I T>(T0+T9) G 6220^STARXXX
3860 I 8*Q1+Q2=(8*Q4+Q5) G 3370^STARTR2
 S T=T+1 G:T>(T0+T9) 6220^STARXXX D SUB3^STARTR2 G ^STARTR1 Q
 ;
 ;   NAME OF GAME
NAM S LM=8 W !!!
1 W ?(LM+3),"SSS",!
2 W ?(LM+2),"SSSSS    U   U  PPPP   EEEEE  RRRR",!
3 W ?(LM+1),"SSS SSS   U   U  P   P  E      R   R",!
4 W ?LM,"SSS   SS   U   U  P   P  E      R   R",!
5 W ?LM,"SS         U   U  PPPP   EEE    RRRR",!
6 W ?LM,"SS         U   U  P      E      R R",!
7 W ?LM,"SS         U   U  P      E      R  R",!
8 W ?(LM+1),"SS         UUU   P      EEEEE  R   R",!
9 W ?(LM+2),"SSS",!
10 W ?(LM+4),"SSS",!
11 W ?(LM+6),"SS   TTTTT   A    RRRR  TTTTT  RRRR   EEEEE  K   K",!
12 W ?(LM+7),"SS    T    A A   R   R   T    R   R  E      K  K",!
13 W ?(LM+7),"SS    T   A   A  R   R   T    R   R  E      K K",!
14 W ?(LM+7),"SS    T   AAAAA  RRRR    T    RRRR   EEE    KK",!
15 W ?LM+1,"SS   SSS    T   A   A  R R     T    R R    E      K K",!
16 W ?(LM+1),"SSS SSS     T   A   A  R  R    T    R  R   E      K  K",!
17 W ?(LM+2),"SGSBS      T   A   A  R   R   T    R   R  EEEEE  K   K",!
18 W ?(LM+3),"SSS",!!! Q
 ;
 ;   STAR SHIP
SHIP S LM=10 W !
A W ?LM,"___------______________________",?LM+49,"___",!
B W ?LM,"\______________________________)",?LM+34,"______________/   \______________",!
C W ?LM+23,"| |",?LM+34,"\_____________     _____________/",!
D W ?LM+23,"| |",?LM+37,"/    /",?LM+48,"\___/",!
E W ?LM+23,"| |          /    /",!
F W ?LM+23,"| |         /    /",!
G W ?LM+17,"______| |________/____/___",!
H W ?LM+17,"\__                       \",?59,"U.S.S. ",SHNM,!
I W ?LM+20,")______________________/",?63,"NCC-17O",NC,!
 W ! Q
 ;
DLOGO S SHNM="ENTERPRISE",NC=1 W # D SHIP H 2 D NAM H 4 D SHIP H 3 Q
PLOGO O ^PR X ^NPR W:$Y # S SHNM="ENTERPRISE",NC=1 D NAM,SHIP W !,# X ^NCRT Q

STARTREK
STARTREK ;TG&MA&GSB&DBB,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;4DEC84 1:15AM;  GAME FOR COLOR COMPUTER (Runs under CCSM)
X ;       STARTREK IS TRANSLATED FROM THE BASIC VERSION
 ; DESCRIBED IN AHL'S "BASIC COMPUTER GAMES" WITH SOME
 ; NEW FEATURES. THE ROUTINE USES ONLY LOCAL VARIABLES.
 ;
 ;    CONVERTED AUGUST 1979 BY THOMAS GUSTAFSSON & MATS
 ; AHLBECK, DEPT. OF ONCOLOGY, LUND UNIVERSITY HOSPITAL,
 ; LUND, S-221 85 ,SWEDEN
 ;
 ;    NEW FEATURES ADDED 1984 BY GLADYS BROWN
 ;
IN S TEMP=0,SH="ENTERPRISE",NC=1
100 W #! D NAM^STARTR3 S HH=$P($H,",",2)
 S ZD="                        "
 F I=1:1:8 S D(I)=0 F J=1:1:8 S Z(I,J)=0
 F I=1:1:9 F J=1:1:2 S C(I,J)=0
 F I=1:1:3 S N(I)=0 F J=1:1:3 S K(I,J)=0
 S (T,T0)=$R(2000)+2000,T9=25+$R(10),D0=0,(E,E0)=3000
 S (P,P0)=10,S9=200,(S,B9,K9)=0,XD="",X0D=" IS ",ENT=1
 F I="Q1","Q2","S1","S2" D FNR S @I=FNR
 F I=2:1:4 S C(I,1)=-1,C(I+2,2)=-1
 S C(9,2)=1 F I=1:1:2 S C(I,2)=1,C(I+5,1)=1,C(8,I)=1
 S A1D="NAVSRSLRSPHATORSHEDAMCOMDESXXXLPP"
SHIP D HNG W # S SHNM=SH W !!!,"YOU ARE IN COMMAND OF THE . . .",! D SHIP^STARTR3 W !!!!
 S NC=$R(3)+1,SH=$S(NC=1:"ENTERPRISE",NC=2:"CONSTELLATION",NC=3:"INTREPID",1:"")
 W "YOU MUST AWAIT ORDERS FROM FEDERATION HEADQUARTERS",!!
 F I=1:1:8 F J=1:1:8 S R1=$R(100) D 850 ;   ALLOCATES KLINGONS, BASES, & STARS IN GALAXY
 G:B9'=0 1200 I G(Q1,Q2)<200 S G(Q1,Q2)=G(Q1,Q2)+100,K9=K9+1 ;   AT LEAST 1 BASE
 S B9=1,G(Q1,Q2)=G(Q1,Q2)+10 D FNR S Q1=FNR D FNR S Q2=FNR
1200 I K9>T9 S T9=K9+1 ;   MAKR SURE DATES > KLINGONS
 S K7=K9 I B9'=1 S XD="S",X0D=" ARE "
 ;I '((K9=23)!(K9=10)) G:((K9>8)&(K9<28)) 100 ;                       * * *
 D HNG W "YOUR ORDERS ARE AS FOLLOWS:",!?10,"DESTROY THE ",K9," KLINGON WARSHIPS WHICH HAVE"
 W " INVADED",!?3,"THE GALAXY BEFORE THEY CAN ATTACK FEDERATION HEADQUARTERS",!?3,"ON "
 W "STARDATE ",T0+T9,".    THIS GIVES YOU ",T9," DAYS.    THERE",X0D,!?3,B9
 W " STARBASE",XD," IN THE GALAXY FOR RESUPPLYING YOUR SHIP.",!!,"PRESS "
 R "<RETURN> WHEN READY TO ACCEPT COMMAND ",?75,GB,!# G:GB="LPP" 100 G ^STARTR1
 ;
 ;   SUBROUTINES
HNG S HHH=$P($H,",",2),HT=HH+5-HHH,HH=HHH S:HT<0 HT=0 H HT Q  ;   HANG DISPLAY 5 SECONDS
 ;
FND S %X=(K(I,1)-S1)*(K(I,1)-S1)+((K(I,2)-S2)*(K(I,2)-S2))
 D SQRT S FND=%X Q
SQRT S:%X'>0 %X=0 Q:%X=0  S %X1=%X/$E(%X,1,$L(%X)/2+1)
SQR S %X1=%X1-(%X1*%X1-%X/2/%X1)
 I %X1*%X1-%X>.000001 G SQR
 S %X=$E(%X1,1,8) K %X1 Q
 ;
 ;   ALLOCATES KLINGONS, BASES, & STARS IN A SECTOR
850 S K3=$S(R1>97:3,R1>94:2,R1>79:1,1:0),K9=K9+K3
 S B3=$S($R(100)>95:1,1:0),B9=B9+B3
 D FNR S G(I,J)=K3*100+(B3*10+FNR) Q
 ;
FNR S FNR=$R(798)+101\100 Q  ;   PRODUCES A NUMBER FROM 1 TO 8

STARXXX
STARXXX ;   ,,,COPYRIGHT 1986 COMP MARK, Inc.  -- This program may be freely copied for non-commercial use ONLY.;11OCT84 9:01AM;
 ;PRX;26May89 17:12;Copyright (c) 1989 PRx, Inc.
 S ENT=.8 W !!!!!?5,"O.K.",! S B9=0 G 6400
 ;
2020 W #!,*7,"** FATAL ERROR **" H 3 W "   YOU'VE JUST STRANDED YOUR SHIP IN "
 W "SPACE.",!,"YOU HAVE INSUFFICIENT MANEUVERING ENERGY,"
 W " AND SHIELD CONTROL",!,"IS PRESENTLY INCAPABLE OF CROSS"
 W "-CIRCUITING TO ENGINE ROOM!!",!
 ;
6220 W !!!,"IT IS STARDATE ",T+.5\1,"." W:T-T0>T9 " YOUR TIME'S OUT!" G 6270
6240 W !!!,"THE U.S.S. ",SHNM," HAS BEEN DESTROYED.  THE FEDERATION " S ENT=.75
 W "WILL BE CONQUERED." G 6220
 ;
6270 S AD="" S:K9>1 AD="S" W !,"THERE WERE ",K9," KLINGON BATTLE CRUISER",AD," LEFT AT"
 W !,"THE END OF YOUR MISSION.",! G 6400
 ;
6290 ;   I B9=0 G 6360
XXX W !!!,"THE FEDERATION IS IN NEED OF A STARSHIP COMMANDER"
 W !,"FOR A SIMILAR MISSION -- IF THERE IS A VOLUNTEER,"
 R !,"LET HIM STEP FORWARD AND ENTER 'AYE' ",!,AD I AD="AYE" G 100^STARTREK
6360 W !! Q
 ;
6370 H 2 W #!,"CONGRATULATIONS, CAPTAIN!  THE LAST KLINGON BATTLE CRUISER"
 W !,"MENACING THE FEDERATION HAS BEEN DESTROYED.",!
 ;
6400 W !,"YOUR EFFICENCY RATING IS " S T=2*K9+T-T0,K=K7-K9
 S RT=K/T*K/K7*K/T*K/K7*1000*ENT+.5\1
 W RT,"." ;G 6290
 I SHNM="" G 6290+1
 S C=K7*20
 I RT<C W !!!,"YOU HAVE JUST WASHED OUT AS A STARSHIP COMMANDER",!,?3,"AND ARE HEREBY DEMOTED TO CABIN BOY.",! Q
 I RT<(1.5*C) W !!!,"YOU ARE ORDERED BACK TO THE ACADEMY",!?3,"FOR A REFRESHER COURSE.",! Q
 I RT>(2.25*C) W !!!,"YOU ARE PROMOTED TO STAR FLEET COMMANDER.",!?3,"(GIVE SOMEONE ELSE A TURN)",!
 G 6290