Imports System.Math
'
' *** Notes ***
'
' *1. Used Windows Visual Basic 2008 Express Edition to edit and
' compile this code.
'
' *2. Took the original source code found on a web site about
' Star Trek (Basic) and modified it to be Windows Based
' version of the Text Based Star Trek. Took some inspiration
' from the "Apple-][ Trek" program which I enjoyed a lot
' back in the late 1970's and into early 1980's. Did this
' project on my own time over a several weeks to get the
' code up to the current version. Here a little, there a
' little bit of time.
'
' Here's the header comments from that code.
' ---
' - Extracted from HP tape image 16-Nov-2003 by Pete Turnbull
' -
' - HP BASIC PROGRAM LIBRARY
' -
' - STTR1: STAR TREK
' -
' - 36243 REV B -- 10/73
' -
' - CONTRIBUTED PROGRAM
' -
' - STAR TREK: BY MIKE MAYFIELD, CENTERLINE ENGINEERING
' -
' - TOTAL INTERACTION GAME - ORIG. 20 OCT 1972
' ---
'
' *3. Next customized the code by removing line numbers that
' were not referenced anywhere else in the code. Then
' modified the code to use subroutines to work properly
' in Windows. Later changed the name of the subroutines to
' tell what each routine does.
'
' *4. Customized some of the logic. Things like:
'
' - Pseudo Random Number generator to insure a different
' starting layout each time the initialization logic is
' run.
' - This is accomplished by the logic using the current
' date and time as the Pseudo Random Number generator
' then randomly generating the initialization for the
' game.
'
' - Unrolled Array Data in the original program for Long
' Range Scanner and Sector arrays.
' - For Example, Unrolled the Data for the Sector Array
' into ONLY 64 characters instead of using an 8 by 8
' array which requires a lot more variable space to use.
'
' - The ">" to the left of the Current Quadrant where the
' Enterprise is on the Quadrant Map.
'
' - Allowed Warping around the edge of the map. Such as
' warping from Quadrant 2,7 at sector 1,4 in Warp
' Direction of 4.5 at Warp Factor 3!
'
' - Added Function Buttons that bring up a TabControl based
' on certain functions for:
' - Navigation
' - Photon Torpedo
' - Phaser Control
' - Shields Control
' *** Text Based Data for each tab added to each tab
' which took away the need for complex list of text
' needed to show the instructions.
' *** When the TabControl is needed, it is shown. Then
' after the function is done, then TabControl is
' hidden.
' *** TabControl gets moved from its' hidden location to
' cover up the function buttons when it is needed
' by using the upper left location of the hidden
' control named OverlayLocation.
'
' - Added Constant Values where needed to simplify changing
' of Global Values instead of having to find each variable
' inside of the code to change that value every place it
' was setup in the original code.
' - See:
' Const BaseEnergy = 5000
' Const BasePhotons = 25
' Const BaseShields = 1000
' Const MaxStarDates = 30
' Const StarBaseToken = "B" ' Star Base
' Const EnterpriseToken = "E" ' Enterprise
' Const StarSpotToken = "*" ' Star on the map
' Const EmptySpotToken = " " ' Unoccupied space
' Const KlingonToken = "K" ' Klingon Cruiser
' - To match the original programs' values to:
' Const BaseEnergy = 3000
' Const BasePhotons = 10
' - I added BaseShields value of 1000 to make sure that
' each time the program runs or another game is chosen
' or we dock with a Star Base that the Enterprise's
' Shields will start at 1000 units of Energy.
'
' - Added Sound Functionality with the ability to turn sound
' on and off within the program.
' - Plays the Wave Files as per the filenames listed inside
' of this program. The Wave Files are used from the
' location / directory where the executable program
' exists. If the Wave File is not found, this program is
' smart enough not to crash when the file is not there.
' - See this logic:
' ' Make Sound!
' Dim SoundFile As String = _
' System.AppDomain.CurrentDomain.BaseDirectory + _
' "EnterpriseKilled.WAV"
' If System.IO.File.Exists(SoundFile) Then
' My.Computer.Audio.Play(SoundFile)
' End If
'
' - Damage Control Function was automated. So there is no
' need to press a button to get a report.
' - Added "Spock used a new repair technique!" like was
' occasionally seen in Apple-][ Trek when a device was
' repaired beyond 1 Star Date when moving.
'
' - Short Range Scan for the Current Quadrant is shown in
' the Long Range Scan even if the Long Range Scanner is
' damaged.
' - If Short Range Scanner is damaged, then ONLY up to 1
' unit around the Enterprise is shown in the current
' quadrant instead of being totally blind in the current
' quadrant.
'
' - Upon Docking with a Star Base, ALL damaged devices are
' repaired and the Shields and Energy are reset to the
' initial values.
'
' - Displays the Current Date and Time in the lower right
' corner of the interface.
'
' - Displays Condition Status Text in Color.
' - "Green" is displayed in Green.
' - "Red" is displayed in Red.
' - "Yellow" is displayed in Yellow.
'
' *5. There are many areas that the program could be enhanced.
' Such as:
'
' - Adding a Library Computer Function to automatically
' target every Klingon in the current Quadrant then fire
' Photon Torpedoes at them.
'
' - Adding a Library Computer Function to calculate moving
' from the current Sector in this Quadrant to another
' Sector in the current Quadrant.
'
' - Adding a Library Computer Function to calculate the
' Warp Factor and Warp Direction to move to another
' Quadrant.
' - For Example, Calculating the shortest distance from
' Quadrant 2,7 to Quadrant 4,1.
'
' - Allowing the Klingons to move like in Apple-][ Trek did
' when Klingons were nearly destroyed but barely had
' enough energy to escape to a connected Quadrant if said
' Klingon was on the outer edge of the current Quadrant
' BUT ONLY if the Klingon wouldn't cause the Quadrant it
' wants to move into would not cause the number of
' Klingons to go above 9!
' - X or Y values of either 1 or 8.
'
' - Allowing User Input for up to 200 Klingons with 1 Star
' Base and 1 Star Base for Every 10 after that.
' - Allow up to a Maximum Value of 9 Klingons per any
' randomly chosen Quadrant.
' * This was done on January 25, 2009 *
'
' - Allowing up to 9 Klingons per Quadrant.
' - Modified the Klingon Array to allow up to 9 but didn't
' modify the code to generate up to 9 in a quadrant.
' - See "KlingonSectorAndShieldsData" Array!
'
' - Efficiency Rating needs to be reworked to a better
' formula. I would suggest something like the way Apple-][
' Trek did it!
'
' - Star Date fine tuning to allow subwarp speeds to not
' calculate as 1 full Star Date. (Warp Speeds under 1)
'
' - Randomly place Enterprise if Warp Speed is 1 or more
' and successfully warped.
' - Currently places Enterprise at the same sector value
' if Warp Factor is a whole number between 1 and 7.
' - So if you started at Quadrant 1,2 at Sector 3,4
' and you warped 2 at direction 1, the Enterprise
' would end up at Quadrant 3,2 at Sector 3,4.
'
' *6. There are bugs may still be in this program!
'
' For example: Saw this bug on November 15, 2008:
'
' Firing a Photon Torpedo from this location that doesn't
' destroy the star like the message log showed.
' - FIXED this bug on January 5, 2009! See the note below!
'
' Current Quadrant Map displayed as follows for the
' "Sector (Short Range Sensor Scan)":
' +-------------------+
' | 1 2 3 4 5 6 7 8 |
' | 1 * |
' | 2 * |
' | 3 |
' | 4 K * |
' | 5 * |
' | 6 * |
' | 7 E |
' | 8 |
' +-------------------+
'
' Used the "Compute Enemy Direction and Distance" button.
'
' Fired Photon Torpedo at Direction of "4.5".
'
' Message Log showed:
' ---
' - Direction = 4.5
' - Distance = 6.70820393249937
' -
' - Photon Torpedo Track: (6,6) (6,5) (5,4) (5,3) (4,2)
' - *** Star Destroyed ***
' ---
'
' IF the Photon Torpedo Track were accurate, Star at 5,4
' should have been destroyed. Then if the SAME direction
' of 4.5 would have been used then the Star at 4,2 should
' have been destroyed.
'
' *** Note *** FIXED on January 5, 2009 by insuring that the
' values for Z1 and Z2 are integers by using
' the following logic:
' ---
' - Z1 = Int(S1 + 0.5) ' X location
' - Z2 = Int(S2 + 0.5) ' Y location
' - InsertIntoStringArrayForSector(InputData)
' ---
'
' * This adjusts the Photon Torpedo Track to:
' (7,6) (6,5) (6,4) (5,3) (5,2) (4,1)
'
' * This would mean that the Klingon at 4,1 is destroyed!
'
' *** This points out why one should be very careful to
' use integer values when integer values are expected!
' - For Example, If we pass a double value of 7.99 to
' an integer value, the program will drop the
' fractional part (.99) which results in a value of 7
' instead of 8!
' - That is why I changed "Z1 = S1" to
' "Z1 = Int(S1 + 0.5)" to make sure if the value of
' S1 is almost 8 that 8 will be used for Z1!
' ---
Public Class frmMain
Dim InputData As String
Dim X As Double 'Integer
Dim Y As Double 'Integer
Dim X1 As Double 'Integer
Dim X2 As Double 'Integer
Dim H As Integer
Dim A As Integer
Dim T0 As Double 'Integer
Dim T As Double 'Integer
Dim T9 As Double 'Integer
'Dim T7 As Integer
'Dim D0 As Integer
Dim E0 As Integer
Dim E7 As Integer
Dim P0 As Integer
Dim P As Integer
Dim S9 As Integer
Dim S As Integer
Dim H8 As Integer
Dim B3 As Integer
Dim TotalStarBases As Integer
Dim MaximumStarBases As Integer
Dim KlingonsLeft As Integer
Dim R1 As Integer
Dim R2 As Integer
Dim K3 As Integer
Dim TotalKlingons As Integer
Dim S3 As Integer
Dim Z1 As Integer
Dim Z2 As Integer
Dim Z3 As Integer
Dim W1 As Double 'Integer
Dim Num As Integer
Dim C1 As Double 'Integer
Dim C2 As Integer ' As Double 'Integer
Dim GalaxyKlingonStarBaseAndStarsData(8 + 1, 8 + 1)
Dim C(9 + 1, 2 + 1)
'
'
Const MaximumKlingonsPerQuadrant As Integer = 9
'
' KlingonSectorAndShieldsData() Array contains this Data
' based on I = Klingon Number within a Sector.
'
' Where:
' KlingonSectorAndShieldsData(I, 1) = Sector X offset
' KlingonSectorAndShieldsData(I, 2) = Sector Y offset
' KlingonSectorAndShieldsData(I, 3) = Shields Value
Dim KlingonSectorAndShieldsData( _
MaximumKlingonsPerQuadrant + 1, 3 + 1)
'Dim N(3 + 1)
'Dim Z(8 + 1, 8 + 1)
Dim DeviceArrayForDamageTime(8 + 1)
Dim I As Integer
Dim J As Integer
' Quadrant and Sector Values
Dim Q1 As Integer
Dim Q2 As Integer
Dim S1 As Double 'Integer
Dim S2 As Double 'Integer
' The LastQ1 and LastQ2 are to prevent playing the Red Alert
' sound effect more than once in the current Quadrant!
' - However, If we turn the sound off then back on Red Alert
' will sound since the Sound On / Off button resets the
' value when the Sound is turned back On!
Dim LastQ1 As Integer = 0
Dim LastQ2 As Integer = 0
' Start program with sound effects ON by default!
Dim SoundsFlag As Boolean = True ' = False
Dim Cstring As String '(6)
'Dim Dstring As String ' (72)
'Dim Estring As String ' (24)
'Dim InputData(3)
Dim SectorArray As String '(72)
'Dim Rstring As String '(72)
'Dim Sstring As String '(48)
'Dim Zstring As String ' (72)
Dim Temp1, Temp2, Temp3 As String
' *** Note I added the Constants to make it very easy to
' *** change these Constants without having to find the
' *** hard coded values multiple times in the Original
' *** Program's Code!
' Base Energy was 3000 in the Original Program
Const BaseEnergy = 5000 ' *** Was: 3000
' Base Photon Torpedos was 10 in the Original Program
Const BasePhotons = 25 ' *** Was: 10
' Base Shields wasn't setup in the Original Program
Const BaseShields = 1000 ' *** Was: 0
'Const MinimumShieldsToCalcDamage = 1000
Const MaxStarDates = 30 ' *** Was: 30
Const StarBaseToken = "B" ' Star Base
Const EnterpriseToken = "E" ' Enterprise
Const StarSpotToken = "*" ' Star on the map
Const EmptySpotToken = " " ' Unoccupied space
Const KlingonToken = "K" ' Klingon Cruiser
Dim GameOverFlag As Boolean = False
Dim LongRangeData As String = ""
'' Is Enterprise Moving?
'' - False = Stopped in Space
'' - True = Moving using Warp Drive
'Dim EnterpriseIsMoving As Boolean = False
'---
' Global Variables returned from "frmNewGame"
'
' "N" = Normal Random Game
' "C" = Custom Number of Klingons
Public GameType As String = "N"
'
' If GameType = "C" then Randomly assign the
' Klingons in the 8 x 8 Quadrant Array based on
' the number in MaxKlingonsSelected Value!
Public MaxKlingonsSelected As Integer = 0
'---
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'' Play Sound Effect ONLY if Sounds are set to ON!
'If SoundsFlag = True Then
'
' ' Play Star Trek Intro Music!
' Dim SoundFile As String = _
' System.AppDomain.CurrentDomain.BaseDirectory + _
' "Intro.WAV"
''
' If System.IO.File.Exists(SoundFile) Then
' My.Computer.Audio.Play(SoundFile)
' End If
'End If
' Note: Version Number 8.08.11.05 means:
' - First digit is the last number of the Visual
' Studio Compiler.
' - 8 = Visual Studio 2008
' - Year of 2008, Month of 11 (November), Day of 5
' -- Translates to: November 5, 2008
'
' Version Number 8.9.01.03 means:
' - First digit is the last number of the Visual
' Studio Compiler.
' - 8 = Visual Studio 2008
' - Year of 2009, Month of 1 (January), Day of 3
' -- Translates to: January 3, 2009
StartNewMission()
End Sub
Private Sub StartNewMission()
Dim I As Integer
Dim J As Integer
' Reset Game Over Flag when starting a New Mission!
GameOverFlag = False
' ---
' Show New Game Form to select Game Type
Dim SelectNewGame As New frmNewGame
Me.Hide()
SelectNewGame.ShowDialog()
SelectNewGame.Hide()
Me.Show()
SelectNewGame.Dispose()
'---
' Get Current Values for these to use for the Pseudo
' Randomize Logic Below:
' - Hour
' - Minute
' - Second
' - Month
' - Day
' - Year
Dim CurrentHour As Integer = TimeOfDay.Hour
Dim CurrentMinute As Integer = TimeOfDay.Minute
Dim CurrentSecond As Integer = TimeOfDay.Second
Dim CurrentMonth As Integer = Today.Date.Month
Dim CurrentDay As Integer = Today.Date.Day
Dim CurrentYear As Integer = Today.Date.Year
' AI1, AI2, and AJ2 are used to pseudo randomize
' the random number seed!
Dim AI1 As Integer = 0
Dim AI2 As Integer = _
((CurrentYear Mod 20) * 4) + _
((CurrentSecond Mod 9) * 3) + _
((CurrentMonth Mod 3) * 5) + 37
'
'Dim AJ1 As Integer = 0
Dim AJ2 As Single = _
((CurrentHour Mod 6) * 5) + _
((CurrentDay Mod 13) * 3) + _
((CurrentMinute Mod 7) * 2) + _
((CurrentSecond Mod 12) * 3) + 13
'
Dim AB1 As Single = 0
'
' Pseudo Randomize the seeding of random number
' - This insures a Random Universe each time the game
' is run.
For AI1 = 0 To AI2
AB1 = Rnd(AJ2) 'AB1 = AJ2 * Rnd(1)
Next AI1
'
' *** Initialize the Variables below ***
'
' 1 2 3 4
' ....5....0....5....0....5....0.....5....0....5...
' | xxx | xxx | xxx | xxx | xxx | xxx | xxx | xxx |
' Long Range Sensor Scan
LRSS1.Text = Space(48)
LRSS2.Text = Space(48)
LRSS3.Text = Space(48)
LRSS4.Text = Space(48)
LRSS5.Text = Space(48)
LRSS6.Text = Space(48)
LRSS7.Text = Space(48)
LRSS8.Text = Space(48)
' Combine ALL Long Range Data before updating it!
LongRangeData = LRSS1.Text + _
LRSS2.Text + _
LRSS3.Text + _
LRSS4.Text + _
LRSS5.Text + _
LRSS6.Text + _
LRSS7.Text + _
LRSS8.Text
OriginalMission.Text = ""
RemainingMission.Text = ""
MessageLog.Clear()
' Short Range Sensor Scan Data
SRSS1.Text = Space(32)
SRSS2.Text = Space(32)
SRSS3.Text = Space(32)
SRSS4.Text = Space(32)
SRSS5.Text = Space(32)
SRSS6.Text = Space(32)
SRSS7.Text = Space(32)
SRSS8.Text = Space(32)
StarDate.Text = ""
Condition.Text = "Green"
Condition.ForeColor = Color.Green
Quadrant.Text = ""
Sector.Text = ""
PhotonTorpedoes.Text = ""
Shields.Text = ""
Energy.Text = ""
KlingonsCount.Text = ""
' Auto Repair all devices since starting a new game!
For I = 0 To 9 '1 To 8
DeviceArrayForDamageTime(I) = 0
Next I
UpdateDamageControlData()
'StatusWarpEngines.Text = "Online"
'StatusShortRangeSensors.Text = "Online"
'StatusLongRangeSensors.Text = "Online"
'StatusPhaserControl.Text = "Online"
'StatusPhotonTorpedoes.Text = "Online"
'StatusDamageControl.Text = "Online"
'StatusShieldControl.Text = "Online"
'StatusComputer.Text = "Online"
' Reset Last Quadrant Data
' - This is used to ONLY play Red Alert once per Quadrant!
' - Prevent Playing the Sound Effect until changing into
' another quadrant!
LastQ1 = 0
LastQ2 = 0
' Setup Starting "Star Date" Data
T0 = Int(Rnd(1) * 20 + 20) * 100
T = T0
T9 = MaxStarDates ' *** Was: 30
'
' Docked (0 = No, 1 = Yes
'D0 = 0
'
' Energy Data
E0 = BaseEnergy ' *** Was: 3000
E7 = E0 ' - BaseShields ' Was: E0
'
' Photon Torpedoes
P0 = BasePhotons ' *** Was: 10
P = P0
' Shields
S9 = 200
S = BaseShields ' Was: 0
H8 = S
' Randomly Pick a Starting Quadrant and Sector!
Q1 = Int(Rnd(1) * 8 + 1)
Q2 = Int(Rnd(1) * 8 + 1)
S1 = Int(Rnd(1) * 8 + 1)
S2 = Int(Rnd(1) * 8 + 1)
'T7 = TIM(0) + 60 * TIM(1)
' ---
' October 24, 2008:
'
' Used this to test a Warp from Quadrant 2,7
' at Sector 1,4 to test Warp Direction 4.5
' at Warp Factor 3!
' - Helped to fix a bug in StringComparisonInSectorArray()
' routine where Z1 was equal to Zero!
' - The bug would cause the program to crash!
'Q1 = 2
'Q2 = 7
'
'S1 = 1
'S2 = 4
'---
' I have no idea why the C() Array Values used these
' values at these locations!
C(2, 1) = -1
C(3, 1) = -1
C(4, 1) = -1
C(4, 2) = -1
C(5, 2) = -1
C(6, 2) = -1
C(1, 1) = 0
C(3, 2) = 0
C(5, 1) = 0
C(7, 2) = 0
C(9, 1) = 0
C(1, 2) = 1
C(2, 2) = 1
C(6, 1) = 1
C(7, 1) = 1
C(8, 1) = 1
C(8, 2) = 1
C(9, 2) = 1
'' '....5....0.2..5....0'
'Dstring = "Warp Engines " + _
' "Short Range Sensors " + _
' "Long Range Sensors " + _
' "Phaser Control " + _
' "Photon Torpedo Tubes" + _
' "Damage Control " + _
' "Shield Control " + _
' "Computer "
TotalStarBases = 0
MaximumStarBases = 0
KlingonsLeft = 0
'---
' Get the information selected on the frmNewGame Form!
'
' "N" = Normal Random Game
' "C" = Custom Number of Klingons
If GameType = "N" Then
GoTo RandomizeKlingonsStarbasesAndStars
End If
'---
' GameType is "C" (Custom) since we got to this point!
' - So handle the Custom Setup!
'
' Randomly Pick the Number of stars in each Quadrant
' first. We have to initialize the Array anyway... So
' assigning the Stars first made the most sense!
For I = 1 To 8
For J = 1 To 8
'
' Randomly pick number of stars for each Quadrant!
S3 = Int(Rnd(1) * 8 + 1)
'
GalaxyKlingonStarBaseAndStarsData(I, J) = S3
Next
Next
' GameType is "C" (Custom) since we got to this point!
' then Randomly assign the
' Klingons in the 8 x 8 Quadrant Array based on
' the number in MaxKlingonsSelected Value!
Dim X1 As Integer
Dim X2 As Integer
Dim x As Integer
For x = 1 To MaxKlingonsSelected
RetryKlingonSelection:
' Randomly Pick a Quadrant between (1,1) to (8,8)
'
I = Int(Rnd(1) * 8 + 1)
J = Int(Rnd(1) * 8 + 1)
X1 = GalaxyKlingonStarBaseAndStarsData(I, J)
X2 = Int(X1 / 100) ' We now have the Klingons Value!
' If we have 9 Klingons in the selected Quadrant, then
' randomly reselect another Quadrant!
If X2 = 9 Then
GoTo RetryKlingonSelection
End If
' Add 1 Klingon into the Selected Quadrant
GalaxyKlingonStarBaseAndStarsData(I, J) = _
GalaxyKlingonStarBaseAndStarsData(I, J) + 100
KlingonsLeft = KlingonsLeft + 1
Next
' Allow 1 Starbase and 1 Starbase for every 10 Klingons
' after that!
Dim MaxStarBases As Integer = 1 + _
Int(MaxKlingonsSelected / 10)
For x = 1 To MaxStarBases
RetryStarBasesSelection:
' Randomly Pick a Quadrant between (1,1) to (8,8)
'
I = Int(Rnd(1) * 8 + 1)
J = Int(Rnd(1) * 8 + 1)
X1 = GalaxyKlingonStarBaseAndStarsData(I, J)
X2 = Int(X1 / 100) ' We now have the Klingons Value!
' B3 = 0 or 1 Star Base in this Quadrant
X1 = X1 - (100 * X2) ' Subtract out the Klingons value
X2 = Int(X1 / 10) ' We now have the Star Bases Value!
' If we have a Star Base in the selected Quadrant, then
' randomly reselect another Quadrant!
If X2 > 0 Then
GoTo RetryStarBasesSelection
End If
' Add 1 Star Base into the Selected Quadrant
GalaxyKlingonStarBaseAndStarsData(I, J) = _
GalaxyKlingonStarBaseAndStarsData(I, J) + 10
TotalStarBases = TotalStarBases + 1
MaximumStarBases = MaximumStarBases + 1
Next
GoTo CommonSetup
' Normal Game Setup here!
RandomizeKlingonsStarbasesAndStars:
TotalStarBases = 0
MaximumStarBases = 0
KlingonsLeft = 0
Dim RandomValuesBasedOn1 As Double
For I = 1 To 8
For J = 1 To 8
''Test...
'K3 = 2
'KlingonsLeft = KlingonsLeft + 2
'GoTo Common1
' Randomly Pick the number of Klingons for a sector
RandomValuesBasedOn1 = Rnd(1)
' 3 Klingons?
If RandomValuesBasedOn1 > 0.98 Then GoTo Klingon3
' 2 Klingons?
If RandomValuesBasedOn1 > 0.95 Then GoTo Klingon2
' 1 Klingon?
If RandomValuesBasedOn1 > 0.8 Then GoTo Klingon1
' No Klingons
K3 = 0
GoTo Common1
Klingon3:
K3 = 3
KlingonsLeft = KlingonsLeft + 3
GoTo Common1
Klingon2:
K3 = 2
KlingonsLeft = KlingonsLeft + 2
GoTo Common1
Klingon1:
K3 = 1
KlingonsLeft = KlingonsLeft + 1
Common1:
RandomValuesBasedOn1 = Rnd(1)
If RandomValuesBasedOn1 > 0.96 Then GoTo StarBase1 '700
B3 = 0 ' No Star Base for this sector!
GoTo Stars1 '720
StarBase1:
B3 = 1 ' 1 Star Base for this sector!
TotalStarBases = TotalStarBases + 1
MaximumStarBases = MaximumStarBases + 1
Stars1:
' Randomly pick number of stars for this Quadrant!
S3 = Int(Rnd(1) * 8 + 1)
' Galaxy Data Array contains Quadrant Data.
'
' Each Quadrant's Data contains:
'
' 100's digit indicates Klingons
' 10's digit indicates presence of Star Base or not
' 1's digit indicates the number of Stars
'
' For Example:
'
' 213 would translate to:
' 2 Klingons, 1 Star Base, and 3 Stars
'
' 302 would translate to:
' 3 Klingons, No Star Base, and 2 Stars
'
' 011 would translate to:
' No Klingons, 1 Star Base, and 1 Star
'
' K3 = Klingons
' B3 = Star Base (0 = none, 1 = 1 Star Base)
' S3 = Number of Stars
'
' I = X offset
' J = Y offset
GalaxyKlingonStarBaseAndStarsData(I, J) = _
K3 * 100 + _
B3 * 10 + _
S3
'Z(I, J) = 0
Next J
Next I
' Show the Setup Data
CommonSetup:
' Calculate Maximum Star Dates...
' - We may have MORE Quadrants with Klingons than the
' allotted number of Star Dates.
' - We want to allow the Mission to have a chance for
' success!
T9 = MaxStarDates ' *** Was: 30
Dim QuadrantsWithKlingons As Integer = 0
For I = 1 To 8
For J = 1 To 8
X1 = GalaxyKlingonStarBaseAndStarsData(I, J)
X2 = Int(X1 / 100) ' We now have the Klingons Value!
If X2 > 0 Then
QuadrantsWithKlingons = QuadrantsWithKlingons + 1
End If
Next
Next
' If we have more Quadrants with Klingons in them than
' the normal Maximum Star Dates, then
' Calculate Maximum Star Dates to use!
If QuadrantsWithKlingons > MaxStarDates Then
T9 = Int(QuadrantsWithKlingons * 1.5)
End If
' Hold the number of Klingons
TotalKlingons = KlingonsLeft
' If NO Starbases and No Klingons, then try again!
If TotalStarBases <= 0 Or KlingonsLeft <= 0 Then
GoTo RandomizeKlingonsStarbasesAndStars
End If
OriginalMission.Text = _
"You must destroy " + _
KlingonsLeft.ToString() + _
" Klingons in " + _
T9.ToString() + _
" Star Dates with " + _
TotalStarBases.ToString() + _
" Star Bases"
MapNextQuadrant()
End Sub
Private Sub MapNextQuadrant()
' Make sure game is NOT over before we map the Next Quadrant!
CheckForGameOver()
If GameOverFlag = True Then
'StartNewMission()
Exit Sub
End If
'Dim input1 As ConsoleKeyInfo
'End Sub
'Private Sub MapNextQuadrantData()
Dim I As Integer
Dim J As Integer
Entry810: '810:
K3 = 0
B3 = K3
S3 = K3
' Don't Allow Quadrant to go OUTSIDE of range of 1 to 8!
If Q1 < 1 Then Q1 = Q1 + 8
If Q1 > 8 Then Q1 = Q1 - 8
If Q2 < 1 Then Q2 = Q2 + 8
If Q2 > 8 Then Q2 = Q2 - 8
'If Q1 < 1 Or Q1 > 8 Or Q2 < 1 Or Q2 > 8 Then
' GoTo Entry920 '920
'End If
' K3 = Number of Klingons in this Quadrant
'
' GalaxyKlingonStarBaseAndStarsData array holds each
' Quadrant's Data where the 100's digit holds the number
' of Klingons, the 10's digit holds the number of
' Star Bases (0 or 1 ONLY), and the 1's digit holds
' the number of stars!
'
' The logic below uses a placeholder variable XX
Dim XX As Integer
XX = GalaxyKlingonStarBaseAndStarsData(Q1, Q2)
K3 = Int(XX / 100) ' We now have the Klingons Value!
' B3 = 0 or 1 Star Base in this Quadrant
XX = XX - (100 * K3) ' Subtract out the Klingons value
B3 = Int(XX / 10) ' We now have the Star Base Value!
' S3 = Number of Stars in this Quadrant
XX = XX - (10 * B3) ' Subtract out the Star Base Value
S3 = XX ' We now have the number of Stars!
' If no Klingons in this Quadrant,
' then we cannot have a Condition RED!
If K3 = 0 Then
GoTo Entry910
End If
' If Shields above 500, then
' Shields aren't Dangerously Low!
If S > 500 Then ' Was: If S > 200 Then
GoTo Entry910
End If
MessageLogWriteLine("")
MessageLogWriteLine("* Combat Area - Condition RED")
MessageLogWriteLine("* Shields are Dangerously low!")
Entry910:
'
' Zero Out Data for Klingon Data in the current Quadrant!
For I = 1 To MaximumKlingonsPerQuadrant ' 9
For J = 1 To 3
KlingonSectorAndShieldsData(I, J) = 0
Next J
Next I
Entry920:
'
' Zero Out Klingon Shield Values!
For I = 1 To MaximumKlingonsPerQuadrant ' 9
KlingonSectorAndShieldsData(I, 3) = 0
Next I
' Clear out the 8 by 8 Sector Array String!
SectorArray = Space(64) 'Zstring
'Rstring = Zstring
'Sstring = Mid(Zstring, 1, 48)
' Pick a Spot for the Enterprise!
InputData = EnterpriseToken
Z1 = Int(S1 + 0.5) ' X location
Z2 = Int(S2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
' Map any Klingons
For I = 1 To K3
GenerateRandomLocationForSelectedInputData()
InputData = KlingonToken ' Klingon
Z1 = Int(R1 + 0.5) ' X location
Z2 = Int(R2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
KlingonSectorAndShieldsData(I, 1) = R1
KlingonSectorAndShieldsData(I, 2) = R2
KlingonSectorAndShieldsData(I, 3) = S9
Next I
' Map a Star Base?
For I = 1 To B3
GenerateRandomLocationForSelectedInputData()
InputData = StarBaseToken ' Star Base
Z1 = Int(R1 + 0.5) ' X location
Z2 = Int(R2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
Next I
' Map any Stars
For I = 1 To S3
GenerateRandomLocationForSelectedInputData()
InputData = StarSpotToken ' Star
Z1 = Int(R1 + 0.5) ' X location
Z2 = Int(R2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
Next I
ShortRangeScanner()
UpdateDamageControlData()
UpdateCurrentQuadrantData()
End Sub
Private Sub CheckForGameOver()
Dim ResultsText As String = ""
Dim Temp1 As String = ""
StarDateExpirationCheck:
If T > T0 + T9 Then
'
' Time has expired!
Temp1 = "* Star Dates have expired! *"
ResultsText = Temp1 + vbCrLf + vbCrLf
MessageLogWriteLine("")
MessageLogWriteLine(Temp1)
GameOverFlag = True
'GoTo ShowCurrentStarDate
End If
' If NO shields, then the Enterprise has been destroyed!
If S < 0 Then
Temp1 = "* The Enterprise has been destroyed. " + _
"This means very hard times for the " + _
"Federation in this Galaxy!"
ResultsText = ResultsText + Temp1 + vbCrLf + vbCrLf
MessageLogWriteLine("")
MessageLogWriteLine(Temp1)
GameOverFlag = True
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"EnterpriseKilled.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
End If
If KlingonsLeft = 0 Then
Temp1 = "* The last Klingon Battle Cruiser in " + _
"this galaxy has been destroyed! " + _
"Congratulations on the excellent job " + _
"defending Federation's Interests in this Galaxy!"
ResultsText = ResultsText + Temp1 + vbCrLf + vbCrLf
MessageLogWriteLine("")
MessageLogWriteLine(Temp1)
GameOverFlag = True
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"EnterpriseWon.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
End If
If GameOverFlag = True Then
' Update this data IF the game is over!
ShortRangeScanner()
UpdateDamageControlData()
UpdateCurrentQuadrantData()
' Calculate the Battle Efficiency!
Temp1 = "*** Your efficiency rating is: "
'
' Prevent Division by 0!
If T - T0 = 0 Then
T = T0 + 1
End If
' Calculate Total Klingons Left multiplied by 100
Dim KlingonFactor As Integer = _
(TotalKlingons - KlingonsLeft) * 100
' Calculate Star Bases left from Starting Value
Dim StarBaseAndEnergyFactor As Double = _
((MaximumStarBases - TotalStarBases) * 50) + _
(E7 / 200)
'' Prevent Division by 0!
If StarBaseAndEnergyFactor = 0 Then
StarBaseAndEnergyFactor = 1
End If
' See Apple-][ Trek for Efficiency Rating Calculation
Dim EfficiencyRating As Double
EfficiencyRating = 2 * _
((KlingonFactor / StarBaseAndEnergyFactor) + _
(KlingonFactor / (((T - T0) * 100) + 1 + T))) - _
(KlingonsLeft) - _
(4 * (MaximumStarBases - TotalStarBases))
'Used to use: ((K7 / (T - T0)) * 1000))
Temp1 = Temp1 + EfficiencyRating.ToString '((TotalKlingons / (T - T0)) * 1000).ToString
ResultsText = ResultsText + Temp1 + vbCrLf + vbCrLf
MessageLogWriteLine("")
MessageLogWriteLine(Temp1)
MessageLogWriteLine("")
Temp1 = "*** End of Game ***"
ResultsText = ResultsText + Temp1 + vbCrLf + vbCrLf
MessageLogWriteLine(Temp1)
ResultsText = ResultsText + _
"Yes = Play another Game, No = Exit Game"
If MessageBox.Show(ResultsText, _
"Star Trek for Windows - Game Over", _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Information) = _
Windows.Forms.DialogResult.No Then
Me.Close()
End
End If
' If Play Again was chosen (YES), then start a NEW Game!
StartNewMission()
Exit Sub
End If
' Game is NOT over, so do the Standard Stuff!
ShortRangeScanner()
UpdateDamageControlData()
UpdateCurrentQuadrantData()
End Sub
'Private Sub PrintBlankLines()
' Dim I As Integer
' ' Do some Blank Lines
' For I = 1 To 11
' MessageLogWriteLine("")
' Next I
' MessageLogWriteLine("")
' ' Return
'End Sub
'Private Sub ShowInstructions()
' ' Instructions
' MessageLogWriteLine("Instructions:")
' MessageLogWriteLine("")
' MessageLogWriteLine("Short Range Scan Legend:")
' MessageLogWriteLine("")
' 'MessageLogWriteLine(EmptySpotToken + " = Empty Spot on Map")
' MessageLogWriteLine(EnterpriseToken + " = ENTERPRISE")
' MessageLogWriteLine(KlingonToken + " = KLINGON")
' MessageLogWriteLine(StarBaseToken + " = STARBASE")
' MessageLogWriteLine(StarSpotToken + " = STAR")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 0 = Warp Engine Control")
' MessageLogWriteLine(" 'Course' is in a circular Numerical 4 3 2")
' MessageLogWriteLine(" Vector arrangement as shown. \ | /")
' MessageLogWriteLine(" Integer and Real Number Values may be \|/")
' MessageLogWriteLine(" used. A course of 1.5 is half way 5-----1")
' MessageLogWriteLine(" between 1 and 2. /|\")
' MessageLogWriteLine(" / | \")
' MessageLogWriteLine(" A vector of 9 is undefined, but 6 7 8")
' MessageLogWriteLine(" values may approach 9.")
' MessageLogWriteLine(" COURSE")
' MessageLogWriteLine(" One 'Warp Factor' is the size of")
' MessageLogWriteLine(" One Quadrant. Therefore to get from Quadrant 6,5 to")
' MessageLogWriteLine(" Qyadrant 5,5 you would use a course of 3 at Warp Factor 1")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 1 = Short Range Sensor Scan")
' MessageLogWriteLine(" Scans the Quadrant you are currently in, including Stars,")
' MessageLogWriteLine(" Klingons, Star Bases, as well as the Enterprise.")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 2 = Long Range Sensor Scan")
' MessageLogWriteLine(" Shows conditions in space for one Quadrant to each side")
' MessageLogWriteLine(" of the Enterprise in the middle of the scan. The scan")
' MessageLogWriteLine(" is shown in the Form XXX, where the units digit is the")
' MessageLogWriteLine(" number of stars, the tens digit is the number of Star")
' MessageLogWriteLine(" Bases, with the hundreds digit as the number of Klingons.")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 3 = Phaser Control")
' MessageLogWriteLine(" Allows you to destroy the Klingons by hitting them with")
' MessageLogWriteLine(" suitably large numbers of energy units to deplete their")
' MessageLogWriteLine(" Shield Power. Keep in mind that when you shoot at them")
' MessageLogWriteLine(" they are going to shoot back at you!")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 4 = Photon Torpedo Control")
' MessageLogWriteLine(" Course is the same as is used for Warp Engine Control.")
' MessageLogWriteLine(" If you destroy a Klingon Battle Cruiser, they will not")
' MessageLogWriteLine(" be able to return fire. However, if you miss, they will")
' MessageLogWriteLine(" shoot back at you with their phasers.")
' MessageLogWriteLine(" * Note * The Library Computer (Command 7) has an option")
' MessageLogWriteLine(" to compute torpedo trajectory for you (Option 2).")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 5 = Shields Control")
' MessageLogWriteLine(" Defines number of energy units to be assigned to shields.")
' MessageLogWriteLine(" Energy is taken from the Enterprise's total Ship Energy.")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 6 = Damage Control Report")
' MessageLogWriteLine(" Gives the state of repairs of all devices. A state of repair")
' MessageLogWriteLine(" of less than zero shows that that device is temporarily")
' MessageLogWriteLine(" Damaged.")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 7 = Library Computer")
' MessageLogWriteLine(" The Library Computer contains 3 options:")
' MessageLogWriteLine(" Option 0 = Cumulative Galactic Record")
' MessageLogWriteLine(" Shows Computer recall of the results of all previous")
' MessageLogWriteLine(" Long Range Sensor Scans")
' MessageLogWriteLine(" Option 1 = Status Report")
' MessageLogWriteLine(" Shows the number of Klingons, Star Dates, And Star Bases")
' MessageLogWriteLine(" left.")
' MessageLogWriteLine(" Option 2 = Photon Torpedo Data")
' MessageLogWriteLine(" Gives Trajectory and Distance between the enterprise and")
' MessageLogWriteLine(" All Klingons in your Quadrant")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 8 = Exit Program")
' MessageLogWriteLine("")
' MessageLogWriteLine("Command 9 = Help")
' '6410: Return
'End Sub
' Insertion in String Array for Sector
' - Passed Values to this routine:
' InputData is the String to be placed in the Sector Array!
' Z1 is the integer value for the X Location
' Z2 is the integer value for the Y Location
Private Sub InsertIntoStringArrayForSector(ByVal InputData)
Dim S8 As Integer
'
' Calculate the offset based on the unrolled array string!
S8 = (Z1 - 1) * 8 + Z2
' Overlay the String Array individual character with the
' data passed to this routine!
Mid(SectorArray, S8, 1) = InputData
End Sub
' Randomly pick 1 spot on the 8 by 8 Short Range Scan for
' one of the following:
'
' - Enterprise
' - Klingons
' - Star Base
' - Stars
Private Sub GenerateRandomLocationForSelectedInputData()
' This logic guarantees that we will use an UNUSED
' Location in the Sector Array for the Current Quadrant!
' - In other words, we won't allow placing a Klingon or
' Star in a Location where the Enterprise or any
' Klingon or any Star is placed already in the Sector
' Array!
RetryRandom:
' Randomly generate a value from 1 to 8
R1 = Int(Rnd(1) * 8 + 1)
' Randomly generate a value from 1 to 8
R2 = Int(Rnd(1) * 8 + 1)
' See if this is a valid spot to place the wanted item!
InputData = EmptySpotToken
Z1 = R1
Z2 = R2
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
'
' If we didn't find an empty spot, then...
' ...try until we get an unused spot!
If Z3 = 0 Then GoTo RetryRandom
End Sub
Private Sub CheckEnterpriseStatus()
Dim I As Integer
If Cstring <> "DOCKED" Then
GoTo EnterpriseNotDocked
End If
MessageLogWriteLine("")
MessageLogWriteLine("Star Base shields protect the Enterprise")
Return
EnterpriseNotDocked:
'
' If No Klingons left in this Quadrant, skip over the
' damage from Klingon Phasers to Enterprise!
If K3 <= 0 Then GoTo CheckEnterpriseExit
For I = 1 To MaximumKlingonsPerQuadrant ' 9
' If Klingon is already dead, then skip it!
If KlingonSectorAndShieldsData(I, 3) <= 0 Then
GoTo CheckEnterpriseNextLoop
End If
' Calculate Damage from each Klingon Ship based on:
'
' Each Klingon Ships Shield Energy...
' divided by the Square Root of ((difference in X
' direction) + (difference in Y direction)) then
' multiply that value by 2 and times a random value
' between 0 that approaches 1!
H = (KlingonSectorAndShieldsData(I, 3) / FND(0)) * _
(2 * Rnd(1))
' Reduce Enterprise Shields by the value of each
' Klingon's Phaser hit value!
S = S - H
'
MessageLogWriteLine("")
MessageLogWriteLine( _
H.ToString() + _
" Unit hit on Enterprise from Sector " + _
KlingonSectorAndShieldsData(I, 1).ToString() + _
", " + _
KlingonSectorAndShieldsData(I, 2).ToString() + _
" (" + S.ToString() + " Left)")
CheckEnterpriseNextLoop:
Next I
CheckEnterpriseExit:
End Sub
Private Sub ShortRangeScanner()
Dim I As Integer
Dim J As Integer
Dim Offset As Integer
' Show the remaining Mission Values!
RemainingMission.Text = _
KlingonsLeft.ToString() + _
" Klingons in " + _
((T0 + T9) - T).ToString() + _
" Star Dates with " + _
TotalStarBases.ToString() + _
" Star Bases"
RemainingDates.Text = ((T0 + T9) - T).ToString()
Condition.ForeColor = Color.Green
' Check to see if we are Docked to StarBase!
' - Look around our ship +1 and -1 in both directions
For I = S1 - 1 To S1 + 1
For J = S2 - 1 To S2 + 1
If I < 1 Or I > 8 Or J < 1 Or J > 8 Then
GoTo SkipOverInvalidValues '4200
End If
InputData = StarBaseToken ' Star Base
Z1 = I
Z2 = J
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2) 'GOSUB 5680
If Z3 = 1 Then GoTo LooksLikeWeAreDocked '4240
SkipOverInvalidValues: '4200:
Next J
Next I
'D0 = 0
GoTo CheckCurrentCondition ' 4310
LooksLikeWeAreDocked: '4240:
'D0 = 1
Cstring = "DOCKED"
Condition.ForeColor = Color.Blue
MessageLogWriteLine("*** Docked with Star Base ***")
E0 = BaseEnergy ' *** Was: 3000
E7 = E0 '- BaseShields ' Was: E0
'E7 = BaseEnergy ' 3000
P = BasePhotons ' 10
'MessageLogWriteLine("")
'MessageLogWriteLine("Shields dropped while docked")
S = BaseShields ' 0
' Auto Repair all devices since we are at a Star Base!
For I = 0 To 9 '1 To 8
DeviceArrayForDamageTime(I) = 0
Next I
UpdateDamageControlData()
GoTo CheckShortRangeSensors '4380
CheckCurrentCondition: '4310:
If K3 > 0 Then GoTo ConditionRED '4350
' If Current Energy Level is less than 10%, then
' Show Condition as Yellow!
If E7 < E0 * 0.1 Then GoTo ConditionYellow '4370
' Situation Normal... No Enemies and energy above 10%
Cstring = "Green"
Condition.ForeColor = Color.Green
GoTo CheckShortRangeSensors
' We have Klingons in the current quadrant!
ConditionRED: '4350:
Cstring = "Red"
Condition.ForeColor = Color.Red
'' Only if Quadrant changed do we want to do Red Alert Sound!
'If (Q1 <> LastQ1) Or _
' (Q2 <> LastQ2) Then
'
RedAlertSoundCheck()
'
'End If
GoTo CheckShortRangeSensors
' Low Energy Level (Below 10%)
ConditionYellow:
Cstring = "Yellow"
Condition.ForeColor = Color.Yellow
CheckShortRangeSensors:
' Map the "Current Condition" section!
Condition.Text = Cstring
StarDate.Text = T.ToString()
Quadrant.Text = Q1.ToString() + "," + Q2.ToString()
Sector.Text = S1.ToString() + "," + S2.ToString()
Energy.Text = (E7 - S).ToString
PhotonTorpedoes.Text = P.ToString()
Shields.Text = S.ToString()
KlingonsCount.Text = K3.ToString()
Dim CharsPerLine As Integer = 32
Dim MaxLines As Integer = 8
Dim ShortRangeData As String = _
Space(CharsPerLine * MaxLines)
' If ShortRange Sensors are good, then show the whole Array!
' - Otherwise...
If DeviceArrayForDamageTime(2) >= 0 Then
GoTo ShowShortRangeSensors
End If
'
' Added logic to show up to 3 by 3 if short range sensors
' are out ... This allows us to at least see ourself and
' up to 1 navigational box in each direction around the
' Enterprise... This is how the Old Apple-][ Trek showed
' up to -1 to +1 around our ship in the X and Y directions
' when Short Range Sensors are damaged!
'
' Unroll the data into ONE string, then map each item!
' - Look around our ship -1 and +1 in both directions
For I = S1 - 1 To S1 + 1
For J = S2 - 1 To S2 + 1
If I < 1 Or I > 8 Or J < 1 Or J > 8 Then
GoTo SkipOverInvalidValues2
End If
' - If I=1 and J=1 then Offset is equal to 1
' - If I=3 and J=2 then Offset is equal to 18
' - If I=8 and J=8 then Offset is equal to 64
Offset = ((I - 1) * 8) + J
' Overlay the proper character with our Sector Map Item!
' - if Offset = 1, then overlay Character 3!
' - if Offset = 18, then overlay Character 71!
' - if Offset = 64, then overlay Character 255!
Mid(ShortRangeData, ((Offset * 4) - 1), 1) = _
Mid(SectorArray, Offset, 1)
SkipOverInvalidValues2:
Next J
Next I
'MessageLogWriteLine("*** Short range sensors are out! ***")
GoTo StatusCheckIsDone
' Show ALL Sectors in the current Quadrant!
ShowShortRangeSensors:
'
' Simplified Mapping method:
'
' Roll the data into ONE string, then map each item!
For I = 1 To 8
For J = 1 To 8
' - If I=1 and J=1 then Offset is equal to 1
' - If I=3 and J=2 then Offset is equal to 18
' - If I=8 and J=8 then Offset is equal to 64
Offset = ((I - 1) * 8) + J
' Overlay the proper character with our Sector Map Item!
' - if Offset = 1, then overlay Character 3!
' - if Offset = 18, then overlay Character 71!
' - if Offset = 64, then overlay Character 255!
Mid(ShortRangeData, ((Offset * 4) - 1), 1) = _
Mid(SectorArray, Offset, 1)
Next
Next
StatusCheckIsDone:
' Take ShortRangeData String the chop up the data then
' map it to the Short Range Sensors display lines!
SRSS1.Text = Mid(ShortRangeData, 1, 32)
SRSS2.Text = Mid(ShortRangeData, 33, 32)
SRSS3.Text = Mid(ShortRangeData, 65, 32)
SRSS4.Text = Mid(ShortRangeData, 97, 32)
SRSS5.Text = Mid(ShortRangeData, 129, 32)
SRSS6.Text = Mid(ShortRangeData, 161, 32)
SRSS7.Text = Mid(ShortRangeData, 193, 32)
SRSS8.Text = Mid(ShortRangeData, 225, 32)
'' If Enterprise is Moving, then...
'' ... DO NOT Save Current Quadrant Data!
'If EnterpriseIsMoving = True Then
' Exit Sub
'End If
'' Save the Current Quadrant Data!
'LastQ1 = Q1
'LastQ2 = Q2
End Sub
'' Prints Device Name from Array!
'Private Sub PrintDeviceNameFromArray(ByVal R1)
' Dim S8 As Integer
' S8 = (R1 * 20) - 19
' MessageLogWriteLine(Mid(Dstring, S8, 20))
' 'Return
'End Sub
Private Sub RedAlertSoundCheck()
'' If Enterprise is Moving, DO NOT Check for Red Alert!
'If EnterpriseIsMoving = True Then
' Exit Sub
'End If
' Don't Allow Quadrant to go OUTSIDE of range of 1 to 8!
If Q1 < 1 Then Q1 = Q1 + 8
If Q1 > 8 Then Q1 = Q1 - 8
If Q2 < 1 Then Q2 = Q2 + 8
If Q2 > 8 Then Q2 = Q2 - 8
' If we have already attempted to do Red Alert for this
' sector, then exit!
If (Q1 = LastQ1) And _
(Q2 = LastQ2) Then
Exit Sub
End If
' Save the Last Quadrant that we attempted to do
' the Red Alert Sound Effect in!
LastQ1 = Q1
LastQ2 = Q2
'--- October 30, 2008:
' Added to prevent spurious Red Alert Sound Effect!
'
' KX = Number of Klingons in this Quadrant
Dim XX As Integer
XX = GalaxyKlingonStarBaseAndStarsData(Q1, Q2)
Dim KX = Int(XX / 100)
' If No Klingons here, then exit! (Condition NOT "Red"!)
If KX = 0 Then
Exit Sub
End If
'---
'' Check to see if we are under RED Alert!
'If Cstring <> "Red" Then
' Exit Sub
'End If
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
'' Save the Last Quadrant that we did the Red Alert
'' Sound Effect in!
'LastQ1 = Q1
'LastQ2 = Q2
' Make Red Alert Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"RedAlert.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
End Sub
' String Comparison in Quadrant Array
Private Sub StringComparisonInSectorArray( _
ByVal InputData As String)
'Private Sub StringComparisonInSectorArray( _
' ByVal InputData As String, _
' ByVal Z1 As Integer, _
' ByVal Z2 As Integer)
Dim S8 As Integer
' Z1 = Int(Z1 + 0.5)
' Z2 = Int(Z2 + 0.5)
' Prevent the 2 values from being outside of the proper
' range of 1 to 8!
If Z1 < 1 Then
Z1 = Z1 + 8
End If
If Z1 > 8 Then
Z1 = Z1 - 8
End If
If Z2 < 1 Then
Z2 = Z2 + 8
End If
If Z2 > 8 Then
Z2 = Z2 - 8
End If
' Calculate the current offset based on the unrolled data!
S8 = ((Z1 - 1) * 8) + Z2
Z3 = 0
' If the Value in the current Sector doesn't match, then
' Z3 will be set to 0!
If Mid(SectorArray, S8, 1) <> InputData Then
GoTo CommonExit
End If
' Otherwise we had a match... so set Z3 to 1!
Z3 = 1
CommonExit:
End Sub
Private Sub KlingonDestroyed(ByVal I)
MessageLogWriteLine("*** Klingon at Sector " + _
KlingonSectorAndShieldsData(I, 1).ToString + _
", " + _
KlingonSectorAndShieldsData(I, 2).ToString() + _
" Destroyed! ***")
K3 = K3 - 1
KlingonsLeft = KlingonsLeft - 1
InputData = EmptySpotToken
Z1 = KlingonSectorAndShieldsData(I, 1) ' X location
Z2 = KlingonSectorAndShieldsData(I, 2) ' Y location
InsertIntoStringArrayForSector(InputData) 'GOSUB 5510
GalaxyKlingonStarBaseAndStarsData(Q1, Q2) = _
K3 * 100 + B3 * 10 + S3
UpdateCurrentQuadrantData()
'Return
End Sub
Function FND(ByVal D)
' Find the square root of:
' (difference in X direction) squared +
' (difference in Y direction) squared
Return Sqrt((KlingonSectorAndShieldsData(I, 1) - S1) ^ 2 + _
(KlingonSectorAndShieldsData(I, 2) - S2) ^ 2)
End Function
Private Sub btnWarpSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWarpSelected.Click
' Show TabControl and then go to the Warp Tab
EnableTabControl(0)
End Sub
Private Sub btnPhotonSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPhotonSelected.Click
If Not (DeviceArrayForDamageTime(5) >= 0) Then
MessageLogWriteLine("")
MessageLogWriteLine("Photon Torpedo Tubes are not operational")
Return
End If
If P = 0 Then
MessageLogWriteLine("")
MessageLogWriteLine("All Photon Torpedoes have been expended / used")
Return
End If
' Show TabControl and then go to the Photon Torpedo Tab
EnableTabControl(1)
End Sub
Private Sub btnPhasersSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPhasersSelected.Click
If Not (DeviceArrayForDamageTime(4) >= 0) Then
MessageLogWriteLine("")
MessageLogWriteLine("Phaser Control is Disabled")
Return
End If
' No Klingons here!
If K3 <= 0 Then
MessageLogWriteLine("")
MessageLogWriteLine("Short Range Sensors Report No Klingons in this Quadrant")
Return
End If
' Show TabControl and then go to the Phasers Tab
EnableTabControl(2)
End Sub
' Long Range Sensor Scan
Private Sub btnLongRangeScanSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLongRangeScanSelected.Click
Dim I As Integer
Dim J As Integer
'' Combine ALL Long Range Data before updating it!
'Dim LongRangeData As String = _
' LRSS1.Text + _
' LRSS2.Text + _
' LRSS3.Text + _
' LRSS4.Text + _
' LRSS5.Text + _
' LRSS6.Text + _
' LRSS7.Text + _
' LRSS8.Text
Dim Offset As Integer = 0
Dim Temp1 As String = ""
LongRangeSensors:
If DeviceArrayForDamageTime(3) >= 0 Then
GoTo LongRangeSensorsScan
End If
' The Long Range Sensors are down...
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"LongRangeSensorsDamaged.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
' Update the current Quadrant anyway!
Offset = ((Q1 - 1) * 8) + Q2
' - October 30, 2008:
' Now uses Leading Spaces in the Long Range Scan
' to make it a lot easier to tell where the Klingons
' in the areas that have had Long Range Scans done
' in them!
Temp1 = Microsoft.VisualBasic.Right(Space(3) & _
GalaxyKlingonStarBaseAndStarsData(Q1, Q2).ToString, 3)
Mid(LongRangeData, ((Offset * 6) - 3)) = Temp1
'Temp1 = (1000 + GalaxyKlingonStarBaseAndStarsData(Q1, Q2)).ToString
'Mid(LongRangeData, ((Offset * 6) - 3)) = Mid(Temp1, 2)
MessageLogWriteLine("")
MessageLogWriteLine("Long Range Sensors are inoperable due to damage")
GoTo CommonExit
'' 1 2 3 4
'' ....5....0....5....0....5....0.....5....0....5...
'' | xxx | xxx | xxx | xxx | xxx | xxx | xxx | xxx |
'' Long Range Sensor Scan
'LRSS1.Text = Space(48)
'LRSS2.Text = Space(48)
'LRSS3.Text = Space(48)
'LRSS4.Text = Space(48)
'LRSS5.Text = Space(48)
'LRSS6.Text = Space(48)
'LRSS7.Text = Space(48)
'LRSS8.Text = Space(48)
LongRangeSensorsScan: '2370:
'MessageLogWriteLine("Long Range Sensor Scan for Quadrant " + _
' Q1.ToString + ", " + Q2.ToString
' MessageLogWriteLine("-----------------")
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Long Range Sensors Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"LongRangeScanners.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
Dim I2 As Integer = 0
Dim J2 As Integer = 0
For I = Q1 - 1 To Q1 + 1 ' Tested with "1 to 8"
I2 = I
If I2 < 1 Then I2 = I2 + 8
If I2 > 8 Then I2 = I2 - 8
For J = Q2 - 1 To Q2 + 1 ' Tested with "1 to 8"
J2 = J
If J2 < 1 Then J2 = J2 + 8
If J2 > 8 Then J2 = J2 - 8
'If I < 1 Or I > 8 Or J < 1 Or J > 8 Then
' GoTo SkipIllegalRangesforLongRangeScan '2460
'End If
' - October 30, 2008:
' Now uses Leading Spaces in the Long Range Scan
' to make it a lot easier to tell where the Klingons
' in the areas that have had Long Range Scans done
' in them!
Offset = ((I2 - 1) * 8) + J2
Temp1 = Microsoft.VisualBasic.Right(Space(3) & _
GalaxyKlingonStarBaseAndStarsData(I2, J2).ToString, 3)
Mid(LongRangeData, ((Offset * 6) - 3)) = Temp1
'Temp1 = (1000 + GalaxyKlingonStarBaseAndStarsData(I2, J2)).ToString
'Mid(LongRangeData, ((Offset * 6) - 3)) = Mid(Temp1, 2)
'' Save to Total Computer Scan Data!
'Z(I2, J2) = GalaxyKlingonStarBaseAndStarsData(I2, J2)
SkipIllegalRangesforLongRangeScan:
Next J
Next I
CommonExit:
' Take LongRangeData String the chop up the data then
' map it to the Long Range Sensors display lines!
LRSS1.Text = Mid(LongRangeData, 1, 48)
LRSS2.Text = Mid(LongRangeData, 49, 48)
LRSS3.Text = Mid(LongRangeData, 97, 48)
LRSS4.Text = Mid(LongRangeData, 145, 48)
LRSS5.Text = Mid(LongRangeData, 193, 48)
LRSS6.Text = Mid(LongRangeData, 241, 48)
LRSS7.Text = Mid(LongRangeData, 289, 48)
LRSS8.Text = Mid(LongRangeData, 337, 48)
'GoTo WaitForNextCommand '1270
End Sub
Private Sub UpdateCurrentQuadrantData()
'' Combine ALL Long Range Data before updating it!
'Dim LongRangeData As String = _
' LRSS1.Text + _
' LRSS2.Text + _
' LRSS3.Text + _
' LRSS4.Text + _
' LRSS5.Text + _
' LRSS6.Text + _
' LRSS7.Text + _
' LRSS8.Text
Dim Offset As Integer = 0
Dim Temp1 As String = ""
' Don't Allow Quadrant to go OUTSIDE of range of 1 to 8!
If Q1 < 1 Then Q1 = Q1 + 8
If Q1 > 8 Then Q1 = Q1 - 8
If Q2 < 1 Then Q2 = Q2 + 8
If Q2 > 8 Then Q2 = Q2 - 8
Dim I As Integer
Dim J As Integer
' Mark Current Quadrant in the Long Range Scan
' ">" indicates the Quadrant that contains the Enterprise!
' - Unmark all but the Current Quadrant
' - ONLY 1 of 64 Quadrants match the current Quadrant!
For I = 1 To 8
For J = 1 To 8
Offset = ((I - 1) * 8) + J
'
' Assume that the quadrant we are looking at
' is not the one we are looking for yet.
Temp1 = " "
'
' If we are on the current Quadrant
If (I = Q1) And (J = Q2) Then
Temp1 = ">"
End If
Mid(LongRangeData, ((Offset * 6) - 4)) = Temp1
Next
Next
' Update the current Quadrant even if the Long Range
' sensors are down since we can see the data anyway!
'
' 100's digit marks Klingons
' 10's digit marks up to 1 Star Base
' 1's digit indicate the number of Stars
'
' - Example Values:
' 317 means 3 Klingons, 1 Star Base, and 7 Stars
' 013 means No Klingons, 1 Star Base, and 3 Stars
' 102 means 1 Klingon, No Star Base, and 2 Stars
Offset = ((Q1 - 1) * 8) + Q2
' - October 30, 2008:
' Now uses Leading Spaces in the Long Range Scan
' to make it a lot easier to tell where the Klingons
' in the areas that have had Long Range Scans done
' in them!
Temp1 = Microsoft.VisualBasic.Right(Space(3) & _
GalaxyKlingonStarBaseAndStarsData(Q1, Q2).ToString, 3)
Mid(LongRangeData, ((Offset * 6) - 3)) = Temp1
'Temp1 = (1000 + GalaxyKlingonStarBaseAndStarsData(Q1, Q2)).ToString
'Mid(LongRangeData, ((Offset * 6) - 3)) = Mid(Temp1, 2)
' Take LongRangeData String the chop up the data then
' map it to the Long Range Sensors display lines!
LRSS1.Text = Mid(LongRangeData, 1, 48)
LRSS2.Text = Mid(LongRangeData, 49, 48)
LRSS3.Text = Mid(LongRangeData, 97, 48)
LRSS4.Text = Mid(LongRangeData, 145, 48)
LRSS5.Text = Mid(LongRangeData, 193, 48)
LRSS6.Text = Mid(LongRangeData, 241, 48)
LRSS7.Text = Mid(LongRangeData, 289, 48)
LRSS8.Text = Mid(LongRangeData, 337, 48)
End Sub
' Calculate Photon Torpedo Data
Private Sub btnComputeEnemyInformation_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnComputeEnemyInformation.Click
' If No Klingons, then nothing to do!
If K3 = 0 Then
MessageLogWriteLine("")
MessageLogWriteLine("* No Enemies *")
GoTo EndCalculationLoop
End If
' If Computer is Damaged, then change the effective fire
' amount by a random factor!
If DeviceArrayForDamageTime(8) >= 0 Then
GoTo RestartTorpedoCalculator
End If
' Computer is damaged...
' ... Play the Unable to Comply Sound?
CheckOnTheUnableToComplySound()
MessageLogWriteLine("")
MessageLogWriteLine("Computer is down! Cannot Calculate Enemy Data!")
GoTo EndCalculationLoop
'PhotonTorpedoCalculator:
' MessageLogWriteLine("")
Dim I As Integer
RestartTorpedoCalculator:
H8 = 0
' Look for up to 9 Klingons in the current Quadrant
For I = 1 To MaximumKlingonsPerQuadrant ' 9
If KlingonSectorAndShieldsData(I, 3) <= 0 Then
GoTo SkipPhotonCalculation
End If
C1 = S1
A = S2
W1 = KlingonSectorAndShieldsData(I, 1)
X = KlingonSectorAndShieldsData(I, 2)
'GoTo CommonPhotonCalculationLogic
'C1 = S1
'A = S2
CommonPhotonCalculationLogic:
X = X - A
A = C1 - W1
If X < 0 Then
GoTo Entry5130
End If
If A < 0 Then
GoTo Entry5190
End If
If X > 0 Then
GoTo Entry5070
End If
If A = 0 Then
GoTo Entry5150
End If
Entry5070:
C1 = 1 ' Direction 1
Entry5080:
If Math.Abs(A) <= Math.Abs(X) Then
GoTo Entry5110
End If
MessageLogWriteLine("")
MessageLogWriteLine("Direction = " + _
(C1 + _
(((Math.Abs(A) - Math.Abs(X)) + Math.Abs(A)) / _
Math.Abs(A))).ToString())
GoTo Entry5240
Entry5110:
MessageLogWriteLine("")
MessageLogWriteLine("Direction = " + _
(C1 + (Math.Abs(A) / Math.Abs(X))).ToString())
GoTo Entry5240
Entry5130:
If A > 0 Then
GoTo Entry5170
End If
If X = 0 Then
GoTo Entry5190
End If
Entry5150:
C1 = 5 ' Direction 5
GoTo Entry5080
Entry5170:
C1 = 3 ' Direction 3
GoTo Entry5200
Entry5190:
C1 = 7 ' Direction 7
Entry5200:
If Math.Abs(A) >= Math.Abs(X) Then
GoTo Entry5230
End If
MessageLogWriteLine("")
MessageLogWriteLine("Direction = " + _
(C1 + _
(((Math.Abs(X) - Math.Abs(A)) + Math.Abs(X)) / _
Math.Abs(X))).ToString())
GoTo Entry5240
Entry5230:
MessageLogWriteLine("")
MessageLogWriteLine("Direction = " + _
(C1 + (Math.Abs(X) / Math.Abs(A))).ToString())
Entry5240:
MessageLogWriteLine("Distance = " + _
(Sqrt(X ^ 2 + A ^ 2)).ToString())
If H8 = 1 Then
GoTo EndCalculationLoop
End If
SkipPhotonCalculation:
Next I
H8 = 0
EndCalculationLoop:
End Sub
Private Sub btnShieldControlSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnShieldControlSelected.Click
If Not (DeviceArrayForDamageTime(7) >= 0) Then
MessageLogWriteLine("")
MessageLogWriteLine("Shield Control is Non-operational")
Return
End If
' Show TabControl and then go to the Sheilds Control Tab
EnableTabControl(3)
End Sub
Private Sub btnDamageControlSelected_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDamageControlSelected.Click
'zzzzz()
End Sub
Private Sub btnCancelShields_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelShields.Click
DisableTabControl()
End Sub
' Shield Control
Private Sub btnEnergyToShields_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnergyToShields.Click
DisableTabControl()
If DeviceArrayForDamageTime(7) >= 0 Then
GoTo SetShieldsValue
End If
' Shield Control is Damaged...
' ... Play the Unable to Comply Sound?
CheckOnTheUnableToComplySound()
MessageLogWriteLine("")
MessageLogWriteLine("Shield Control is Non-operational")
GoTo CommonExit
SetShieldsValue:
' MessageLogWrite("Energy Available = " + _
' (e + S).ToString() + _
' " number of units to shields: ")
' InputData = ErrorConsoleReadLine()
InputData = Val(EnergyToShields.Text)
X = Val(InputData) 'Input(X)
'MessageLogWriteLine("")
If X <= 0 Then GoTo CommonExit 'WaitForNextCommand '1270
If E7 + S - X < 0 Then GoTo CommonExit 'SetShieldsValue '3490
'E7 = E7 + S - X
S = X
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Shields Transfer Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"ShieldControl.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
CommonExit: 'GoTo WaitForNextCommand '1270
CheckForGameOver()
End Sub
Private Sub btnCancelPhaserControl_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelPhaserControl.Click
DisableTabControl()
End Sub
Private Sub btnFirePhasers_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFirePhasers.Click
DisableTabControl()
Dim I As Integer
FirePhasers:
If K3 <= 0 Then GoTo CommonExit 'ShortRangeSensorsReportNoKlingons '3670
If DeviceArrayForDamageTime(4) >= 0 Then
GoTo PreparePhasers
End If
' Phasers are down...
' ... Play the Unable to Comply Sound?
CheckOnTheUnableToComplySound()
MessageLogWriteLine("")
MessageLogWriteLine("Phaser Control is Disabled")
GoTo CommonExit
PreparePhasers:
' Is the Computer Damaged?
If DeviceArrayForDamageTime(8) >= 0 Then
GoTo EnterPhaserAmount
End If
MessageLogWriteLine("")
MessageLogWriteLine("Computer damage hampers Phaser accuracy")
EnterPhaserAmount:
InputData = Val(PhaserUnits.Text)
'MessageLogWriteLine("Phasers locked on target. Energy available = " + e.ToString)
'MessageLogWrite("Number of units to fire: ")
'InputData = ErrorConsoleReadLine()
X = Val(InputData)
'Input(X)
If X <= 0 Then GoTo CommonExit
If E7 - X < 0 Then GoTo PreparePhasers
E7 = E7 - X
CheckEnterpriseStatus()
If S < 0 Then
GoTo CommonExit
End If
'
' If Computer is Damaged, then change the effective
' fire amount by a random factor!
If DeviceArrayForDamageTime(8) >= 0 Then
GoTo Entry2680
End If
' Change the Effective fire amount
X = X * Rnd(1)
Entry2680:
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Phasers Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"Phasers.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
For I = 1 To MaximumKlingonsPerQuadrant ' 9
'
' If Klingon is already dead, ignore that data!
If KlingonSectorAndShieldsData(I, 3) <= 0 Then
GoTo Entry2770
End If
' Calculate Damage to each Klingon Ship based on:
'
' X which is the Energy to fire at them...
' divided K3 (number of Klingons left in this Quadrant)
' then divided by the Square Root of ((difference in X
' direction) + (difference in Y direction)) then
' multiply that value by 2 and times a random value
' between 0 that approaches 1!
H = ((X / K3) / FND(0)) * (2 * Rnd(1))
KlingonSectorAndShieldsData(I, 3) = KlingonSectorAndShieldsData(I, 3) - H
MessageLogWriteLine( _
H.ToString + _
" Unit hit on Klingon at Sector " + _
KlingonSectorAndShieldsData(I, 1).ToString() + ", " + _
KlingonSectorAndShieldsData(I, 2).ToString() + " " + _
" (" + KlingonSectorAndShieldsData(I, 3).ToString + " left)")
' If Klingon has at least 1 energy of shields left,
' then it survived your Phaser attack.
If KlingonSectorAndShieldsData(I, 3) > 0 Then
GoTo Entry2770 '2770
End If
'
' If Klingon has 0 or less on shield energy then it
' was killed / destroyed!
KlingonDestroyed(I) ' GOSUB 3690
' Any more Klingons to defeat?
If KlingonsLeft <= 0 Then
GoTo CommonExit 'BattleIsWon '4040
End If
Entry2770: '2770:
Next I
'If E7 < 0 Then GoTo EnterpriseDestroyed '4000
CommonExit: ' GoTo WaitForNextCommand '1270
CheckForGameOver()
End Sub
Private Sub btnCancelPhotonTorpedo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelPhotonTorpedo.Click
DisableTabControl()
End Sub
' Fire ONE Photon Torpedo
Private Sub btnFirePhotonTorpedo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFirePhotonTorpedo.Click
DisableTabControl()
Dim I As Integer
'FirePhotonTorpedoes:
If DeviceArrayForDamageTime(5) >= 0 Then
GoTo PhotonTorpedoesCheck
End If
' Photon Torpedo Tubes are down...
' ... Play the Unable to Comply Sound?
CheckOnTheUnableToComplySound()
MessageLogWriteLine("")
MessageLogWriteLine("Photon Torpedo Tubes are not operational!")
GoTo CommonExit
PhotonTorpedoesCheck:
' If we have at least 1 Photon Torpedo, fire it!
If P > 0 Then
GoTo PhotonTorpedoesCourseSelection
End If
MessageLogWriteLine("")
MessageLogWriteLine("All Photon Torpedoes have been used!")
GoTo CommonExit
PhotonTorpedoesCourseSelection:
'MessageLogWrite("Torpedo Course (1-9):")
'2870: InputData = ErrorConsoleReadLine()
InputData = Val(PhotonCourse.Text)
C1 = Val(InputData)
If C1 = 0 Then
'MessageLogWriteLine("")
GoTo CommonExit
End If
If C1 < 1 Or C1 >= 9 Then
'MessageLogWriteLine("")
GoTo CommonExit
End If
'MessageLogWriteLine("")
C2 = Int(C1)
X1 = C(C2, 1) + (C(C2 + 1, 1) - C(C2, 1)) * (C1 - C2)
X2 = C(C2, 2) + (C(C2 + 1, 2) - C(C2, 2)) * (C1 - C2)
X = S1
Y = S2
P = P - 1 ' Use 1 Photon Torpedo
' Start Tracking the Photon Torpedo!
MessageLogWriteLine("")
MessageLogWriteLine("Photon Torpedo Track:")
MessageLogWrite(" ")
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Photon Torpedo Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"PhotonTorpedo.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
NextTorpedoTrackingLoop:
X = X + X1
Y = Y + X2
' If X or Y value goes outside of current Quadrant...
' ... then Photon Torpedo has missed!
If X < 0.5 Or X >= 8.5 Or Y < 0.5 Or Y >= 8.5 Then
GoTo TorpedoMissed
End If
' Show the NEXT spot where the Photon Torpedo is tracking...
MessageLogWrite(" (" + Int(X + 0.5).ToString() + _
"," + Int(Y + 0.5).ToString() + ")")
'
' If the spot where the Photon Torpedo just went is an
' empty spot, increment the X and/or Y value and loop
' again!
InputData = EmptySpotToken
Z1 = Int(X + 0.5)
Z2 = Int(Y + 0.5)
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
'
' If we didn't match a Space in the next X / Y location
' then check to see if we hit a Klingon!
If Z3 = 0 Then
GoTo CheckForKlingonHit
End If
GoTo NextTorpedoTrackingLoop
CheckForKlingonHit:
InputData = KlingonToken ' Klingon
Z1 = Int(X + 0.5)
Z2 = Int(Y + 0.5)
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
' If Next Spot wasn't a Klingon, then Check to see if
' we hit a Star!
If Z3 = 0 Then
GoTo TorpedoHitStarCheck
End If
MessageLogWriteLine("")
MessageLogWriteLine(" *** Klingon Destroyed! ***")
K3 = K3 - 1
KlingonsLeft = KlingonsLeft - 1
UpdateCurrentQuadrantData()
' Any More Klingons to defeat?
If KlingonsLeft <= 0 Then
GoTo CommonExit 'BattleIsWon
End If
' Checks up to 9 Klingons in the Current Quadrant
For I = 1 To MaximumKlingonsPerQuadrant ' 9
If Int(X + 0.5) <> KlingonSectorAndShieldsData(I, 1) Then GoTo Entry3190 '3190
If Int(Y + 0.5) = KlingonSectorAndShieldsData(I, 2) Then GoTo Entry3200 '3200
Entry3190:
Next I
Entry3200:
KlingonSectorAndShieldsData(I, 3) = 0
GoTo ReplaceDestroyedObjectWithASpace
TorpedoHitStarCheck:
InputData = StarSpotToken
Z1 = Int(X + 0.5)
Z2 = Int(Y + 0.5)
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
' If Next Spot wasn't a Star, then Check to see if
' we hit a Star Base!
If Z3 = 0 Then
GoTo CheckForStarbaseHit
End If
MessageLogWriteLine("")
'MessageLogWriteLine(" You are not allowed to destroy stars!")
'GoTo TorpedoMissed '3420
MessageLogWriteLine("*** Star Destroyed ***")
S3 = S3 - 1
GoTo ReplaceDestroyedObjectWithASpace
CheckForStarbaseHit:
InputData = StarBaseToken ' Star Base
Z1 = Int(X + 0.5)
Z2 = Int(Y + 0.5)
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
' If Next Spot wasn't a Star Base, then
' go to the Next Torpedo Tracking Loop!
If Z3 = 0 Then
GoTo NextTorpedoTrackingLoop
End If
' We hit a Star Base with a Photon Torpedo!
MessageLogWriteLine("")
MessageLogWriteLine("*** Star Base Destroyed ***")
B3 = B3 - 1
' We hit something, so blank out that spot in the
' current Sector Map and update the Galaxy Data!
ReplaceDestroyedObjectWithASpace:
InputData = EmptySpotToken
Z1 = Int(X + 0.5) ' X location
Z2 = Int(Y + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
GalaxyKlingonStarBaseAndStarsData(Q1, Q2) = _
K3 * 100 + B3 * 10 + S3
GoTo PrepareToReturnToNextCommand
TorpedoMissed:
MessageLogWriteLine("")
MessageLogWriteLine("* Photon Torpedo Missed! *")
PrepareToReturnToNextCommand:
'CheckEnterpriseStatus() 'GOSUB 3790
'If S < 0 Then
' GoTo CommonExit 'EnterpriseDestroyed '4000
'End If
'If E7 < 0 Then
' GoTo CommonExit 'EnterpriseDestroyed '4000
'End If
CommonExit:
CheckForGameOver()
End Sub
Private Sub btnCancelNavigation_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelNavigation.Click
DisableTabControl()
End Sub
Private Sub btnEngageWarp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEngageWarp.Click
Dim Q1Save As Integer = Q1
Dim Q2Save As Integer = Q2
DisableTabControl()
Dim I As Integer
InputData = Val(WarpCourse.Text)
If Val(InputData) < 1 Or Val(InputData) >= 9 Then
MessageLogWriteLine("")
MessageLogWriteLine("Invalid Course of " + InputData)
GoTo CommonExit
End If
C1 = Val(InputData)
InputData = Val(WarpFactor.Text)
W1 = Val(InputData)
If W1 < 0 Or W1 > 8 Then
MessageLogWriteLine("")
MessageLogWriteLine("Invalid Warp Factor of " + InputData)
GoTo CommonExit
End If
If DeviceArrayForDamageTime(1) >= 0 Or W1 <= 0.25 Then
GoTo NormalWarpEngines
End If
MessageLogWriteLine("")
MessageLogWriteLine("* Warp Engines are Damaged, Maximum Speed = Warp .25")
GoTo CommonExit
NormalWarpEngines:
If K3 <= 0 Then GoTo Entry1560
CheckEnterpriseStatus()
If K3 <= 0 Then GoTo Entry1560
If S < 0 Then
GoTo CommonExit
End If
GoTo CheckDamage
Entry1560:
'If E7 > 0 Then GoTo CheckDamage
''If S > 500 Then GoTo CheckDamage
'MessageLogWriteLine("")
'MessageLogWriteLine("You have " + E7.ToString() + _
' " units of energy")
'MessageLogWriteLine("Suggest that you get some from " + _
' "your shields which have " + _
' S.ToString() + " units left")
'GoTo CommonExit
' Check for Damage
CheckDamage:
'' Only allow random damage if shields are under
'' MinimumShieldsToCalcDamage Value!
'If S >= MinimumShieldsToCalcDamage Then
' GoTo MapData
'End If
'---
' Enterprise Devices:
'
' 1 = Warp Engines
' 2 = Short Range Scanners
' 3 = Long Range Scanners
' 4 = Phaser Control
' 5 = Photon Torpedo Tubes
' 6 = Damage Control
' 7 = Shield Control
' 8 = Computer
'---
' 1 Star Date has now passed, Check devices for Damage...
' ... If device was damaged and +1 Star Date fixed it,
' then make sure the value doesn't exceed 0!
' - Negative Device Values = Damage Device for that many
' Star Dates!
For I = 1 To 8
'
' If Device is undamaged, then don't allow value over 0!
If DeviceArrayForDamageTime(I) > 0 Then
DeviceArrayForDamageTime(I) = 0
GoTo SkipDamageCheck
End If
' Add 1 Star Date to Damage Time Left!
' - Damaged Devices have a negative Value!
DeviceArrayForDamageTime(I) = _
DeviceArrayForDamageTime(I) + 1
' If Device is now undamaged, then ...
' ... don't allow value to go over 0!
If DeviceArrayForDamageTime(I) > 0 Then
DeviceArrayForDamageTime(I) = 0
End If
SkipDamageCheck:
Next I
'
' If no random damage, goto MapData!
If Rnd(1) > 0.2 Then GoTo MapData
'
' Randomly Damage something
' RandomDevice = The Device Number
Dim RandomDevice As Integer = Int(Rnd(1) * 8 + 1)
' If Generated Value is greater than or equal to 1/2
' then lessen ANY damage to that device!
If Rnd(1) >= 0.5 Then
GoTo DamageLessened
End If
' Damage the Random Device!
DeviceArrayForDamageTime(RandomDevice) = _
DeviceArrayForDamageTime(RandomDevice) - _
(Rnd(1) * 5 + 1)
'1690: MessageLogWriteLine("")
'1700: MessageLogWriteLine("Damage Control Report: ")
'1710: PrintDeviceNameFromArray(R1)
'1720: MessageLogWriteLine(" * Damaged *")
'1730: MessageLogWriteLine("")
GoTo MapData
DamageLessened:
'
' If device isn't damaged, then no need to undamage it!
If DeviceArrayForDamageTime(RandomDevice) >= 0 Then
GoTo MapData
End If
' Randomly undamage the selected Device by a new random
' amount!
DeviceArrayForDamageTime(RandomDevice) = _
DeviceArrayForDamageTime(RandomDevice) + _
(Rnd(1) * 5 + 1)
' If the New Device Damage is greater than or equal to 0...
' then set it to undamaged!
If DeviceArrayForDamageTime(RandomDevice) >= 0 Then
DeviceArrayForDamageTime(RandomDevice) = 0
MessageLogWriteLine("")
MessageLogWriteLine("Spock used a new repair technique!")
'If RandomDevice = 3 Then
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"SensorsFixed.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
'Else
'End If
End If
'1760: MessageLogWriteLine("")
'1770: MessageLogWriteLine("Damage Control Report: ")
'1780: PrintDeviceNameFromArray(R1) 'GOSUB 5610
'1790: MessageLogWriteLine(" State of repair improved")
'1800: MessageLogWriteLine("")
MapData:
'' Set Enterprise is on the Move!
'EnterpriseIsMoving = True
Num = Int(W1 * 8)
InputData = EmptySpotToken
Z1 = Int(S1 + 0.5) ' X location
Z2 = Int(S2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
X = S1
Y = S2
C2 = Int(C1)
X1 = C(C2, 1) + (C(C2 + 1, 1) - C(C2, 1)) * (C1 - C2)
X2 = C(C2, 2) + (C(C2 + 1, 2) - C(C2, 2)) * (C1 - C2)
For I = 1 To Num
S1 = S1 + X1
S2 = S2 + X2
If S1 < 0.5 Or S1 >= 8.5 Or S2 < 0.5 Or S2 >= 8.5 Then
GoTo Entry2170
End If
InputData = EmptySpotToken
Z1 = Int(S1 + 0.5)
Z2 = Int(S2 + 0.5)
StringComparisonInSectorArray(InputData) ' .. , Z1, Z2)
If Z3 <> 0 Then GoTo ContinueToNextSectorCheck
MessageLogWriteLine("")
MessageLogWriteLine("Warp engines shutdown at sector " + _
S1.ToString() + ", " + _
S2.ToString() + _
" due to bad navigation")
S1 = S1 - X1
S2 = S2 - X2
GoTo MapEnterprise
ContinueToNextSectorCheck:
Next I
MapEnterprise:
InputData = EnterpriseToken
'S1 = Int(S1 + 0.5)
'S2 = Int(S2 + 0.5)
Z1 = Int(S1 + 0.5) ' X location
Z2 = Int(S2 + 0.5) ' Y location
InsertIntoStringArrayForSector(InputData)
E7 = (E7 - Num) + 5
If W1 < 1 Then GoTo CommonExit
T = T + 1
'StarDateExpirationCheck: '2150:
' If T > T0 + T9 Then
' '
' ' Time has expired!
' GoTo ShowCurrentStarDate '3970
' End If
GoTo CommonExit
Entry2170:
X = Q1 * 8 + X + X1 * Num
Y = Q2 * 8 + Y + X2 * Num
Q1 = Int(X / 8)
Q2 = Int(Y / 8)
S1 = Int(X - Q1 * 8 + 0.5)
S2 = Int(Y - Q2 * 8 + 0.5)
If S1 <> 0 Then GoTo Entry2260
Q1 = Q1 - 1
S1 = 8
Entry2260:
If S2 <> 0 Then GoTo Entry2290
Q2 = Q2 - 1
S2 = 8
Entry2290:
T = T + 1
E7 = E7 - Num + 5
'' Out of Time?
'If T > T0 + T9 Then
' GoTo ShowCurrentStarDate
'End If
CommonExit:
'' Set Enterprise is finished Moving!
'EnterpriseIsMoving = False
' If We moved to a NEW Quadrant, then Map the NEW Quadrant!
If (Q1Save <> Q1) Or (Q2Save <> Q2) Then
'
' Map Next Quadrant randomizes the data when the
' Enterprise enters that quadrant!
MapNextQuadrant()
Else
'
' First checks for Game Over then remaps the current
' Sectors in this Quadrant!
CheckForGameOver()
End If
End Sub
Private Sub CheckOnTheUnableToComplySound()
' Play Sound Effect ONLY if Sounds are set to ON!
If SoundsFlag = True Then
' Make Sound!
Dim SoundFile As String = _
System.AppDomain.CurrentDomain.BaseDirectory + _
"UnableToComply.WAV"
If System.IO.File.Exists(SoundFile) Then
My.Computer.Audio.Play(SoundFile)
End If
End If
End Sub
Private Sub UpdateDamageControlData()
Dim NormalStatus As String = "Online"
Dim DeviceStatus As String
'D(6) = 0 ' Automatic repair of Damage Control for now?
' DAMAGE CONTROL REPORT
DamageControl:
If DeviceArrayForDamageTime(6) >= 0 Then
'DeviceArrayForDamageTime(6) = 0
StatusDamageControl.Text = NormalStatus
GoTo ShowDamageReport
End If
'' Do Unable to Comply Sound?
'UnableToComplySound()
' Damage Control is down!
StatusWarpEngines.Text = "Unknown"
StatusShortRangeSensors.Text = "Unknown"
StatusLongRangeSensors.Text = "Unknown"
StatusPhaserControl.Text = "Unknown"
StatusPhotonTorpedoes.Text = "Unknown"
StatusDamageControl.Text = "System Down! " + _
DeviceArrayForDamageTime(6).ToString
StatusShieldControl.Text = "Unknown"
StatusComputer.Text = "Unknown"
GoTo CommonExit
ShowDamageReport:
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(1) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(1).ToString
End If
StatusWarpEngines.Text = DeviceStatus
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(2) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(2).ToString
End If
StatusShortRangeSensors.Text = DeviceStatus
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(3) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(3).ToString
End If
StatusLongRangeSensors.Text = DeviceStatus
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(4) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(4).ToString
End If
StatusPhaserControl.Text = DeviceStatus
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(5) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(5).ToString
End If
StatusPhotonTorpedoes.Text = DeviceStatus
' Damage Control checked above!
'StatusDamageControl.Text = "System Down!"
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(7) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(7).ToString
End If
StatusShieldControl.Text = DeviceStatus
DeviceStatus = NormalStatus
If Not (DeviceArrayForDamageTime(8) >= 0) Then
DeviceStatus = "Offline " + _
DeviceArrayForDamageTime(8).ToString
End If
StatusComputer.Text = DeviceStatus
CommonExit:
End Sub
Private Sub EnableTabControl(ByVal TabControlNumber As Integer)
' Show the TabControl and go the Selected Tab on it!
TabControl.Location = OverlayLocation.Location
TabControl.Visible = True
TabControl.SelectedIndex = TabControlNumber
End Sub
Private Sub DisableTabControl()
' Hide the TabControl
TabControl.Visible = False
End Sub
Private Sub btnNewMission_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNewMission.Click
StartNewMission()
End Sub
Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
Me.Close()
End
End Sub
' Show the Current Date and Time
' - Timer comes here every second
Private Sub TimeDisplay_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimeDisplay.Tick
Dim CurrentHour As Integer = TimeOfDay.Hour
Dim CurrentMinute As Integer = TimeOfDay.Minute
Dim CurrentSecond As Integer = TimeOfDay.Second
Dim DisplayAmPm As String
If CurrentHour < 12 Then
DisplayAmPm = "AM"
If CurrentHour = 0 Then CurrentHour = 12
Else
If CurrentHour > 12 Then
CurrentHour = CurrentHour - 12
End If
DisplayAmPm = "PM"
End If
Dim CurrentMonth As Integer = Today.Date.Month
Dim CurrentDay As Integer = Today.Date.Day
Dim CurrentYear As Integer = Today.Date.Year
Dim CurrentDayOfWeek As Integer = Today.DayOfWeek
Dim DayName As String = ""
Select Case CurrentDayOfWeek
Case 0 : DayName = "Sunday"
Case 1 : DayName = "Monday"
Case 2 : DayName = "Tuesday"
Case 3 : DayName = "Wednesday"
Case 4 : DayName = "Thursday"
Case 5 : DayName = "Friday"
Case 6 : DayName = "Saturday"
End Select
Dim DisplayDate As String = Today.Date.Month.ToString & _
"/" & _
Today.Date.Day.ToString & _
"/" & _
Today.Date.Year.ToString
Dim MonthName As String = ""
Select Case CurrentMonth
Case 1 : MonthName = "January"
Case 2 : MonthName = "February"
Case 3 : MonthName = "March"
Case 4 : MonthName = "April"
Case 5 : MonthName = "May"
Case 6 : MonthName = "June"
Case 7 : MonthName = "July"
Case 8 : MonthName = "August"
Case 9 : MonthName = "September"
Case 10 : MonthName = "October"
Case 11 : MonthName = "November"
Case 12 : MonthName = "December"
End Select
DisplayTime.Text = _
DayName & ", " & _
MonthName & " " & Trim(Str(CurrentDay)) & _
", " & _
Microsoft.VisualBasic.Right(Str(10000 + CurrentYear), 4) & _
" - " & _
Microsoft.VisualBasic.Right(Str(100 + CurrentHour), 2) & _
":" & _
Microsoft.VisualBasic.Right(Str(100 + CurrentMinute), 2) & _
":" & _
Microsoft.VisualBasic.Right(Str(100 + CurrentSecond), 2) & _
" " & _
DisplayAmPm
End Sub
' Writes to the Message Log on the Screen then adds
' a Carriage Return and Line Feed for a New Line when done!
' - vbCrLf = Carriage Return and Line Feed!
Private Sub MessageLogWriteLine(ByVal ReportDataLine As String)
AddToMessageLog(ReportDataLine + vbCrLf)
End Sub
' Writes to the Message Log on the Screen placing the passed
' data to the current line without adding a Carriage Return
' and Line Feed for a New Line!
Private Sub MessageLogWrite(ByVal ReportDataLine As String)
AddToMessageLog(ReportDataLine)
End Sub
' Add Message to the MessageLog! (Rich Text Box)
Private Sub AddToMessageLog(ByVal Message As String)
MessageLog.AppendText(Message)
MessageLog.SelectionStart = MessageLog.TextLength()
MessageLog.ScrollToCaret()
End Sub
Private Sub btnSpeakerToggle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSpeakerToggle.Click
' If Sounds were off, Then turn on sounds!
If SoundsFlag = False Then
'
SoundsFlag = True
btnSpeakerToggle.Image = SpeakerPictureOn.Image
btnSpeakerToggle.Text = "Sound Effects On"
'
' Check to see if we are under RED Alert!
If Cstring = "Red" Then
'
' If So, Force Red Alert Sound Effect!
LastQ1 = 0
LastQ2 = 0
'
' Play Sound Effect!
RedAlertSoundCheck()
'
End If
'
Else
'
' Otherwise, turn off sounds!
SoundsFlag = False
btnSpeakerToggle.Image = SpeakerPictureOff.Image
btnSpeakerToggle.Text = "Sound Effects Off"
'
End If
End Sub
End Class
Submit an article or tip