Zoom_Trek

[James D Jarvis]

Zoom_TREK version 0.01
adjusted navigation and was able to implement targeting of beam weapons (after reading bplus's angle post)

still very early in development but things are working more as I wanted them to.

Code: (Select All)

'Zoom Trek  v0.01
'by James D. Jarvis
'special thanks to bplus for posting angle example that improved some of the math for me
'
'Command a Trek a Starship
' w - accelerate
' s - decelerate
' a - turn to port
' d- turn to starboard
' t - activate tracking to traget alien vessel
' <space>,b to fire beam weapon at targetted vessel
'<esc>  - end program
Screen _NewImage(900, 680, 32)
_FullScreen
Dim Shared klr As _Unsigned Long
Type shiptype
    shape As Integer
    nm As String
    fuel As Double
    hdg As Double
    hc As Double
    mr As Double
    px As Double
    py As Double
    shield As Integer
    shieldmax As Integer
    shieldregen As Integer
    shieldrc As Integer
    sregenon As Integer
    hull As Integer
    k As _Unsigned Long
    br As Double
    beamname As String
    torpname As String
    bcost As Integer
    tcost As Integer
    tnum As Integer
    bdam As Integer
    tdam As Integer
    brange As Integer
    trange As Integer
    barc As Integer
    tarc As Integer
End Type
Type torptype
    shape As Integer
    torpname As String
    target As Integer
    hdg As Double
    hc As Double
    mr As Double
    px As Double
    py As Double
    k As _Unsigned Long
    tdam As Integer
    tarc As Integer
End Type
Dim Shared ps As shiptype
Dim Shared AV(10) As shiptype
Dim Shared pt(100) As torptype
Dim Shared at(300) As torptype
Dim Shared na As Integer
Dim Shared stardate, target, tdd, tsarc

defineship 0, ps 'player starting as commonwealth  you can chage this but missions will not reflect change beyond player ship

For msn = 1 To 1
    View Print 35 To 40
    tx = ps.px + 3.5 * Cos(0.01745329 * hdg)
    ty = ps.py + 3.5 * Sin(0.01745329 * hdg)

    stardate = Timer
    missions msn
    Cls
    Do
        Line (0, 0)-(_Width, 535), _RGB32(0, 0, 0), BF
        _Limit 30
        ' Circle (ppx, ppy), 4, _RGB32(250, 250, 100) 'the zoom_circle saucer
        ' drawcraft 1, ppx, ppy, hdg, _RGB32(250, 250, 250)
        drawcraft ps.shape, ps.px, ps.py, ps.hdg, ps.k
        shipdatadisplay
        handlealiens "draw"
        Line (1, 1)-(535, 535), _RGB32(100, 200, 100), B
        Line (10, 10)-(525, 525), _RGB32(100, 200, 100), B
        'Circle (tx, ty), 2, _RGB32(255, 255, 255) 'this nubbin is to show where the cricle is heading
        kk$ = InKey$
        'Locate 1, 1: Print "Fuel : "; Int(ps.fuel)
        'Locate 1, 20: Print "Velocity :"; Int(ps.mr * 200)
        _Display
        Select Case kk$
            Case "w"
                If ps.fuel > 0 Then
                    ps.mr = ps.mr + 0.05 * (100000 / ps.fuel)
                    ps.fuel = ps.fuel - (1 * ps.br)
                End If
            Case "s"
                If ps.fuel > 0 Then
                    ps.fuel = ps.fuel - Sqr(ps.mr / (0.05 * ps.br))
                    ps.mr = ps.mr - 0.05
                    If ps.mr < 0 Then ps.mr = 0
                End If
            Case "a"
                If ps.fuel > 0 Then
                    ps.fuel = ps.fuel - Sqr(Sqr(ps.mr / (0.05 * ps.br)))
                    ps.hc = ps.hc - 2
                    ps.mr = ps.mr * 0.995
                End If
            Case "d"
                If ps.fuel > 0 Then
                    ps.fuel = ps.fuel - Sqr(Sqr(ps.mr / 0.05))
                    ps.hc = ps.hc + 2
                    ps.mr = ps.mr * .995
                End If
            Case " ", "b" 'fire beam weapon
                If target < 1 Then
                    Sound 880, 3
                    Print "NO TARGET DECLARED (Press T to activate target tracking)"
                Else
                    If Abs(tsarc) <= ps.barc And tdd <= ps.brange Then
                        Print "FIRING BEAM AT "; AV(target).nm; tsarc
                        Print tdd
                    Else
                        If Abs(tsarc) > ps.barc Then Print "TARGET "; AV(target).nm; " OUTSIDE FIRING ARC of "; ps.barc
                        If tdd > ps.brange Then Print "TARGET OUT OF RANGE"
                    End If

                End If
            Case "t" 'activate or shift tracking
                If na > 1 Then Print "SENSORS REPORT VALID TARGETS"
                For a = 1 To na
                    Print a; ") "; AV(a).nm,
                Next a
                Print
                Input "Enter Target # "; target
                If target > 0 Or target <= na Then
                    For T = 1 To na
                        If T = target And AV(T).px > 0 Then
                            Print "TARGET TRACKING FOR "; AV(T).nm; " CONFIRMED!"
                        Else
                            Print "NO VALID TARGET SELECTED"
                            target = 0
                        End If
                    Next T
                Else
                    Beep
                    Print "NO VALID TARGET SELECTED"
                    target = 0
                End If

        End Select


        handlealiens "move"

        ps.px = ps.px + ps.mr * Cos(0.01745329 * ps.hdg)
        ps.py = ps.py + ps.mr * Sin(0.01745329 * ps.hdg)

        ps.hdg = ps.hdg + ps.hc
        If ps.hdg >= 360 Then ps.hdg = ps.hdg - 360
        If ps.hdg < 0 Then ps.hdg = 360 + ps.hdg
        ps.hc = ps.hc * .75
        If ps.px < 15 Then ps.px = 500
        If ps.px > 515 Then ps.px = 15
        If ps.py < 15 Then ps.py = 500
        If ps.py > 515 Then ps.py = 15
        tx = ps.px + 3.5 * Cos(0.01745329 * ps.hdg)
        ty = ps.py + 3.5 * Sin(0.01745329 * ps.hdg)
    Loop Until kk$ = Chr$(27) Or kk$ = "ABORT"
    If kk$ = "ABORT" Then
        Print "MISSION "; msn; " ABORT"
        Print
        Print "Attempt next mission? (Y or N)"
        Do
            ask$ = Input$(1)
            ask$ = UCase$(ask$)
        Loop Until aks$ = "Y" Or ask$ = "N"
        If ask$ = "N" GoTo endgame
    Else
        GoTo endgame
    End If
Next msn
endgame:
End
Sub drawcraft (craftid, cx, cy, hdg, klr As _Unsigned Long)
    Select Case craftid
        Case 1
            Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(-(hdg - 90)) + " bu5l4d5u10br8d10u5l4d10"
            tx = cx + 5 * Cos(0.01745329 * hdg)
            ty = cy + 5 * Sin(0.01745329 * hdg)
            Circle (tx, ty), 3, klr
        Case 2
            Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(-(hdg - 90)) + " bu5l4d5u6br8d6u5l4d10"
            tx = cx + 5 * Cos(0.01745329 * hdg)
            ty = cy + 5 * Sin(0.01745329 * hdg)
            Circle (tx, ty), 2, klr
        Case 3
            Circle (cx, cy), 6, klr
            Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(-(hdg - 90)) + " l6u6br12d6l6u6"
        Case 4
            Circle (cx, cy), 9, klr
            Circle (cx, cy), 3, klr
            tx = cx + 6 * Cos(0.01745329 * hdg)
            ty = cy + 6 * Sin(0.01745329 * hdg)
            Circle (tx, ty), 2, klr
    End Select

End Sub
Sub defineship (id As Integer, ds As shiptype)
    Select Case id
        Case 0 'Commonwealth cruiser
            ds.shape = 1
            ds.fuel = 100000
            ds.hdg = 90
            ds.br = 1.1
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 1000
            ds.shieldmax = 1000
            ds.shieldregen = 10
            ds.shieldrc = 10
            ds.sregenon = 1
            ds.hull = 3000
            ds.k = _RGB32(250, 250, 250)
            ds.nm = "Commonwealth Cruiser"
            ds.beamname = "Maser"
            ds.torpname = "Proton Torpedo MII"
            ds.bcost = 1
            ds.tcost = 1
            ds.tnum = 300
            ds.bdam = 300
            ds.tdam = 1500
            ds.brange = 100
            ds.trange = 300
            ds.barc = 60
            ds.tarc = 30
        Case 1 'Kraal Destroyer
            ds.shape = 2
            ds.fuel = 90000
            ds.br = 1.0
            ds.hdg = 90
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 900
            ds.shieldmax = 900
            ds.shieldregen = 9
            ds.shieldrc = 10
            ds.sregenon = 1
            ds.hull = 2000
            ds.k = _RGB32(250, 50, 0)
            ds.nm = "Kraal Destroyer"
            ds.beamname = "UVaser"
            ds.torpname = "Proton Torpedo MI"
            ds.bcost = 1
            ds.tcost = 1
            ds.tnum = 300
            ds.bdam = 250
            ds.tdam = 1000
            ds.brange = 70
            ds.trange = 200
            ds.barc = 40
            ds.tarc = 25

        Case 2 'Gorgon Raider
            ds.shape = 3
            ds.fuel = 125000
            ds.br = 2
            ds.hdg = 90
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 500
            ds.shieldmax = 500
            ds.shieldregen = 8
            ds.shieldrc = 15
            ds.sregenon = -1
            ds.hull = 5000
            ds.k = _RGB32(100, 250, 50)
            ds.nm = "Gorgon Imperial Raider"
            ds.beamname = "Laser"
            ds.torpname = "Atomic-WarpStorm"
            ds.bcost = 1
            ds.tcost = 3000
            ds.tnum = -99
            ds.bdam = 200
            ds.tdam = 3000
            ds.brange = 50
            ds.trange = 200
            ds.barc = 40
            ds.tarc = 20

        Case 3 'Andromeda Invader
            ds.shape = 4
            ds.fuel = 250000
            ds.br = 1
            ds.hdg = 90
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 2000
            ds.shieldmax = 2000
            ds.shieldregen = 20
            ds.shieldrc = 10
            ds.sregenon = 1
            ds.hull = 6000
            ds.k = _RGB32(100, 250, 50)
            ds.nm = "Andromeda Invader"
            ds.beamname = "Demat Beam"
            ds.torpname = "Quark Torpedo"
            ds.bcost = 1
            ds.tcost = 30
            ds.tnum = 1000
            ds.bdam = 400
            ds.tdam = 5000
            ds.brange = 150
            ds.trange = 100
            ds.barc = 120
            ds.tarc = 60

        Case 4 'Kraal Corsair
            ds.shape = 2
            ds.fuel = 100000
            ds.br = 1.05
            ds.hdg = 90
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 950
            ds.shieldmax = 950
            ds.shieldregen = 10
            ds.shieldrc = 11
            ds.sregenon = 1
            ds.hull = 1800
            ds.k = _RGB32(240, 50, 40)
            ds.nm = "Kraal Corsair"
            ds.beamname = "UVaser"
            ds.torpname = "Proton Torpedo MI"
            ds.bcost = 1
            ds.tcost = 1
            ds.tnum = 100
            ds.bdam = 250
            ds.tdam = 1000
            ds.brange = 70
            ds.trange = 200
            ds.barc = 50
            ds.tarc = 20

        Case 5 'Kraal
            ds.shape = 2
            ds.fuel = 150000
            ds.br = 1.2
            ds.hdg = 90
            ds.hc = 0
            ds.mr = 0
            ds.px = 0
            ds.py = 0
            ds.shield = 1150
            ds.shieldmax = 1150
            ds.shieldregen = 12
            ds.shieldrc = 15
            ds.sregenon = 1
            ds.hull = 2500
            ds.k = _RGB32(240, 50, 40)
            ds.nm = "Kraal BattleCruiser"
            ds.beamname = "Overcharged UVaser"
            ds.torpname = "Proton Torpedo MII"
            ds.bcost = 2
            ds.tcost = 1
            ds.tnum = 200
            ds.bdam = 300
            ds.tdam = 1500
            ds.brange = 90
            ds.trange = 280
            ds.barc = 55
            ds.tarc = 35

    End Select
End Sub
Sub shipdatadisplay
    _PrintString (580, 10), "Stardate " + Str$(Timer)
    _PrintString (580, 60), ps.nm
    _PrintString (580, 80), "Fuel " + Str$(Int(ps.fuel))
    _PrintString (580, 100), "Velocity " + Str$(Int(ps.mr * 200))
    _PrintString (580, 120), "Shields " + Str$(ps.shield)
    _PrintString (580, 140), "Hull Integrity " + Str$(ps.hull)
    _PrintString (580, 160), ps.torpname
    If ps.tnum > -1 Then
        _PrintString (580, 180), "Ammo: " + Str$(ps.tnum)
    Else
        Select Case ps.tnum
            Case -99
                _PrintString (580, 180), "-- Online --"
            Case -13
                _PrintString (580, 180), "** OFFLINE **"
        End Select
    End If
    If target > 0 Then
        _PrintString (580, 200), "************************"
        _PrintString (580, 216), " TARGET TRACKING REPORT "
        _PrintString (580, 232), "************************"
        _PrintString (580, 250), AV(target).nm
        If Int(Rnd * 100) < 20 Then
            msg$ = "Shields : ?????????????????"
        Else
            msg$ = "Shields : " + Str$(AV(target).shield)
        End If
        _PrintString (580, 270), msg$
        If Int(Rnd * 100) < 20 Then
            msg$ = "Hull   : ?????????????????"
        Else
            msg$ = "Hull   : " + Str$(AV(target).hull)
        End If
        _PrintString (580, 290), msg$
        dx = Abs(ps.px - AV(target).px): dy = Abs(ps.py - AV(target).py)
        tdd = Sqr(dx * dx + dy + dy)
        _PrintString (580, 310), "Range to Target : " + Str$(Int(tdd))
        tsarc = tbearing(ps.px, ps.py, AV(target).px, AV(target).py, ps.hdg)
        _PrintString (580, 330), "Target Bearing : " + Str$(tsarc)

    End If
End Sub
Sub missions (m)
    Select Case m
        Case 1
            Print "**** STARWATCH COMMAND to "; ps.nm; " ****"
            Print "!!!! NEUTRAL ZONE VIOLATION DETECTED !!!!"
            Print "!!!!  ENGAGE HOSTILE KRAAL VESSEL    !!!!"
            Print
            Print " <press any key to engage warp drive> "
            _KeyClear
            any$ = Input$(1)
            na = 1
            defineship 1, AV(1)
            AV(1).hdg = 90: AV(1).mr = .1: AV(1).px = 300: AV(1).py = 100: AV(1).hull = AV(1).hull / 2
            For a = 2 To 10
                defineship 1, AV(a)
                AV(a).fuel = 0: AV(a).px = 0
            Next a
            ps.px = 250: ps.py = 250: ps.hdg = 0: ps.hc = 0: ps.mr = 0
            target = 0
    End Select
End Sub
Sub handlealiens (sequence$)
    Select Case sequence$
        Case "draw"
            For a = 1 To na
                If AV(a).px > 0 Then
                    drawcraft AV(a).shape, AV(a).px, AV(a).py, AV(a).hdg, AV(a).k
                End If
            Next a
        Case "move"
            For a = 1 To na
                If AV(a).px > 0 And AV(a).mr > 0 Then

                    xtp = AV(a).px - ps.px
                    ytp = AV(a).py - ps.py
                    dtp = Sqr(Abs(xtp) * Abs(xtp) + Abs(ytp) * Abs(ytp))
                    AV(a).hdg = AV(a).hdg + AV(a).hc
                    AV(a).hc = AV(a).hc * .75
                    AV(a).px = AV(a).px + AV(a).mr * Cos(0.01745329 * AV(a).hdg)
                    AV(a).py = AV(a).py + AV(a).mr * Sin(0.01745329 * AV(a).hdg)

                    If AV(a).px < 15 Then AV(a).px = 500
                    If AV(a).px > 515 Then AV(a).px = 15
                    If AV(a).py < 15 Then AV(a).py = 500
                    If AV(a).py > 515 Then AV(a).py = 15
                End If
            Next a
    End Select
End Sub
Function tbearing (x1, y1, x2, y2, ahdg)
    'gets a  bearing to target at x2,y2 from origin at x1,y1 with heading ahdg
    'the angle returned will be negative  if target is to port and positive if target is to starboard
    ang = DAtan2(x1, y1, x2, y2)
    tang = (ahdg - ang) * -1
    If tang < -180 Then tang = 360 + tang
    tbearing = tang
End Function

Function DAtan2 (x1, y1, x2, y2)
    'thanks to bplus for this function
    deltaX = x2 - x1
    deltaY = y2 - y1
    ' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
    rtn = _R2D(_Atan2(deltaY, deltaX))
    If rtn < 0 Then DAtan2 = rtn + 360 Else DAtan2 = rtn
End Function