Old Star Trek text game converted to PureBasic

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Old Star Trek text game converted to PureBasic

Post by BasicallyPure »

If you were using computers back in the late '70s or early '80s, you may have
encountered a text based Star Trek game similar to this one.
I searched for the code to this old game and I found something very close to
the game I remember playing so many years ago.
Code Project had an article about the old game: http://www.codeproject.com/Articles/282 ... -Text-Game
Down at the bottom of the article I found a link to some code: http://newton.freehostia.com/hp/bas/TREKPT.txt
It looks like the original game was written by Mike Mayfield in 1972, perhaps using HP basic.
Comments in the code I found say it was converted to Paper-Tape Basic ( PDP-11 Basic ) by Terry Newton in 2007.
I went ahead and got it running under PureBasic.
If you are a fan of the Goto command you will love this code. Ugh!

Code: Select all

; found this article at codeproject : http://www.codeproject.com/Articles/28228/Star-Trek-Text-Game
; followed code link at bottom to Enhanced Version : http://newton.freehostia.com/hp/bas/TREKPT.txt 
; I left comments intact as I found them + adding some of my own.
; I formatted code somewhat to make it more readable.
; Code translated to PureBasic by BasicallyPure 7/2/15
;
;
;
; ****  HP BASIC PROGRAM LIBRARY  ******************************
;
;       STTR1: STAR TREK
;
;       36243  REV B  --  10/73
;
; ****  CONTRIBUTED PROGRAM  ***********************************
; Shortened To <=72 char lines 3/08
; Converted To paper-tape basic by Terry Newton 9/07
; Strings, PRINT USING And other syntax matters re-coded
; Variable names changed To single letters And arrays...
; A - A$ replacement And general temp use
; C - C$ replacement (status)
; T E P S I J X Y N H left As is
; T0,T9-->T(1),T(2) T7 removed
; D0-->D  E0-->K  P0-->M  H8-->Q  R1-->F
; R2-->G  W1-->W  C1-->B  C2-->R
; S1,S2,S3,S9-->S(1),S(2),S(3),S(4)
; Q1,Q2-->Q(1),Q(2)
; B3,B9-->B(1),B(2)
; K3,K7,K9-->P(1),P(2),P(3)
; X1,X2-->X(1),X(2)
; Z1,Z2 And my Z7,Z8,Z9-->V(1),V(2),V(3),V(4),V(5)
; Z3 And original string subs removed Or heavily modified.
; V(6) used To flag calculator use, added WARP UNITS To calc.
; Z And L added For number print subs
; PRINT USING/IMAGE conversions mostly from 9/06 TSBE conversion
; An interesting bug arose.. directions were wrong.. then looked
; at the tsb-e conversion And noticed coords spec'd y,x.. forgot
; about that And had assumed x,y coords so altered the numbers in
; the C(,) Array To compensate. This led To several other changes
; To various display subroutines And docs.. almost wish I hadn't
; done that but I like it better this way (just how it came out).
; Added subs For number printing To display mostly original text.
; Note.. L.R.scan And galaxy Map formatted For paper-tape basic.
; LAST MOD 9/23/07
; **************************************************************
; ***
; ***     STAR TREK: BY MIKE MAYFIELD, CENTERLINE ENGINEERING
; ***
; ***        TOTAL INTERACTION GAME - ORIG. 20 OCT 1972
; ***
; **************************************************************

OpenConsole("Star Trek")

Macro RND(n) ; macro added by BasicallyPure
   ; produce a random float number (0 < number < 1)
   ((Random(2147483645)+1) / 2147483647.0)
EndMacro

For I=1 To 20
     PrintN("")
Next I
Print("                          STAR TREK ")
PrintN("")
PrintN("")
PrintN("")
Print("ENTER 1 OR 2 FOR INSTRUCTIONS (ENTER 2 TO PAGE) ");
A = Val(Input())
If A<>1 And A<>2 : Goto _210 : EndIf
Gosub _5820

; this useless block removed by BasicallyPure
   ; randomize query To mix it up, Not in original
   ;210  PRINT
   ;211  PRINT "ENTER SEED NUMBER ";
   ;212  INPUT A
   ;213  LET A=Int(Abs(A))
   ;215  PRINT "INITIALIZING..."
   ;220  For I=0 To A
   ;222  LET J=RND(1)
   ;225  Next I

_210: 
PrintN("")
PrintN("INITIALIZING...")

_230: 
; *****  PROGRAM STARTS HERE *****
PrintN("")
Dim G(8,8) : Dim C(9,2) : Dim K(3,3) : Dim N(3)   : Dim Z(8,8)
Dim A(8,8) : Dim D(9)   : Dim T(2)   : Dim S.f(4) : Dim Q(2)
Dim B(2)   : Dim P(3)   : Dim X.f(2) : Dim V.f(6)

T=Int(RND(1)*20+20)*100 ;stardate
T(1)=T  ;remember begining stardate
T(2)=30 ;game duration
D=0
E=3000
K=E
P=10
M=P
S(4)=200
Q=0
S=0

;DEF FND(D)=Sqr((K[I,1]-S[1])^2+(K[I,2]-S[2])^2)
;function to macro conversion by BasicallyPure
;find distance Klingon to Enterprise
Macro FND(D) : Sqr(Pow((K(I,1)-S(1)),2)+Pow((K(I,2)-S(2)),2)) : EndMacro

;starting location
Q(1)= Int(RND(1)*8+1) ;Enterprise quadrant x
Q(2)= Int(RND(1)*8+1) ;Enterprise quadrant y
S(1)= Int(RND(1)*8+1) ;Enterprise sector x
S(2)= Int(RND(1)*8+1) ;Enterprise sector y

; C Array numbers changed For X,Y notation/display
; dir 1 = X+1,Y    right
C(1,1)=1
C(1,2)=0
; dir 2 = X+1,Y-1  right And up
C(2,1)=1
C(2,2)=-1
; dir 3 = X, Y-1   up
C(3,1)=0
C(3,2)=-1
; dir 4 = X-1,Y-1  left And up
C(4,1)=-1
C(4,2)=-1
; dir 5 = X-1,Y    left
C(5,1)=-1
C(5,2)=0
; dir 6 = X-1,Y+1  left And down
C(6,1)=-1
C(6,2)=1
; dir 7 = X,Y+1    down
C(7,1)=0
C(7,2)=1
; dir 8 = X+1,Y+1  right And down
C(8,1)=1
C(8,2)=1
; dir 9 = same As dir 1
C(9,1)=1
C(9,2)=0

;MAT D=ZER ;<------------- WHAT IS THIS ???????????????????????????????????????????
FreeArray(D()) : Dim D(9) ; Added by BasicallyPure, a guess, seems to work

_490: 
B(2)=0 ;starbase total
P(3)=0 ;Klingon total

;populate galaxy
For I=1 To 8
   For J=1 To 8
      F = Random(100) ;assign probability of Klingons
      If F > 98 : Goto _580 : EndIf ;3
      If F > 95 : Goto _610 : EndIf ;2
      If F > 80 : Goto _640 : EndIf ;1
      P(1)=0 ;0 Klingons this quadrant
      Goto _660
      _580: 
      P(1)=3 ;quadrant gets 3 Klingons
      P(3)=P(3)+3 ;add 3 Klingons to total
      Goto _660
      _610: 
      P(1)=2 ;quadrant gets 2 Klingons
      P(3)=P(3)+2 ;add 2 Klingons to total
      Goto _660
      _640: 
      P(1)=1 ;quadrant gets 1 Klingon
      P(3)=P(3)+1 ;add 1 Klingon to total
      _660: 
      F = Random(100) ;assign probability of starbase
      If F > 96 : Goto _700 : EndIf
      B(1)=0 ;no starbase this quadrant
      Goto _720
      _700: 
      B(1)=1 ;starbase this quadrant
      B(2)=B(2)+1 ;add 1 starbase to total
      _720: 
      S(3)=Int(RND(1)*8+1) ;assign number of stars this quadrant
      G(I,J)=P(1)*100+B(1)*10+S(3) ;hundreds=Klingons, tens=starbase, ones=stars
      Z(I,J)=0 ;computer record of galaxy starts empty
   Next J
Next I

P(2)=P(3)
If B(2) <= 0 Or P(3) <= 0 : Goto _490 : EndIf
; mod For number print sub And plurality
Print("YOU MUST DESTROY ");
Z=P(3)
 Gosub _9400
Print(" KINGONS IN ");
Z=T(2)
Gosub _9400
Print(" STARDATES WITH ");
Z=B(2)
Gosub _9400
Print(" STARBASE");
If B(2)=1 : Goto _793 : EndIf
Print("S");
_793:
PrintN("")
PrintN("")
_810: 
P(1)=0
B(1)=0
S(3)=0
If Q(1)<1 Or Q(1)>8 Or Q(2)<1 Or Q(2)>8 : Goto _920 : EndIf
X.f=G(Q(1),Q(2))*1.00000E-02
P(1)=Int(X)
B(1)=Int((X-P(1))*10)
S(3)=G(Q(1),Q(2))-Int(G(Q(1),Q(2))*0.1)*10
If P(1)=0 : Goto _910 : EndIf
If S>200  : Goto _910 : EndIf
PrintN("COMBAT AREA      CONDITION RED")
PrintN("   SHIELDS DANGEROUSLY LOW")
_910: 

;MAT K=ZER ;<------- WHAT IS THIS ???????????????????????????????????????
FreeArray(K()) : Dim K(3,3) ; Added by BasicallyPure

_920: 
For I=1 To 3
   K(I,3)=0
Next I
; string arrays replaced With A(x,y)
; 0="   "
; 1="<*>"
; 2="+++"
; 3=">!<"
; 4=" * "

;MAT A=ZER ;<----- WHAT IS THIS ??????????????????????????????????????????
FreeArray(A()) : Dim A(8,8) ; Added by BasicallyPure , clear sector of old stars

A(Int(S(1)+0.5),Int(S(2)+0.5))=1
For I=1 To P(1)
   Gosub _5380
   A(F,G)=2
   K(I,1)=F
   K(I,2)=G
   K(I,3)=S(4)
Next I
For I=1 To B(1)
   Gosub _5380
   A(F,G)=3
Next I
For I=1 To S(3)
   Gosub _5380
   A(F,G)=4
Next I

_1260:
Gosub _4120

_1270: 
Print("COMMAND? ");
A = Val(Input())
If A=0 : Goto _1410 : EndIf
If A=1 : Goto _1260 : EndIf
If A=2 : Goto _2330 : EndIf
If A=3 : Goto _2530 : EndIf
If A=4 : Goto _2800 : EndIf
If A=5 : Goto _3460 : EndIf
If A=6 : Goto _3560 : EndIf
If A=7 : Goto _4630 : EndIf
Print(#CRLF$)
PrintN("   0 = SET COURSE")
PrintN("   1 = SHORT RANGE SENSOR SCAN")
PrintN("   2 = LONG RANGE SENSOR SCAN")
PrintN("   3 = FIRE PHASERS")
PrintN("   4 = FIRE PHOTON TORPEDOES")
PrintN("   5 = SHIELD CONTROL")
PrintN("   6 = DAMAGE CONTROL REPORT")
PrintN("   7 = CALL ON LIBRARY COMPUTER")
PrintN("")
Goto _1270

_1410: 
Print("COURSE (1-9) ");
B.f = ValF(Input())
If B=0 : Goto _1270 : EndIf
If B<1 Or B >= 9 : Goto _1410 : EndIf
Print("WARP FACTOR (0-8) ");
W.f = ValF(Input())
If W<0 Or W>8 : Goto _1410 : EndIf
If D(1) >= 0 Or W <= 0.2 : Goto _1510 : EndIf
PrintN("WARP ENGINES ARE DAMAGED, MAXIMUM SPEED = WARP 0.2")
Goto _1410

_1510: 
If P(1) <= 0 : Goto _1560 : EndIf
Gosub _3790
If P(1) <= 0 : Goto _1560 : EndIf
If S<0 : Goto _4000 : EndIf
Goto _1610
_1560: 
If E>0 : Goto _1610 : EndIf
If S<1 : Goto _3920 : EndIf
; mod For number print sub
Print("YOU HAVE ");
Z=E
Gosub _9400
Print(" UNITS OF ENERGY")
Print("SUGGEST YOU GET SOME FROM YOUR SHIELDS WHICH HAVE "+Str(S))
Print("UNITS LEFT")
Goto _1270

_1610: 
For I=1 To 8
   If D(I) >= 0 : Goto _1640 : EndIf
   D(I)=D(I)+1
   _1640: 
Next I
If RND(1)>0.2 : Goto _1810 : EndIf
F=Int(RND(1)*8+1)
If RND(1) >= 0.5 : Goto _1750 : EndIf
D(F)=D(F)-(RND(1)*5+1)
PrintN("")
Print("DAMAGE CONTROL REPORT: ");
Gosub _5610
PrintN(" DAMAGED")
PrintN("")
Goto _1810
_1750: 
D(F)=D(F)+(RND(1)*5+1)
PrintN("")
Print("DAMAGE CONTROL REPORT: ");
Gosub _5610
PrintN(" STATE OF REPAIR IMPROVED")
PrintN("")

_1810: 
N=Int(W*8)

; string "   " insertion removed
A(Int(S(1)+0.5),Int(S(2)+0.5))=0
X=S(1)
Y.f=S(2)
R=Int(B)
X(1)=C(R,1)+(C(R+1,1)-C(R,1))*(B-R)
X(2)=C(R,2)+(C(R+1,2)-C(R,2))*(B-R)
For I=1 To N
   S(1)=S(1)+X(1)
   S(2)=S(2)+X(2)
   If S(1)<0.5 Or S(1) >= 8.5 Or S(2)<0.5 Or S(2) >= 8.5 : Goto _2170 : EndIf ;jumps out of loop :(
   ; string "   " comparison removed
   If A(Int(S(1)+0.5),Int(S(2)+0.5))=0 : Goto _2070 : EndIf
   ; print using removed
   Print("WARP ENGINES SHUTDOWN AT SECTOR");
   V(4)=S(1)
   V(5)=S(2)
   Gosub _9000
   PrintN("DUE TO BAD NAVIGATION")
   S(1)=S(1)-X(1)
   S(2)=S(2)-X(2)
   Goto _2080 ;jumps out of loop :(
   _2070: 
Next I

_2080: 
; string "<*>" insertion removed
S(1)=Int(S(1)+0.5)
S(2)=Int(S(2)+0.5)
A(Int(S(1)),Int(S(2)))=1
E=E-N+5
If W<1 : Goto _2150 : EndIf
T=T+1
_2150: 
If T>T(1)+T(2) : Goto _3970 : EndIf ;time expired
Goto _1260
_2170: 
X=Q(1)*8+X+X(1)*N
Y=Q(2)*8+Y+X(2)*N
Q(1)=Int(X/8)
Q(2)=Int(Y/8)
S(1)=Int(X-Q(1)*8+0.5)
S(2)=Int(Y-Q(2)*8+0.5)
If S(1)<>0 : Goto _2260 : EndIf
Q(1)=Q(1)-1
S(1)=8
_2260: 
If S(2)<>0 : Goto _2290 : EndIf
Q(2)=Q(2)-1
S(2)=8
_2290: 
T=T+1
E=E-N+5
If T>T(1)+T(2) : Goto _3970 : EndIf
Goto _810

_2330: 
If D(3) >= 0 : Goto _2370 : EndIf
PrintN("LONG RANGE SENSORS ARE INOPERABLE")
Goto _1270
; print using/image converted
_2370: 
Print("LONG RANGE SENSOR SCAN FOR QUADRANT");
V(4)=Q(1)
V(5)=Q(2)
Gosub _9000
PrintN("")
; converted To X,Y display
PrintN("-------------------")
For J=Q(2)-1 To Q(2)+1
   ;MAT N=ZER ;<------ WHAT IS THIS ??????????????????????????????????????????????
   FreeArray(N()) : Dim N(3) ; Added by BasicallyPure, a guess, seems to work
      
   For I=Q(1)-1 To Q(1)+1
      If I<1 Or I>8 Or J<1 Or J>8 : Goto _2460 : EndIf
      N(I-Q(1)+2)=G(I,J)
      If D(7)<0 : Goto _2460 : EndIf
      Z(I,J)=G(I,J)
      _2460: 
   Next I
   ;2470  PRINT N[1]":"N[2]":"N[3]
   ;text for long range scan, formatted by BasicallyPure
   PrintN(RSet(Str(N(1)),3,"0")+" : "+RSet(Str(N(2)),3,"0")+" : "+RSet(Str(N(3)),3,"0"))
   PrintN("-------------------")
Next J
Goto _1270

_2530: 
If P(1) <= 0 : Goto _3670 : EndIf
If D(4) >= 0 : Goto _2570 : EndIf
PrintN("PHASER CONTROL IS DISABLED")
Goto _1270
_2570: 
If D(7) >= 0 : Goto _2590 : EndIf
PrintN(" COMPUTER FAILURE HAMPERS ACCURACY")
_2590: 
PrintN("PHASERS LOCKED ON TARGET.  ENERGY AVAILABLE = "+Str(E))
Print("NUMBER OF UNITS TO FIRE ");
X = Val(Input())
If X <= 0 : Goto _1270 : EndIf
If E-X<0 : Goto _2570 : EndIf
E=E-X ;subtract phaser energy used
Gosub _3790
If D(7) >= 0 : Goto _2680 : EndIf
X=X*RND(1) ;scale down the phaser energy

_2680: 
For I=1 To 3
   Delay(1000) ;added by BasicallyPure
   If K(I,3) <= 0 : Goto _2770 : EndIf
   ;calculate phaser damage [H]
   H=(X/P(1)/FND(0))*(2*RND(1)) ;X[phaserEnergy] / P(1)[num Klingons] / FND(0)[distance]
   K(I,3)=K(I,3)-H
   PrintN("") ;added by BasicallyPure
   Z=H ; print using/image converted
   Gosub _9400
   Print(" UNIT HIT ON KLINGON AT SECTOR ");
   V(4)=K(I,1) ;sector x
   V(5)=K(I,2) ;sector y
   Gosub _9000
   ;Print(Space(41)+"(");
   PrintN("") : Print(Space(27)+"("); changed by BasicallyPure
   Z=K(I,3)
   Gosub _9400
   PrintN(" LEFT)")
   If K(I,3)>0 : Goto _2770 : EndIf
   Gosub _3690 ;Klingon destroyed
   If P(3) <= 0 : Goto _4040 : EndIf
   _2770: 
Next I

If E<0 : Goto _4000 : EndIf
Goto _1270
_2800: 
If D(5) >= 0 : Goto _2830 : EndIf
PrintN("PHOTON TUBES ARE NOT OPERATIONAL")
Goto _1270
_2830: 
If P>0 : Goto _2860 : EndIf
PrintN("ALL PHOTON TORPEDOES EXPENDED")
Goto _1270
_2860: 
Print("TORPEDO COURSE (1-9) ");
B = ValF(Input())
If B=0 : Goto _1270 : EndIf
If B<1 Or B >= 9 : Goto _2860 : EndIf
R=Int(B)
X(1)=C(R,1)+(C(R+1,1)-C(R,1))*(B-R)
X(2)=C(R,2)+(C(R+1,2)-C(R,2))*(B-R)
X=S(1)
Y=S(2)
P=P-1
PrintN("TORPEDO TRACK:")
_2960: 
   Delay(1000) ;added by BasicallyPure
   X=X+X(1)
   Y=Y+X(2)
   If X<0.5 Or X >= 8.5 Or Y<0.5 Or Y >= 8.5 : Goto _3420 : EndIf
   ; print using/image converted
   V(4)=X
   V(5)=Y
   Gosub _9000
   PrintN("")
   ; string "   " comparison removed
   If A(Int(X+0.5),Int(Y+0.5))<>0 : Goto _3070 : EndIf
   Goto _2960

_3070: 
; string "+++" comparison removed
If A(Int(X+0.5),Int(Y+0.5))<>2 : Goto _3220 : EndIf
PrintN("*** KLINGON DESTROYED ***")
P(1)=P(1)-1
P(3)=P(3)-1
If P(3) <= 0 : Goto _4040 : EndIf
For I=1 To 3
   If Int(X+0.5)<>K(I,1) : Goto _3190 : EndIf
   If Int(Y+0.5)= K(I,2) : Goto _3200 : EndIf
      _3190: 
Next I
_3200: 
K(I,3)=0
Goto _3360
_3220: 
; string " * " comparison removed
If A(Int(X+0.5),Int(Y+0.5))<>4 : Goto _3290 : EndIf
PrintN("YOU CAN'T DESTROY STARS SILLY")
Goto _3420
; string ">!<" comparison removed
_3290:
If A(Int(X+0.5),Int(Y+0.5))<>3 : Goto _2960 : EndIf
PrintN("*** STAR BASE DESTROYED ***  .......CONGRATULATIONS")
B(1)=B(1)-1
_3360: 
; string "   " insertion removed
V(1)=Int(X+0.5)
V(2)=Int(Y+0.5)
A(Int(V(1)),Int(V(2)))=0
G(Q(1),Q(2))=P(1)*100+B(1)*10+S(3)
Goto _3430
_3420: 
PrintN("TORPEDO MISSED")
_3430: 
Gosub _3790
If E<0 : Goto _4000 : EndIf
Goto _1270
_3460: 
If D(7) >= 0 : Goto _3490 : EndIf
PrintN("SHIELD CONTROL IS NON-OPERATIONAL")
Goto _1270
; added Return
_3490: 
PrintN("ENERGY AVAILABLE = "+Str(E+S))
Print("NUMBER OF UNITS TO SHIELDS ");
X = Val(Input())
If X <= 0  : Goto _1270 : EndIf
If E+S-X<0 : Goto _3490 : EndIf
E=E+S-X
S=X
Goto _1270
_3560: 
If D(6) >= 0 : Goto _3590 : EndIf
PrintN("DAMAGE CONTROL REPORT IS NOT AVAILABLE")
Goto _1270
_3590: 
PrintN("")
PrintN("DEVICE        STATE OF REPAIR")
For F=1 To 8
Gosub _5610
PrintN(" "+Str(D(F)))
Next F
PrintN("")
Goto _1270
_3670: 
PrintN("SHORT RANGE SENSORS REPORT NO KLINGONS IN THIS QUANDRANT")
Goto _1270


_3690: ;subroutine
   ; print using/image converted, changed text slightly
   Print("*** KLINGON AT SECTOR ");
   V(4)=K(I,1)
   V(5)=K(I,2)
   Gosub _9000
   PrintN("DESTROYED ***")
   P(1)=P(1)-1
   P(3)=P(3)-1
   ; string "   " insertion removed
   A(Int(K(I,1)+0.5),Int(K(I,2)+0.5))=0
   G(Q(1),Q(2))=P(1)*100+B(1)*10+S(3)
Return
   
_3790: ;subroutine
   If C<>3 : Goto _3820 : EndIf
   PrintN("STAR BASE SHIELDS PROTECT THE ENTERPRISE")
Return


_3820: 
If P(1) <= 0 : Goto _3910 : EndIf
For I=1 To 3
   Delay(1000) ;added by BasicallyPure
   If K(I,3) <= 0 : Goto _3900 : EndIf
   H=(K(I,3)/FND(0))*(2*RND(1))
   S=S-H
   PrintN("") ;added by BasicallyPure
   ; print using/image converted
   Z=H
   Gosub _9400
   Print(" UNIT HIT ON ENTERPRISE AT SECTOR ");
   V(4)=K(I,1)
   V(5)=K(I,2)
   Gosub _9000
   ;Print(Space(41)+"(");
   PrintN("") : Print(Space(30)+"("); changed by BasicallyPure
   Z=S
   Gosub _9400
   PrintN(" LEFT)")
   If S<0 : Goto _4000 : EndIf
   _3900: 
Next I

_3910: 
Return

_3920: 
Print("THE ENTERPRISE IS DEAD IN SPACE. IF YOU SURVIVE ALL");
PrintN(" IMPENDING")
PrintN("ATTACK YOU WILL BE DEMOTED TO THE RANK OF PRIVATE")
_3940: 
If P(1) <= 0 : Goto _4020 : EndIf
Gosub _3790
Goto _3940
_3970: 
PrintN("")
PrintN("IT IS STARDATE "+Str(T))
Goto _4020
_4000: 
PrintN("")
Print("THE ENTERPRISE HAS BEEN DESTROYED. THE FEDERATION WILL");
PrintN(" BE CONQUERED")
; mod For number print
_4020: 
Print("THERE ARE STILL ");
Z=P(3)
Gosub _9400
PrintN(" KLINGON BATTLE CRUISERS")
Goto _230 ;restart game
_4040: 
PrintN("")
Print("THE LAST KLIGON BATTLE CRUISER IN THE GALAXY HAS BEEN");
PrintN(" DESTROYED")
PrintN("THE FEDERATION HAS BEEN SAVED !!!")
PrintN("")

;4080  PRINT "YOUR EFFICIENCY RATING ="((P[2]/(T-T[1]))*1000)
;efficiency formula changed by BasicallyPure 7/2/15
;efficiency = 100 * KlingonsDestroyed / ElapsedStardates
PrintN("YOUR EFFICIENCY RATING = "+StrF( 100.0*P(2)/(T-T(1)),1 ))

Goto _230

_4120: ;subroutine
   For I=S(1)-1 To S(1)+1
      For J=S(2)-1 To S(2)+1
         If I<1 Or I>8 Or J<1 Or J>8 : Goto _4200 : EndIf
         ; string ">!<" comparison removed
         If A(Int(I+0.5),Int(J+0.5))=3 : Goto _4240 : EndIf ;jumps out of for/next loop :(
         _4200: 
      Next J
   Next I
   D=0
   Goto _4310
   _4240: 
   D=1
   ; docked
   C=3
   E=3000
   P=10
   PrintN("SHIELDS DROPPED FOR DOCKING PURPOSES")
   S=0
   Goto _4380
   _4310: 
   If P(1)> 0 : Goto _4350 : EndIf
   If E<K*0.1 : Goto _4370 : EndIf
   ; green
   C=0
   Goto _4380
   ; red
   _4350:
   C=2
   Goto _4380
   ; yellow
   _4370:
   C=1
   _4380: 
   If D(2) >= 0 : Goto _4430 : EndIf
   PrintN("")
   Print("*** SHORT RANGE SENSORS ARE OUT ***")
   PrintN("")
   Goto _4530
   ; this section has been compely rewritten
   ; sub at 9000 prints coordinates As in other print using conv.
   ; sub at 9200 prints Next line of D(x,y) replacing strings
   ; V(3) indexes Y line, start at 0 (9200 increments first)
   ; changed some of the text ordering And formatting here
   _4430: 
   PrintN("-=--=--=--=--=--=--=--=-")
   V(3)=0
   Gosub _9200
   PrintN("")
   Gosub _9200
   PrintN(" STARDATE "+Str(T))
   Gosub _9200
   Print(" CONDITION ");
   If C=1 : Goto _4467 : EndIf
   If C=2 : Goto _4469 : EndIf
   If C=3 : Goto _4471 : EndIf
   PrintN("GREEN")
   Goto _4472
   _4467: 
   PrintN("YELLOW")
   Goto _4472
   _4469: 
   PrintN("RED")
   Goto _4472
   _4471: 
   PrintN("DOCKED")
   _4472:
   Gosub _9200
   Print(" QUADRANT ");
   V(4)=Q(1)
   V(5)=Q(2)
   Gosub _9000
   PrintN("")
   Gosub _9200
   Print(" SECTOR   ");
   V(4)=S(1)
   V(5)=S(2)
   Gosub _9000
   PrintN("")
   Gosub _9200
   PrintN(" ENERGY   "+Str(Int(E)))
   Gosub _9200
   PrintN(" SHIELDS  "+Str(Int(S)))
   Gosub _9200
   PrintN(" PHOTON TORPEDOES "+Str(P))
   PrintN("-=--=--=--=--=--=--=--=-")
   _4530: 
Return


; ................. computer......................
_4630:
If D(8) >= 0 : Goto _4660 : EndIf
PrintN("COMPUTER DISABLED")
Goto _1270
_4660: 
Print("COMPUTER ACTIVE AND AWAITING COMMAND ");
A = Val(Input())
; added, calc mode off
V(6)=0
If A=0 : Goto _4740 : EndIf
If A=1 : Goto _4830 : EndIf
If A=2 : Goto _4880 : EndIf
PrintN("")
PrintN("FUNCTIONS AVAILABLE FROM COMPUTER")
PrintN("   0 = CUMULATIVE GALATIC RECORD")
PrintN("   1 = STATUS REPORT")
PrintN("   2 = PHOTON TORPEDO DATA")
Goto _4660

_4740: ; print using/image statements converted
Print("COMPUTER RECORD OF GALAXY FOR QUADRANT");
V(4)=Q(1)
V(5)=Q(2)
Gosub _9000
PrintN("")
; converted To x,y Array specs
PrintN("----- ----- ----- ----- ----- ----- ----- -----")
For I=1 To 8 ; galaxy text formatted by BasicallyPure
   PrintN(" "+RSet(Str(Z(1,I)),3,"0")+"  "+
          " "+RSet(Str(Z(2,I)),3,"0")+"  "+
          " "+RSet(Str(Z(3,I)),3,"0")+"  "+
          " "+RSet(Str(Z(4,I)),3,"0")+"  "+
          " "+RSet(Str(Z(5,I)),3,"0")+"  "+
          " "+RSet(Str(Z(6,I)),3,"0")+"  "+
          " "+RSet(Str(Z(7,I)),3,"0")+"  "+
          " "+RSet(Str(Z(8,I)),3,"0"))
   PrintN("----- ----- ----- ----- ----- ----- ----- -----")
Next I
Goto _1270

_4830: 
PrintN("")
PrintN("STATUS REPORT")
PrintN("")
PrintN("NUMBER OF KLINGONS LEFT  = "+Str(P(3)))
PrintN("NUMBER OF STARDATES LEFT = "+Str((T(1)+T(2))-T))
PrintN("NUMBER OF STARBASES LEFT = "+Str(B(2)))
Goto _3560

_4880: 
; PRINT removed
Q=0

For I=1 To 3
   If K(I,3) <= 0 : Goto _5260 : EndIf
   ; reversed For x/y mods
   A=S(1)
   B=S(2)
   X=K(I,1)
   W=K(I,2)
   Goto _5010
   
   _4970: ; print using/image converted
   Print("YOU ARE AT QUADRANT");
   V(4)=Q(1)
   V(5)=Q(2)
   Gosub _9000
   Print("SECTOR");
   V(4)=S(1)
   V(5)=S(2)
   Gosub _9000
   PrintN("")
   PrintN("ENTER 4 COMMA SEPARATED VALUES")
   Print("SHIP'S & TARGET'S COORDINATES ARE ?");
   
   ; reversed For x,y entry, int mod
   ;INPUT A,B,X,W ;<---- adapted to parse input string by BasicallyPure
   I$ = Input()
   A = 0 : B = 0 : X = 0 : W = 0
   A = Val(StringField(I$,1,","))
   B = Val(StringField(I$,2,","))
   X = Val(StringField(I$,3,","))
   W = Val(StringField(I$,4,","))
   
   _5010: 
   X=Int(X-A+0.5)
   A=Int(B-W+0.5)
   If X<0 : Goto _5130 : EndIf
   If A<0 : Goto _5190 : EndIf
   If X>0 : Goto _5070 : EndIf
   If A=0 : Goto _5150 : EndIf
   _5070:
   B=1
   _5080: 
   If Abs(A) <= Abs(X) : Goto _5110 : EndIf
   PrintN("DIRECTION = "+StrF(B+(((Abs(A)-Abs(X))+Abs(A))/Abs(A)),2))
   Goto _5240
   _5110: 
   PrintN("DIRECTION = "+StrF(B+(Abs(A)/Abs(X)),2))
   Goto _5240
   _5130: 
   If A>0 : Goto _5170 : EndIf
   If X=0 : Goto _5190 : EndIf
   _5150: 
   B=5
   Goto _5080
   _5170: 
   B=3
   Goto _5200
   _5190: 
   B=7
   _5200: 
   If Abs(A) >= Abs(X) : Goto _5230 : EndIf
   PrintN("DIRECTION = "+StrF(B+(((Abs(X)-Abs(A))+Abs(X))/Abs(X)),2))
   Goto _5240
   _5230: 
   PrintN("DIRECTION = "+StrF(B+(Abs(X)/Abs(A)),2))
   _5240: 
   Print("DISTANCE  = "+StrF((Sqr(X*X+A*A)),2));
   ; added warp units To aid With navigation
   If V(6)<>1 : Goto _5253 : EndIf
   L=Abs(X)
   If L>Abs(A) : Goto _5246 : EndIf
   L=Abs(A)
   _5246: 
   Print(Space(28)+"(");
   Print(Str(L))
   Print(" WARP UNIT");
   If L=1 : Goto _5251 : EndIf
   Print("S");
   _5251: 
   Print(")");
   _5253: 
   PrintN("")
   If Q=1 : Goto _5320 : EndIf
   _5260: 
Next I

Q=0
Print("ENTER 1 TO USE THE CALCULATOR ");
V(6) = Val(Input())
If V(6)=1 : Goto _4970 : EndIf
_5320: 
Goto _1270


_5380: ;subroutine
   ; find-empty-location sub, strings removed
   F=Int(RND(1)*8+1)
   G=Int(RND(1)*8+1)
   If A(F,G)<>0 : Goto _5380 : EndIf
Return


_5610: ;subroutine
   ; ****  PRINTS DEVICE NAME FROM Array *****
   ; recoded To remove strings
   If F=1 : Goto _5635 : EndIf
   If F=2 : Goto _5640 : EndIf
   If F=3 : Goto _5645 : EndIf
   If F=4 : Goto _5650 : EndIf
   If F=5 : Goto _5655 : EndIf
   If F=6 : Goto _5660 : EndIf
   If F=7 : Goto _5665 : EndIf
   Print("COMPUTER") : Return
   _5635: : Print("WARP ENGINES") : Return
   _5640: : Print("S.R. SENSORS") : Return
   _5645: : Print("L.R. SENSORS") : Return
   _5650: : Print("PHASER CNTRL") : Return
   _5655: : Print("PHOTON TUBES") : Return
   _5660: : Print("DAMAGE CNTRL") : Return
   _5665: : Print("SHIELD CNTRL")
Return


_5820: ;subroutine
   ; instructions modified To notify of use of X,Y coordinates
   ; If A=2 then ENTER # prompts inserted To avoid scrolling
   ; messed With the course graphic.
   PrintN("")
   PrintN("")
   PrintN("     INSTRUCTIONS:")
   PrintN("")
   PrintN("<*> = ENTERPRISE")
   PrintN("+++ = KLINGON")
   PrintN(">!< = STARBASE")
   PrintN(" *  = STAR")
   PrintN("")
   PrintN("COMMAND 0 = WARP ENGINE CONTROL")
   PrintN("  'COURSE IS IN A CIRCULAR NUMERICAL         4    3    2")
   PrintN("  VECTOR ARRANGEMENT AS SHOWN.                `.  :  .'")
   PrintN("  INTERGER AND REAL VALUES MAY BE               `.:.'")
   PrintN("  USED.  THEREFORE COURSE 1.5 IS             5---<*>---1")
   PrintN("  HALF WAY BETWEEN 1 AND 2.                     .':`.")
   PrintN("                                              .'  :  `.")
   PrintN("  A VECTOR OF 9 IS UNDEFINED, BUT            6    7    8")
   PrintN("  VALUES MAY APPROACH 9.")
   PrintN("                                               COURSE")
   PrintN("  ONE 'WARP FACTOR' IS THE SIZE OF")
   PrintN("  ONE QUADRANT.  THEREFORE TO GET FROM")
   PrintN("  QUADRANT 5,6 TO 5,5 YOU WOULD USE COURSE 3, WARP")
   PrintN("  FACTOR 1. COORDINATES ARE SPECIFIED USING X,Y NOTATION")
   PrintN("  WITH X 1-8 FROM LEFT-RIGHT AND Y 1-8 FROM TOP-BOTTOM.")
   If A<>2 : Goto _6009 : EndIf
   PrintN("")
   Print("ENTER A NUMBER TO CONTINUE...  ");
   I = Val(Input())
   PrintN("")
   _6009: 
   PrintN("")
   PrintN("COMMAND 1 = SHORT RANGE SENSOR SCAN")
   PrintN("  PRINTS THE QUADRANT YOU ARE CURRENTLY IN, INCLUDING")
   PrintN("  STARS, KLINGONS, STARBASES, AND THE ENTERPRISE; ALONG")
   PrintN("  WITH OTHER PERTINATE INFORMATION.")
   PrintN("")
   PrintN("COMMAND 2 = LONG RANGE SENSOR SCAN")
   PrintN("  SHOWS CONDITIONS IN SPACE FOR ONE QUADRANT ON EACH SIDE")
   PrintN("  OF THE ENTERPRISE IN THE MIDDLE OF THE SCAN.  THE SCAN")
   PrintN("  IS CODED IN THE FORM XXX, WHERE THE UNITS DIGIT IS THE")
   PrintN("  NUMBER OF STARS, THE TENS DIGIT IS THE NUMBER OF STAR-")
   PrintN("  BASES, THE HUNDREDS DIGIT IS THE NUMBER OF KLINGONS.")
   PrintN("")
   PrintN("COMMAND 3 = PHASER CONTROL")
   PrintN("  ALLOWS YOU TO DESTROY THE KLINGONS BY HITTING HIM WITH")
   PrintN("  SUITABLY LARGE NUMBERS OF ENERGY UNITS TO DEPLETE HIS ")
   PrintN("  SHIELD POWER.  KEEP IN MIND THAT WHEN YOU SHOOT AT")
   PrintN("  HIM, HE GONNA DO IT TO YOU TOO.")
   If A<>2 : Goto _6159 : EndIf
   For I=1 To 5
   PrintN("")
   Next I
   Print("ENTER A NUMBER TO CONTINUE...  ");
   I = Val(Input())
   PrintN("")
   _6159: 
   PrintN("")
   PrintN("COMMAND 4 = PHOTON TORPEDO CONTROL")
   PrintN("  COURSE IS THE SAME AS USED IN WARP ENGINE CONTROL")
   PrintN("  IF YOU HIT THE KLINGON, HE IS DESTROYED AND CANNOT FIRE")
   PrintN("  BACK AT YOU.  IF YOU MISS, HE WILL SHOOT HIS PHASERS AT")
   PrintN("  YOU.")
   PrintN("   NOTE: THE LIBRARY COMPUTER (COMMAND 7) HAS AN OPTION")
   PrintN("   TO COMPUTE TORPEDO TRAJECTORY FOR YOU (OPTION 2).")
   PrintN("")
   PrintN("COMMAND 5 = SHIELD CONTROL")
   PrintN("  DEFINES NUMBER OF ENERGY UNITS TO ASSIGN TO SHIELDS")
   PrintN("  ENERGY IS TAKEN FROM TOTAL SHIP'S ENERGY.")
   PrintN("")
   PrintN("COMMAND 6 = DAMAGE CONTROL REPORT")
   Print("  GIVES STATE OF REPAIRS OF ALL DEVICES.");
   PrintN("  A STATE OF REPAIR")
   PrintN("  LESS THAN ZERO SHOWS THAT THAT DEVICE IS TEMPORARALY")
   PrintN("  DAMAGED.")
   If A<>2 : Goto _6299 : EndIf
   For I=1 To 6
      PrintN("")
   Next I
   Print("ENTER A NUMBER TO CONTINUE...  ");
   I = Val(Input())
   PrintN("")
   _6299: 
   PrintN("")
   PrintN("COMMAND 7 = LIBRARY COMPUTER")
   PrintN("  THE LIBRARY COMPUTER CONTAINS THREE OPTIONS:")
   PrintN("    OPTION 0 = CUMULATIVE GALACTIC RECORD")
   PrintN("     SHOWS COMPUTER MEMORY OF THE RESULTS OF ALL PREVIOUS")
   PrintN("     LONG RANGE SENSOR SCANS")
   PrintN("    OPTION 1 = STATUS REPORT")
   PrintN("     SHOWS NUMBER OF KLINGONS, STARDATESC AND STARBASES")
   PrintN("     LEFT.")
   PrintN("    OPTION 2 = PHOTON TORPEDO DATA")
   PrintN("     GIVES TRAJECTORY AND DISTANCE BETWEEN THE ENTERPRISE")
   PrintN("     AND ALL KLINGONS IN YOUR QUADRANT")
   If A<>2 : Goto _6408 : EndIf
   For I=1 To 9
      PrintN("")
   Next I
   _6408: 
   PrintN("")
Return


_9000: ;subroutine
   ; sub To help convert PRINT USING, displays " x,y "
   ; coordinates (V(4),V(5))
   Print(" ");
   L=Int(V(4)+0.5)
   Gosub _9700
   Print(",");
   L=Int(V(5)+0.5)
   Gosub _9700
   Print(" ");
Return


_9200: ;subroutine
   ; print display line from A(x,y)
   ; y coord spec'd by V(3), inc;ented
   V(3)=V(3)+1
   
   For I=1 To 8
      A=A(I,Int(V(3)))
      If A=1 : Goto _9240 : EndIf
      If A=2 : Goto _9242 : EndIf
      If A=3 : Goto _9244 : EndIf
      If A=4 : Goto _9246 : EndIf
      Print("   ");
      Goto _9250
      _9240: 
      Print("<*>");
      Goto _9250
      _9242: 
      Print("+++");
      Goto _9250
      _9244: 
      Print(">!<");
      Goto _9250
      _9246: 
      Print(" * ");
      _9250: 
   Next I
Return


_9400: ;subroutine
   ; Integer print subroutine
   ; up To 4 digits -9999 To 9999, no spaces
   ; Number To print in Z, L used For digit
   If Z >= 0 : Goto _9420 : EndIf
   Print("-");
   
   _9420: 
   Z=Abs(Z)
   Z=Int(Z)
   If Z<10   : Goto _9560 : EndIf
   If Z<100  : Goto _9530 : EndIf
   If Z<1000 : Goto _9500 : EndIf
   L=Int(Z/1000)
   Z=Z-L*1000
   Gosub _9700
   
   _9500: 
   L=Int(Z/100)
   Z=Z-L*100
   Gosub _9700
   
   _9530: 
   L=Int(Z/10)
   Z=Z-L*10
   Gosub _9700
   
   _9560: 
   L=Z
   Gosub _9700
Return


_9700: ;subroutine
   ; Digit print subroutine, digit in L
   If L=1 : Goto _9810 : EndIf
   If L=2 : Goto _9830 : EndIf
   If L=3 : Goto _9850 : EndIf
   If L=4 : Goto _9870 : EndIf
   If L=5 : Goto _9890 : EndIf
   If L=6 : Goto _9910 : EndIf
   If L=7 : Goto _9930 : EndIf
   If L=8 : Goto _9950 : EndIf
   If L=9 : Goto _9970 : EndIf
   
   Print("0") : Return
   
   _9810: : Print("1") : Return
   _9830: : Print("2") : Return
   _9850: : Print("3") : Return
   _9870: : Print("4") : Return
   _9890: : Print("5") : Return
   _9910: : Print("6") : Return
   _9930: : Print("7") : Return
   _9950: : Print("8") : Return
   _9970: : Print("9")
Return

CloseConsole()
End
Last edited by BasicallyPure on Fri Jul 03, 2015 10:04 pm, edited 1 time in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
heartbone
Addict
Addict
Posts: 1058
Joined: Fri Apr 12, 2013 1:55 pm
Location: just outside of Ferguson

Re: Old Star Trek text game converted to PureBasic

Post by heartbone »

Wow!
Floating point vectors!
This is more advanced than the version that I used to play on the old IBM mainframes back in the day.
Thanks for the PB translation BasicallyPure.
Keep it BASIC.
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Old Star Trek text game converted to PureBasic

Post by BasicallyPure »

Bug fix.
Computer sub-option 2 (Photon Torpedo Data) now gives
floating point results for direction and distance instead of integer.

I noticed several For/Next loops are jumped out of with Gotos instead of
exiting the loop normally. Inserting a Break command will not work in these
instances as the program flow will be different.
I have not experienced any crashes so far but I don't think this is a good
situation. Does anyone have thoughts about this potential problem?
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
idle
Always Here
Always Here
Posts: 5902
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Old Star Trek text game converted to PureBasic

Post by idle »

BasicallyPure wrote:I noticed several For/Next loops are jumped out of with Gotos instead of
exiting the loop normally. Inserting a Break command will not work in these
instances as the program flow will be different.
If the native versions are causing issues you could try these replacements
http://www.purebasic.fr/english/viewtop ... 12&t=55242
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: Old Star Trek text game converted to PureBasic

Post by Vera »

Thank you BasicallyPure 8)
you've beamed me to a realm that I'd never reached before Image

It flies great on Linux ... and after torpeding nothing but stars I searched a way out ... but I found none ... so I've added an 8th command if you don't mind.

As for your impressive question ";MAT K=ZER ;<------- WHAT IS THIS ???????????????????????????????????????" ... I thought it might be short for 'Matrix' and 'Zero' ... and of course I can't be sure.
Still I made a search and it looks as if it comes close to it ... though I'd leave it to you to dive into the listed links - search: +MAT +ZER +codeproject

greets ~ Vera
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Old Star Trek text game converted to PureBasic

Post by davido »

@Vera,
I always assumed that 'MAT ZER' simply meant: set each element to zero.
This is what I've always used.

I assume that BP's method must be faster - and so it seems . . . .

Code: Select all

Global Dim A.i(100), i.i, M.i, Dt.i

Dt = ElapsedMilliseconds()

For M = 1 To 1000000
 For i = 0 To 100 : A(i) = 0 : Next i
 ;FreeArray(A()) : Global Dim A.i(100)
Next M

MessageRequester("Time",Str(ElapsedMilliseconds() - Dt) + " ms")
DE AA EB
Little John
Addict
Addict
Posts: 4789
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Old Star Trek text game converted to PureBasic

Post by Little John »

davido wrote:I always assumed that 'MAT ZER' simply meant: set each element to zero.
Hi davido,

this is confirmed by the book "Programming In Basic", see
https://books.google.de/books?id=kNZHC-ODtCcC&pg=PA173
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Old Star Trek text game converted to PureBasic

Post by BasicallyPure »

Hey thanks everyone for confirming what I thought 'MAT ZER' was.

I am in the process of completely rewriting this code to try and eliminate
all or most of the gotos. I'll use meaningful names for labels and variables.
Working on this code is like a giant puzzle so I do a little bit every day.
I'll leave my original code posting as is to somewhat preserve the original work.
I'll post my updated version separately.

If you use the library computer sub-function 2 'torpedo data' don't expect it
to work properly. I doubt if it ever did.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: Old Star Trek text game converted to PureBasic

Post by Vera »

BasicallyPure wrote:Working on this code is like a giant puzzle so ...
you will

Code: Select all

Goto _haveFun

Procedure IfitIs(True)
  Goto _enjoy
  _enjoy: 
  ProcedureReturn #True
EndProcedure

_haveFun:
If IfitIs(1) : Debug "Hurray" : EndIf
~ :wink:
and thanks for keeping the 'artefact' as is - providing more FunToGoTo
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Old Star Trek text game converted to PureBasic

Post by davido »

@BasicallyPure,
Thanks for a great game!

@Little John,
Thank you for confirming Mat Zer.
:D
DE AA EB
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Old Star Trek text game converted to PureBasic

Post by BasicallyPure »

After several days of working on this in my spare time I have the code cleaned up quite a bit.
Many of the gotos have been removed. I believe all of the remaining gotos are now used
properly, no jumping out of loops. Gotos that leave subroutines are now preceded by a
'FakeReturn'. I have changed many of the one letter variable names to more meaningful ones.
Many comments have been added. Color has been added to the short range and long range
scans along with some formatting changes. Phasers have been made more effective.
I have tested with Windows and Linux.

In summary the code should now be much easier to read. If you are of a mind you can
perform a few tweaks of your own without the hassle of cryptic code.

Code: Select all

; **************************************************************
; ***
; ***     STAR TREK: BY MIKE MAYFIELD, CENTERLINE ENGINEERING
; ***
; ***        TOTAL INTERACTION GAME - ORIG. 20 OCT 1972
; ***
; **************************************************************
;
; Original source code of this version found here:
; http://newton.freehostia.com/hp/bas/TREKPT.txt
;
; Recoded to PureBasic by BasicallyPure 7/15/2015


CompilerIf #PB_Compiler_OS = #PB_OS_Linux
   #TXT = 15 ;text color
   #BKG = 8  ;background color
CompilerElse
   #TXT = 7
   #BKG = 0
CompilerEndIf

OpenConsole("Star Trek")
ConsoleColor(#TXT,#BKG)

Macro RND(n) ; produce a random float number (0 < number < 1)
   ((Random(2147483645)+1) / 2147483647.0)
EndMacro

;find distance Klingon to Enterprise
Macro FND(D) : Sqr(Pow((K(I,1)-NCC_1701_SX),2)+Pow((K(I,2)-NCC_1701_SY),2)) : EndMacro

For I = 1 To 100 : PrintN("") : Next I ;added for Linux terminal

Print("                    STAR TREK ")
PrintN("")
PrintN("")
PrintN("")
Print("ENTER 1 OR 2 FOR INSTRUCTIONS (ENTER 2 TO PAGE) ");

A = Val(Input())
If A=1 Or A=2
   Gosub _5820 ;show instructions
EndIf

; *****  PROGRAM STARTS HERE *****
_230: 
PrintN("")
PrintN("INITIALIZING...")
PrintN("")

Dim Quadrant(8,8) : Dim Sector(8,8) : Dim GalaxyMap(8,8) : Dim K(3,3)
Dim Damage(9) : Dim C(9,2)

Define.f Xinc, Yinc, row, col
Define.i CalcMode

GameDuration     = 30   ; game duration (stardates)
E_start          = 3000 ; Enterprise maximim energy
FullTorpLoad     = 10   ; maximum photon torpedos
KlingonMaxEnergy = 200  ; Klingon starting energy
StarDate  = Int(RND(1)*20+20)*100 ;current stardate
BeginDate = StarDate ;beginning stardate
Energy    = E_start ;Enterprise energy level
Torpedos  = FullTorpLoad
Shields   = 0
Docked    = #False

;starting location
NCC_1701_QX = Int(RND(1)*8+1) ;Enterprise quadrant x
NCC_1701_QY = Int(RND(1)*8+1) ;Enterprise quadrant y
NCC_1701_SX = Int(RND(1)*8+1) ;Enterprise sector x
NCC_1701_SY = Int(RND(1)*8+1) ;Enterprise sector y

; C Array numbers changed For X,Y notation/display
C(1,1)= 1 : C(1,2)= 0 ; dir 1 = X+1,Y    right
C(2,1)= 1 : C(2,2)=-1 ; dir 2 = X+1,Y-1  right And up
C(3,1)= 0 : C(3,2)=-1 ; dir 3 = X, Y-1   up
C(4,1)=-1 : C(4,2)=-1 ; dir 4 = X-1,Y-1  left And up
C(5,1)=-1 : C(5,2)= 0 ; dir 5 = X-1,Y    left
C(6,1)=-1 : C(6,2)= 1 ; dir 6 = X-1,Y+1  left And down
C(7,1)= 0 : C(7,2)= 1 ; dir 7 = X,Y+1    down
C(8,1)= 1 : C(8,2)= 1 ; dir 8 = X+1,Y+1  right And down
C(9,1)= 1 : C(9,2)= 0 ; dir 9 = same As dir 1

;populate galaxy
While StarbaseTotal = 0 Or Klingons < 8 ;must have at least 1 starbase and 8 klingons
   StarbaseTotal = 0
   Klingons = 0
   
   For I=1 To 8
      For J=1 To 8
         F = Random(100) ;assign probability of Klingons
         If F > 98
            KlingonsInQuadrant = 3 ;quadrant gets 3 Klingons
            Klingons + 3           ;add 3 Klingons to total
         ElseIf F > 95
            KlingonsInQuadrant = 2 ;quadrant gets 2 Klingons
            Klingons + 2           ;add 2 Klingons to total
         ElseIf F > 80
            KlingonsInQuadrant = 1 ;quadrant gets 1 Klingon
            Klingons + 1           ;add 1 Klingon to total
         Else
            KlingonsInQuadrant = 0 ;0 Klingons this quadrant
         EndIf
         
         F = Random(100) ;assign probability of starbase
         If F > 96
            Starbase = 1      ;starbase this quadrant
            StarbaseTotal + 1 ;add 1 starbase to total
         Else
            Starbase = 0 ;no starbase this quadrant
         EndIf
         
         Stars = Int(RND(1)*8+1) ;assign number of stars this quadrant
         Quadrant(I,J) = KlingonsInQuadrant*100 + Starbase*10 + Stars ;hundreds=Klingons, tens=starbase, ones=stars
         GalaxyMap(I,J)=0                ;computer record of galaxy starts empty
      Next J
   Next I
   
   OriginalKlingons = Klingons
Wend

Print("YOU MUST DESTROY ");
   Print(Str(Klingons))
Print(" KINGONS IN ");
   Print(Str(GameDuration))
Print(" STARDATES WITH ");
   Print(Str(StarbaseTotal))
   Print(" STARBASE");
   If StarbaseTotal > 1 : Print("S") : EndIf

PrintN("")
PrintN("")

_810: ;- ENTER NEW QUADRANT
KlingonsInQuadrant = 0
Starbase = 0
Stars = 0

;scan the quadrant and assign positions of stars, klingons, starbase
If NCC_1701_QX > 0 And NCC_1701_QX < 9 And NCC_1701_QY > 0 And NCC_1701_QY < 9 ;check if inside galaxy
   X.f = Quadrant(NCC_1701_QX, NCC_1701_QY) / 100 ;parse out klingons and starbases
   KlingonsInQuadrant = Int(X)
   Starbase = Int((X - KlingonsInQuadrant)*10)
   
   ;parse out the number of stars
   Stars = Quadrant(NCC_1701_QX,NCC_1701_QY) - Int(Quadrant(NCC_1701_QX,NCC_1701_QY)*0.1)*10
   
   If KlingonsInQuadrant > 0 And Shields <= 200 ;issue warning
      PrintN("COMBAT AREA     CONDITION RED!")
      PrintN("SHIELDS DANGEROUSLY LOW")
   EndIf
   
   FreeArray(K()) : Dim K(3,3) ; zero out any previous Klingon data
EndIf

For I=1 To 3
   K(I,3)=0 ;zero out Klingon energy
Next I

FreeArray(Sector()) : Dim Sector(8,8) ; clear all sectors of old data

Sector(NCC_1701_SX,NCC_1701_SY) = 1 ;indicate Enterprise here

For I = 1 To KlingonsInQuadrant
   Gosub _5380 ;find an empty location
   Sector(F,G)= 2 ;indicate klingon here
   K(I,1)= F ;sector 'x' location
   K(I,2)= G ;sector 'y' location
   K(I,3)= KlingonMaxEnergy ;assign starting Klingon energy
Next I

For I = 1 To Starbase
   Gosub _5380 ;find an empty location
   Sector(F,G)=3 ;indicate starbase here
Next I

For I=1 To Stars ;for each star
   Gosub _5380 ;find an empty location
   Sector(F,G) = 4 ;indicate star here
Next I

Gosub _4120 ;short range scan

_ComPrompt: ;- ComPrompt
;{ this is the program control loop
   PrintN("")
   Print("COMMAND? ");
   
   Select Input()
      Case "0" : Gosub _1410
      Case "1" : Gosub _4120
      Case "2" : Gosub _2330
      Case "3" : Gosub _2530
      Case "4" : Gosub _2800
      Case "5" : Gosub _3460
      Case "6" : Gosub _3560
      Case "7" : Gosub _4620
   Default
      PrintN("   0 = SET COURSE")
      PrintN("   1 = SHORT RANGE SENSOR SCAN")
      PrintN("   2 = LONG RANGE SENSOR SCAN")
      PrintN("   3 = FIRE PHASERS")
      PrintN("   4 = FIRE PHOTON TORPEDO")
      PrintN("   5 = SHIELD CONTROL")
      PrintN("   6 = DAMAGE CONTROL REPORT")
      PrintN("   7 = CALL ON LIBRARY COMPUTER")
      PrintN("")
   EndSelect
   Goto _ComPrompt
;}
   
_1410: ;- SUB_1410 - SET COURSE
   ;{
   PrintN("")
   Repeat
      Print("COURSE (1-9) ");
      Course.f = ValF(Input())
   Until Course >=0 And Course<=9
   If Course=0 : Return : EndIf
   
   Repeat
      Print("WARP FACTOR (0-8) ");
      Warp.f = ValF(Input())
   Until Warp >=0 And Warp<=8
   If Warp=0 : Return : EndIf
   
   If Damage(1) < 0 And Warp > 0.2
      PrintN("WARP ENGINES ARE DAMAGED, MAXIMUM SPEED = WARP 0.2")
      Goto _1410
   EndIf
   
   If KlingonsInQuadrant > 0 ;klingons present
      Gosub _3790 ;klingons attack
      If Shields < 0 : FakeReturn : Goto _4000 : EndIf
   ElseIf Energy <= 0
      If Shields >= 1
         Print("YOU HAVE ");
            Print(Str(Energy))
         Print(" UNITS OF ENERGY")
         Print("SUGGEST YOU GET SOME FROM YOUR SHIELDS WHICH HAVE "+Str(Shields))
         Print("UNITS LEFT")
         Return
      Else
         FakeReturn : Goto _3920 ;dead in space
      EndIf
   EndIf
   
   For I = 1 To 8 ;repair some damage
      If Damage(I) < 0
         Damage(I)=Damage(I)+1
      EndIf
   Next I
   
   If RND(1) > 0.8
      Device = Int(RND(1)*8+1) ;choose which device
      If RND(1) < 0.5 ;damage
         Damage(Device) = Damage(Device)-(RND(1)*5+1)
         PrintN("")
         Print("DAMAGE CONTROL REPORT: ");
         Gosub _5610 ;print device name
         PrintN(" DAMAGED")
         PrintN("")
      Else ;repair
         Damage(Device) = Damage(Device)+(RND(1)*5+1)
         PrintN("")
         Print("DAMAGE CONTROL REPORT: ");
         Gosub _5610 ;print device name
         PrintN(" STATE OF REPAIR IMPROVED")
         PrintN("")
      EndIf
   EndIf
   
   SectorCount = Int(Warp * 8) ;number of sectors to move
   
   Sector(NCC_1701_SX,NCC_1701_SY) = 0
   X   = NCC_1701_SX
   Y.f = NCC_1701_SY
   R=Int(Course)
   
   Xinc = C(R,1) + (C(R+1,1) - C(R,1))*(Course-R)
   Yinc = C(R,2) + (C(R+1,2) - C(R,2))*(Course-R)
   
   ExitQuadrant = #False
   
   For I = 1 To SectorCount ;do once for every sector moved
      NCC_1701_SX  + Xinc
      NCC_1701_SY  + Yinc
      
      If NCC_1701_SX < 1 Or NCC_1701_SX > 8 Or NCC_1701_SY<1 Or NCC_1701_SY >8
         ExitQuadrant = #True
         Break
      EndIf
      
      If Sector(NCC_1701_SX,NCC_1701_SY) <> 0 ;collision
         Print("WARP ENGINES SHUTDOWN AT SECTOR")
         col = NCC_1701_SX
         row = NCC_1701_SY
         Gosub _9000
         PrintN("DUE TO BAD NAVIGATION")
         NCC_1701_SX - Xinc
         NCC_1701_SY - Yinc
         Break ;exit loop
      EndIf
   Next I
   
   If ExitQuadrant = #False
      Sector(NCC_1701_SX,NCC_1701_SY) = 1
      Energy = Energy - SectorCount + 5
      
      If Warp >= 1 : Stardate = Stardate + 1 : EndIf
      
      If Stardate > BeginDate + GameDuration : FakeReturn : Goto _3970 : EndIf ;time expired
      Gosub _4120 ;do short range scan
      Return
   Else ; entered another quadrant
      X = NCC_1701_QX*8 + X + Xinc* SectorCount
      Y = NCC_1701_QY*8 + Y + Yinc* SectorCount
      NCC_1701_QX = Int(X/8) ;set quadrant location
      NCC_1701_QY = Int(Y/8)
      NCC_1701_SX = Int(X - NCC_1701_QX*8 + 0.5) ;set sector location
      NCC_1701_SY = Int(Y - NCC_1701_QY*8 + 0.5)
      
      If NCC_1701_SX = 0
         NCC_1701_QX - 1
         NCC_1701_SX = 8
      EndIf
      
      If NCC_1701_SY = 0
         NCC_1701_QY - 1
         NCC_1701_SY = 8
      EndIf
      
      Stardate = Stardate  + 1
      Energy - SectorCount + 5
      If Stardate > BeginDate + GameDuration ;time expired
         FakeReturn : Goto _3970
      EndIf
   EndIf
FakeReturn : Goto _810 ;}

_2330: ;- SUB_2330 - LONG RANGE SCAN
   ;{
   PrintN("")
   If Damage(3) < 0
      PrintN("LONG RANGE SENSORS ARE INOPERABLE")
      Return
   EndIf
   
   Print("LONG RANGE SENSOR SCAN FOR QUADRANT");
   col = NCC_1701_QX
   row = NCC_1701_QY
   Gosub _9000
   PrintN("")
   PrintN("-------------------")
   For J = NCC_1701_QY-1 To NCC_1701_QY+1
      Print(": ")
      For I = NCC_1701_QX-1 To NCC_1701_QX+1
         If I > 0 And I < 9 And J > 0 And J < 9
            Print(RSet(Str(Quadrant(I,J)),3,"0")+" : ")
            If Damage(7)>=0 : GalaxyMap(I,J) = Quadrant(I,J) : EndIf
         Else
            Print("000 : ")
         EndIf
      Next I
      PrintN("")
      PrintN("-------------------")
   Next J
Return : ;}

_2530: ;- SUB_2530 - FIRE PHASERS
   ;{
   If KlingonsInQuadrant <= 0
      PrintN("SHORT RANGE SENSORS REPORT NO KLINGONS IN THIS QUANDRANT")
      Return
   EndIf
   
   If Damage(4) < 0
      PrintN("PHASER CONTROL IS DISABLED")
      Return
   EndIf
   
   If Damage(7) < 0
      PrintN(" COMPUTER FAILURE HAMPERS ACCURACY")
   EndIf
   
   Repeat
      PrintN("PHASERS LOCKED ON TARGET.  ENERGY AVAILABLE = "+Str(Energy))
      Print("NUMBER OF UNITS TO FIRE ");
      X = Val(Input())
      If X <= 0 : Return : EndIf
      If Energy - X < 0 : PrintN("INSUFFICIENT ENERGY") : EndIf
   Until Energy - X > 0

   Energy - X ;subtract phaser energy used
   
   Gosub _3790 ;Klingons attack
   If Shields < 0 : FakeReturn : Goto _4000 : EndIf
   
   If Damage(7) < 0 : X = X*RND(1) : EndIf ;reduce phaser energy if computer damaged
      
   For I = 1 To 3
      Delay(800) ;added by BasicallyPure
      If K(I,3) > 0
         ;calculate phaser damage [H]
         H = (X/KlingonsInQuadrant/FND(0))*(2*RND(1)+1) ;[phaserEnergy] / [num Klingons] / [distance]
         K(I,3)=K(I,3)-H
         PrintN("") ;added by BasicallyPure
            Print(Str(H))
         Print(" UNIT HIT ON KLINGON AT SECTOR ");
         col=K(I,1) ;sector x
         row=K(I,2) ;sector y
         Gosub _9000
         PrintN("") : Print(Space(27)+"(")
            Print(Str(K(I,3)))
         PrintN(" LEFT)")
         If K(I,3) <= 0
            Gosub _3690 ;Klingon destroyed
            If Klingons <= 0 : Break : EndIf
         EndIf
      EndIf
   Next I
   If Klingons <= 0 : FakeReturn : Goto _4040 : EndIf
   If Energy   < 0  : FakeReturn : Goto _4000 : EndIf
Return : ;}

_2800: ;- SUB_2800 - FIRE TORPEDO
   ;{
   If KlingonsInQuadrant <= 0
      PrintN("SHORT RANGE SENSORS REPORT NO KLINGONS IN THIS QUANDRANT")
      Return
   EndIf
   
   If Damage(5) < 0
      PrintN("PHOTON TUBES ARE NOT OPERATIONAL")
      Return
   EndIf
   
   If Torpedos <= 0
      PrintN("ALL PHOTON TORPEDOES EXPENDED")
      Return
   EndIf
   
   Repeat
      Print("TORPEDO COURSE (1-9) ");
      Course.f = ValF(Input())
   Until Course >= 0 And Course <= 9
   If Course = 0 : Return : EndIf
   
   R = Int(Course)
   Xinc = C(R,1) + (C(R+1,1) - C(R,1))*(Course-R) ;X increment
   Yinc = C(R,2) + (C(R+1,2) - C(R,2))*(Course-R) ;Y increment
   X = NCC_1701_SX
   Y = NCC_1701_SY
   Torpedos = Torpedos - 1
   
   PrintN("TORPEDO TRACK:")
   _2960: 
      Delay(800) ;added by BasicallyPure
      X + Xinc
      Y + Yinc
      If X < 0.5 Or X >= 8.5 Or Y<0.5 Or Y >= 8.5 : Goto _3420 : EndIf ;missed
      col = X
      row = Y
      Gosub _9000
      PrintN("")
      If Sector(Int(X+0.5),Int(Y+0.5)) = 0 ;empty sector
         Goto _2960
      EndIf
      
   If Sector(Int(X+0.5),Int(Y+0.5)) = 2 ;torpedo hits Klingon
      PrintN("*** KLINGON DESTROYED ***")
      KlingonsInQuadrant - 1
      Klingons - 1
      If Klingons <= 0 : FakeReturn : Goto _4040 : EndIf ;all Klingons destroyed
      
      For I = 1 To 3
         If Int(X+0.5)=K(I,1)
            If Int(Y+0.5)= K(I,2)
               Break
            EndIf
         EndIf
      Next I
         
      K(I,3)=0
   ElseIf Sector(Int(X+0.5),Int(Y+0.5)) = 4 ;torpedo hits star
      PrintN("YOU CAN'T DESTROY STARS SILLY")
      Goto _3420
   ElseIf Sector(Int(X+0.5),Int(Y+0.5)) = 3 ;torpedo hits starbase
      PrintN("*** STAR BASE DESTROYED ***  .......CONGRATULATIONS")
      Starbase - 1
      StarbaseTotal - 1
   Else
      Goto _2960 ;torpedo continues
   EndIf
   
   col = Int(X+0.5)
   row = Int(Y+0.5)
   Sector(Int(col),Int(row)) = 0
   Quadrant(NCC_1701_QX,NCC_1701_QY) = KlingonsInQuadrant*100 + Starbase*10 + Stars
   Goto _3430
   
   _3420: 
   PrintN("TORPEDO MISSED")
   
   _3430: 
   Gosub _3790 ;klingons attack
   If Shields < 0 : FakeReturn : Goto _4000 : EndIf
Return : ;}

_3460: ;- SUB_3460 - SHIELD CONTROL REQUEST
   ;{
If Damage(7) < 0
   PrintN("SHIELD CONTROL IS NON-OPERATIONAL")
   Return
EndIf

Repeat
   PrintN("ENERGY AVAILABLE = "+Str(Energy + Shields))
   Print("NUMBER OF UNITS TO SHIELDS ");
   X = Val(Input())
Until Energy + Shields - X > 0

If X <= 0  : Return : EndIf

Energy = Energy + Shields - X ;transfer of energy
Shields = X
Return : ;}

_3560: ;- SUB_3560 - DAMAGE CONTROL REPORT
   ;{
   If Damage(6) < 0
      PrintN("DAMAGE CONTROL REPORT IS NOT AVAILABLE")
   Else
      PrintN("DAMAGE CONTROL REPORT")
      PrintN("")
      PrintN("DEVICE          STATE OF REPAIR")
      
      For Device = 1 To 8
         Gosub _5610 ;print device names
         PrintN("  "+Str(Damage(Device)))
      Next Device
      
   EndIf
Return : ;}

_3690: ;- SUB_3690 - DESTROY KLINGON
   ;{
   Print("*** KLINGON AT SECTOR ");
   col=K(I,1)
   row=K(I,2)
   Gosub _9000
   PrintN("DESTROYED ***")
   KlingonsInQuadrant - 1
   Klingons - 1
   Sector(Int(K(I,1)+0.5),Int(K(I,2)+0.5)) = 0
   Quadrant(NCC_1701_QX,NCC_1701_QY) = KlingonsInQuadrant*100 + Starbase*10 + Stars
Return : ;}
   
_3790: ;- SUB_3790 - KLINGONS ATTACK!
   ;{
   If KlingonsInQuadrant <= 0 : Return : EndIf
   
   If C = 3 
      PrintN("STAR BASE SHIELDS PROTECT THE ENTERPRISE")
      Return
   EndIf

   For I = 1 To 3
      Delay(600) ;added by BasicallyPure
      If K(I,3) > 0
         H = (K(I,3)/FND(0))*(2*RND(1))
         Shields = Shields - H
         PrintN("") ;added by BasicallyPure
            Print(Str(H))
         Print(" UNIT HIT ON ENTERPRISE AT SECTOR ");
         col = K(I,1)
         row = K(I,2)
         Gosub _9000
         PrintN("") : Print(Space(30)+"(")
            Print(Str(Shields))
         PrintN(" LEFT)")
         If Shields < 0 : Break : EndIf
      EndIf
   Next I
   
Return : ;}


_3920: 
PrintN("THE ENTERPRISE IS DEAD IN SPACE! IF YOU SURVIVE THE")
PrintN("ALL IMPENDING ATTACK YOU WILL BE DEMOTED TO THE RANK")
PrintN("OF PRIVATE")

If KlingonsInQuadrant > 0
   Gosub _3790 ;klingons attack
   If Shields < 0 : Goto _4000 : EndIf
EndIf

Goto _4020

_3970: ;ran out of time 
PrintN("")
PrintN("IT IS STARDATE "+Str(Stardate))
Goto _4020

_4000: 
PrintN("")
Print("THE ENTERPRISE HAS BEEN DESTROYED. THE FEDERATION WILL");
PrintN(" BE CONQUERED")

_4020: 
Print("THERE ARE STILL ");
   Print(Str(Klingons))
PrintN(" KLINGON BATTLE CRUISERS")
Goto _230 ;restart game

_4040: 
PrintN("")
Print("THE LAST KLIGON BATTLE CRUISER IN THE GALAXY HAS BEEN");
PrintN(" DESTROYED")
PrintN("THE FEDERATION HAS BEEN SAVED !!!")
PrintN("")

PrintN("YOUR EFFICIENCY RATING = "+StrF( 100.0*OriginalKlingons/(Stardate - BeginDate),1 ))

Goto _230 ;restart game

_4120: ;- SUB_4120 - SHORT RANGE SCAN
   ;{
   PrintN("")
   Docked = #False
   For I=NCC_1701_SX-1 To NCC_1701_SX+1 ;docked check
      For J=NCC_1701_SY-1 To NCC_1701_SY+1
         If I>=1 And I<=8 And J>=1 And J<=8
            If Sector(I,J) = 3 ; docked
               C=3 : Energy = E_start : Torpedos = FullTorpLoad : Shields = 0
               PrintN("SHIELDS DROPPED FOR DOCKING PURPOSES")
               Docked = #True
               Break 2
            EndIf
         EndIf
      Next J
   Next I
   
   If Docked = #False
      If KlingonsInQuadrant > 0      : C=2 ;red
      ElseIf Energy < E_start*0.1 : C=1 ;yellow, K is starting energy
      Else             : C=0 ; green
      EndIf
   EndIf

   If Damage(2) < 0
      PrintN("")
      Print("*** SHORT RANGE SENSORS ARE OUT ***")
      PrintN("")
      Return
   EndIf
   
   ; sub at 9000 prints coordinates
   ; II indexes Y line, start at 1
   PrintN("--1--2--3--4--5--6--7--8--")

   For II = 1 To 8
      Select II
         Case 3,6 : Print(Str(II))
         Default: Print("|")
      EndSelect
      
      For I = 1 To 8
         A=Sector(I,II)
         Select A
            Case 1  : Print("<*>"); Enterprise
            Case 2  : Print("+++"); Klingon
            Case 3  : Print(">!<"); starbase
            Case 4  : Print(" * "); star
            Default : Print("   "); empty space
         EndSelect
      Next I
      
      Select II
         Case 3,6 : Print(Str(II))
         Default: Print("|")
      EndSelect
      
      Select II
         Case 1 : PrintN(" STARDATE  "+Str(Stardate))
         Case 2 : Print(" CONDITION ")
            Select C ;color added by BasicallyPure
               Case 1  : ConsoleColor(14,#BKG) : PrintN("YELLOW") : ConsoleColor(#TXT,#BKG)
               Case 2  : ConsoleColor(12,#BKG) : PrintN("RED")    : ConsoleColor(#TXT,#BKG)
               Case 3  : ConsoleColor(11,#BKG) : PrintN("DOCKED") : ConsoleColor(#TXT,#BKG)
               Default : ConsoleColor(10,#BKG) : PrintN("GREEN")  : ConsoleColor(#TXT,#BKG)
            EndSelect
         Case 3 : Print(" QUADRANT ")
            col=NCC_1701_QX : row=NCC_1701_QY : Gosub _9000 : PrintN("")
         Case 4 : Print(" SECTOR   ")
            col=NCC_1701_SX : row=NCC_1701_SY : Gosub _9000 : PrintN("")
         Case 5 : PrintN(" ENERGY    "+Str(Int(Energy)))
         Case 6 : PrintN(" SHIELDS   "+Str(Int(Shields)))
         Case 7 : PrintN(" PHOTON TORPEDOES "+Str(Torpedos))
         Default : PrintN("")
      EndSelect
      
   Next II
   
   PrintN("--1--2--3--4--5--6--7--8--")
Return : ;}

_4620: ;- SUB_4620 - LIBRARY COMPUTER
    ;{
   If Damage(8) < 0 
      PrintN("COMPUTER DISABLED")
      Return
   EndIf
   
   Repeat
      Print("COMPUTER ACTIVE AND AWAITING COMMAND ?")
      ExitComp = #True
      Select Input()
         Case "0" : Gosub _4740
         Case "1" : Gosub _4830
         Case "2" : Gosub _4880
         Case "3" : Gosub _4970
         Case "4" ;
      Default
         PrintN("")
         PrintN("FUNCTIONS AVAILABLE FROM COMPUTER")
         PrintN("   0 = CUMULATIVE GALATIC RECORD")
         PrintN("   1 = STATUS REPORT")
         PrintN("   2 = PHOTON TORPEDO DATA")
         PrintN("   3 = COURSE CALCULATOR")
         PrintN("   4 = EXIT COMPUTER") ;option 4 added by BasicallyPure
         PrintN("")
         ExitComp = #False
      EndSelect
      
   Until ExitComp = #True
Return : ;}

_4740: ;- SUB_4740 - GALAXY RECORD
   ;{
   PrintN("") : Print("COMPUTER RECORD OF GALAXY FOR QUADRANT");
   col = NCC_1701_QX
   row = NCC_1701_QY
   Gosub _9000
   PrintN("")
   PrintN("----1-- --2-- --3-- --4-- --5-- --6-- --7-- --8----")
   For J = 1 To 8 ; galaxy text formatted by BasicallyPure
      Print(Str(J)+" ")
      For I = 1 To 8 ;color added by BasicallyPure
         If I = NCC_1701_QX And J = NCC_1701_QY
            ConsoleColor(10,#BKG)
            Print(" "+RSet(Str(GalaxyMap(I,J)),3,"0")+"  ")
            ConsoleColor(#TXT,#BKG)
         ElseIf GalaxyMap(I,J) > 99 ;klingon
            ConsoleColor(12,#BKG)
            Print(" "+RSet(Str(GalaxyMap(I,J)),3,"0")+"  ")
            ConsoleColor(#TXT,#BKG)
         ElseIf GalaxyMap(I,J) > 9 ;starbase
            ConsoleColor(11,#BKG)
            Print(" "+RSet(Str(GalaxyMap(I,J)),3,"0")+"  ")
            ConsoleColor(#TXT,#BKG)
         Else
            Print(" "+RSet(Str(GalaxyMap(I,J)),3,"0")+"  ")
         EndIf
      Next I
      PrintN(Str(J))
      
      If J < 8
         PrintN("------- ----- ----- ----- ----- ----- ----- -------")
      Else
         PrintN("----1-- --2-- --3-- --4-- --5-- --6-- --7-- --8----")
      EndIf
   Next J
Return : ;}

_4830: ;- SUB_4830 - STATUS REPORT
   ;{
   PrintN("")
   PrintN("STATUS REPORT")
   PrintN("")
   PrintN("NUMBER OF KLINGONS  LEFT = "+Str(Klingons))
   PrintN("NUMBER OF STARDATES LEFT = "+Str((BeginDate + GameDuration)- Stardate))
   PrintN("NUMBER OF STARBASES LEFT = "+Str(StarbaseTotal))
Return : ;}

_4880: ;- SUB_4880 - PHOTON TORPEDO DATA
   ;{
   For I = 1 To 3
      If K(I,3) <= 0 : Goto _5260 : EndIf
      A = NCC_1701_SX ;Enterprise sector x
      B = NCC_1701_SY ;Enterprise sector y
      X = K(I,1)      ;Klingon sector x ?
      W = K(I,2)      ;Klingon sector y ?
      CalcMode = 0    ;calc mode off
      Gosub _5350
      _5260: 
   Next I
Return : ;}

_4970: ;- SUB_4970 - COURSE CALCULATOR
   ;{
   PrintN("")
   Print("YOU ARE AT QUADRANT");
   col = NCC_1701_QX : row = NCC_1701_QY : Gosub _9000
   Print("SECTOR");
   col = NCC_1701_SX : row = NCC_1701_SY : Gosub _9000
   
   Repeat
      PrintN("")
      PrintN("ENTER 4 COMMA SEPARATED VALUES")
      Print("START & DESTINATION COORDINATES ?");
   
      I$ = Input()
      If I$ = "" : Return : EndIf
      A = 0 : B = 0 : X = 0 : W = 0
      A = Val(StringField(I$,1,","))
      B = Val(StringField(I$,2,","))
      X = Val(StringField(I$,3,","))
      W = Val(StringField(I$,4,","))
   Until A<>0 And B<> 0 And X<>0 And W<>0

   CalcMode = 1 ;calc mode on
   Gosub _5350 
Return : ;}

_5350: ;- SUB_5350 - PLOT COURSE
   ;{
   ; A=startX, B=startY, X=destinationX, W=destinationY
   X = Int(X-A)
   A = Int(B-W)
   
   If X=0 And A=0
      PrintN("ERROR! DESTINATION CANNOT EQUAL START")
      FakeReturn : Goto _4970
   EndIf
   
   ;course calculation completely reworked by BasicallyPure
   ang.f = Degree(ATan2(X,A))
   D.f = 1 + (ang/45 + Bool(ang < 0)*8) ;direction
   Q.f = Sqr(X*X + A*A) ;distance
   
   PrintN("DIRECTION = " + StrF(D,2))
   Print( "DISTANCE  = " + StrF(Q,2));
   
   If CalcMode=1 ;calc mode is on
      X = Abs(X) : A = Abs(A)
      If X>A : L=X : Else : L=A : EndIf
      
      Print(Space(4)+"(");
      Print(StrF(L,2))
      Print(" WARP UNIT");
      
      If L>1 : Print("S") : EndIf
      
      Print(")");
   EndIf
   
   PrintN("")
Return : ;}

_5380: ;- SUB_5380 - FIND EMPTY LOCATION
   ;{
   Repeat
      F = Int(RND(1)*8+1)
      G = Int(RND(1)*8+1)
   Until Sector(F,G) = 0
Return : ;}

_5610: ;- SUB_5610 - PRINT DEVICE NAME
   ;{
   Select Device
      Case 1  : Print("  WARP ENGINES")
      Case 2  : Print("  S.R. SENSORS")
      Case 3  : Print("  L.R. SENSORS")
      Case 4  : Print("  PHASER CNTRL")
      Case 5  : Print("  PHOTON TUBES")
      Case 6  : Print("  DAMAGE CNTRL")
      Case 7  : Print("  SHIELD CNTRL")
      Default : Print("  COMPUTER    ")
   EndSelect
Return : ;}

_5820: ;- SUB_5820 - SHOW INSTRUCTIONS
   ;{
   ;instructions modified To notify of use of X,Y coordinates
   ; If A=2 then ENTER # prompts inserted To avoid scrolling
   PrintN("")
   PrintN("")
   PrintN("     INSTRUCTIONS:")
   PrintN("")
   PrintN("<*> = ENTERPRISE")
   PrintN("+++ = KLINGON")
   PrintN(">!< = STARBASE")
   PrintN(" *  = STAR")
   PrintN("")
   PrintN("COMMAND 0 = WARP ENGINE CONTROL")
   PrintN("  'COURSE IS IN A CIRCULAR NUMERICAL         4    3    2")
   PrintN("  VECTOR ARRANGEMENT AS SHOWN.                `.  :  .'")
   PrintN("  INTERGER AND REAL VALUES MAY BE               `.:.'")
   PrintN("  USED.  THEREFORE COURSE 1.5 IS             5---<*>---1")
   PrintN("  HALF WAY BETWEEN 1 AND 2.                     .':`.")
   PrintN("                                              .'  :  `.")
   PrintN("  A VECTOR OF 9 IS UNDEFINED, BUT            6    7    8")
   PrintN("  VALUES MAY APPROACH 9.")
   PrintN("                                               COURSE")
   PrintN("  ONE 'WARP FACTOR' IS THE SIZE OF")
   PrintN("  ONE QUADRANT.  THEREFORE TO GET FROM")
   PrintN("  QUADRANT 5,6 TO 5,5 YOU WOULD USE COURSE 3, WARP")
   PrintN("  FACTOR 1. COORDINATES ARE SPECIFIED USING X,Y NOTATION")
   PrintN("  WITH X 1-8 FROM LEFT-RIGHT AND Y 1-8 FROM TOP-BOTTOM.")
   If A<>2 : Goto _6009 : EndIf
   PrintN("")
   Print("PRESS ENTER TO CONTINUE...  ");
   Input()
   PrintN("")
   _6009: 
   PrintN("")
   PrintN("COMMAND 1 = SHORT RANGE SENSOR SCAN")
   PrintN("  PRINTS THE QUADRANT YOU ARE CURRENTLY IN, INCLUDING")
   PrintN("  STARS, KLINGONS, STARBASES, AND THE ENTERPRISE; ALONG")
   PrintN("  WITH OTHER PERTINATE INFORMATION.")
   PrintN("")
   PrintN("COMMAND 2 = LONG RANGE SENSOR SCAN")
   PrintN("  SHOWS CONDITIONS IN SPACE FOR ONE QUADRANT ON EACH SIDE")
   PrintN("  OF THE ENTERPRISE IN THE MIDDLE OF THE SCAN.  THE SCAN")
   PrintN("  IS CODED IN THE FORM XXX, WHERE THE UNITS DIGIT IS THE")
   PrintN("  NUMBER OF STARS, THE TENS DIGIT IS THE NUMBER OF STAR-")
   PrintN("  BASES, THE HUNDREDS DIGIT IS THE NUMBER OF KLINGONS.")
   PrintN("")
   PrintN("COMMAND 3 = PHASER CONTROL")
   PrintN("  ALLOWS YOU TO DESTROY THE KLINGONS BY HITTING HIM WITH")
   PrintN("  SUITABLY LARGE NUMBERS OF ENERGY UNITS TO DEPLETE HIS ")
   PrintN("  SHIELD POWER.  KEEP IN MIND THAT WHEN YOU SHOOT AT")
   PrintN("  HIM, HE GONNA DO IT TO YOU TOO.")
   If A<>2 : Goto _6159 : EndIf
   For I=1 To 5
   PrintN("")
   Next I
   Print("PRESS ENTER TO CONTINUE...  ");
   Input()
   PrintN("")
   _6159: 
   PrintN("")
   PrintN("COMMAND 4 = PHOTON TORPEDO CONTROL")
   PrintN("  COURSE IS THE SAME AS USED IN WARP ENGINE CONTROL")
   PrintN("  IF YOU HIT THE KLINGON, HE IS DESTROYED AND CANNOT FIRE")
   PrintN("  BACK AT YOU.  IF YOU MISS, HE WILL SHOOT HIS PHASERS AT")
   PrintN("  YOU.")
   PrintN("   NOTE: THE LIBRARY COMPUTER (COMMAND 7) HAS AN OPTION")
   PrintN("   TO COMPUTE TORPEDO TRAJECTORY FOR YOU (OPTION 2).")
   PrintN("")
   PrintN("COMMAND 5 = SHIELD CONTROL")
   PrintN("  DEFINES NUMBER OF ENERGY UNITS TO ASSIGN TO SHIELDS")
   PrintN("  ENERGY IS TAKEN FROM TOTAL SHIP'S ENERGY.")
   PrintN("")
   PrintN("COMMAND 6 = DAMAGE CONTROL REPORT")
   Print("  GIVES STATE OF REPAIRS OF ALL DEVICES.");
   PrintN("  A STATE OF REPAIR")
   PrintN("  LESS THAN ZERO SHOWS THAT THAT DEVICE IS TEMPORARALY")
   PrintN("  DAMAGED.")
   If A<>2 : Goto _6299 : EndIf
   For I=1 To 6
      PrintN("")
   Next I
   Print("PRESS ENTER TO CONTINUE...  ");
   Input()
   PrintN("")
   _6299: 
   PrintN("")
   PrintN("COMMAND 7 = LIBRARY COMPUTER")
   PrintN("  THE LIBRARY COMPUTER CONTAINS THREE OPTIONS:")
   PrintN("    OPTION 0 = CUMULATIVE GALACTIC RECORD")
   PrintN("     SHOWS COMPUTER MEMORY OF THE RESULTS OF ALL PREVIOUS")
   PrintN("     LONG RANGE SENSOR SCANS")
   PrintN("    OPTION 1 = STATUS REPORT")
   PrintN("     SHOWS NUMBER OF KLINGONS, STARDATESC AND STARBASES")
   PrintN("     LEFT.")
   PrintN("    OPTION 2 = PHOTON TORPEDO DATA")
   PrintN("     GIVES TRAJECTORY AND DISTANCE BETWEEN THE ENTERPRISE")
   PrintN("     AND ALL KLINGONS IN YOUR QUADRANT")
   If A<>2 : Goto _6408 : EndIf
   For I=1 To 11
      PrintN("")
   Next I
   Print("PRESS ENTER TO CONTINUE...  ");
   Input()
   PrintN("")
   _6408: 
   PrintN("")
Return : ;}

_9000: ;- SUB_9000 - PRINT COORDINATES
   ;{ coordinates (V(4),V(5))
   Print(" ");
   Print(Str(col))
   Print(",")
   Print(Str(row))
   Print(" ");
Return : ;}

CloseConsole()
End
Last edited by BasicallyPure on Sat Nov 21, 2015 7:36 pm, edited 1 time in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
heartbone
Addict
Addict
Posts: 1058
Joined: Fri Apr 12, 2013 1:55 pm
Location: just outside of Ferguson

Re: Old Star Trek text game converted to PureBasic

Post by heartbone »

BasicallyPure wrote:After several days of working on this in my spare time I have the code cleaned up quite a bit.
Many of the gotos have been removed. I believe all of the remaining gotos are now used
properly, no jumping out of loops. Gotos that leave subroutines are now preceded by a
'FakeReturn'. I have changed many of the one letter variable names to more meaningful ones.
Many comments have been added. Color has been added to the short range and long range
scans along with some formatting changes. Phasers have been made more effective.
I have tested with Windows and Linux.

In summary the code should now be much easier to read. If you are of a mind you can
perform a few tweaks of your own without the hassle of cryptic code.
Thank you for this work BasicallyPure.
If I can ever get the programming class at school implemented, this will likely be part of the curriculum.
Some youngsters have a hard time wrapping their minds around the fact that this was actually fun.

If you like me were around computer games in the late 70s and early eighties,
then you may have played what I considered the most amazing game for a home computer.
It was based around the STAR TREK template.

I wonder if I still have my STAR RAIDERS™ cartridge, manual, and box somewhere.
Image

By any chance did you get a chance to experience its number crunching graphics glory?
It was truly a thing to behold.

edit: For anyone who cares to, now you can behold! :)

I just found the game in the internet archive, emulated in a browser!
https://archive.org/details/a8b_cart_St ... 9_Atari_US

The (pre-IBM PC) Atari 800 keyboard contained a row of 4 control keys: SYSTEM RESET/OPTIONS/SELECT/START.
I don't know how those inputs are handled in the game emulation, but for the rest of the gameplay you'll need this guide to know what to do.
http://strategywiki.org/wiki/Star_Raiders/Controls

I'm currently running Linux and the gamepad handlers are currently not as robust as Windows®'s, and this is embedded in a browser, so I have not successfully run it.
I'll probably have to boot into XP to make it all work.

This magnificent 8Kb ROM game executed in a mere 8Kb of RAM.
Adding the original 10Kb ROM of the 400/800 operating system, completes STAR RAIDERS 26Kb memory footprint.
Good stuff.

http://videogames.org/html/5200Stuff/St ... orial.html
__________________________

In case that you missed it, here's a plug for my Star Trek on YouTube (mostly) forum page of links.
After CBS posted the entire original series on YouTube, and Nimoy then passed, combined with the accelerating pace of fan productions, it would be near impossible to recreate that list today from scratch.
There's far too much for a single person to sort through.
And it's a good thing that I did not attempt to catalogue CBS's TOS YouTube video posts, after a few months they were pulled, and now cost $.
So many people want to be the Captain.
Last edited by heartbone on Thu Jul 16, 2015 2:48 pm, edited 1 time in total.
Keep it BASIC.
Tess
New User
New User
Posts: 6
Joined: Thu Sep 25, 2014 8:59 am

Re: Old Star Trek text game converted to PureBasic

Post by Tess »

Great,
Sounds and voices can be added with those found here http://www.trekcore.com/audio/
:D
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Old Star Trek text game converted to PureBasic

Post by BasicallyPure »

heartbone wrote:By any chance did you get a chance to experience its number crunching graphics glory?
It was truly a thing to behold.
I am sorry to say I have not encountered the Star Raider game.


@Tess
Thanks for the audio link.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Post Reply