Author Topic: WIP: Dog fight in space...sort of... (Read 10501 times)

OldMoses · « **on:** June 16, 2019, 05:20:31 pm »

I thought I would share this little ditty for your amusement, still very much a work in progress, but a work that QB64 has largely made possible in its present and (somewhat) working form. I also need to give a big "Thank you" to Petr for the ASCII image routine that I'm using, great stuff that I'm far too dense to come up with on my own.

I used to be a gamemaster of GDW's Traveller RPG. A science fiction role playing game, which included the possibility of ship to ship space combat. Problem with the game system's rules being that it employed a laborious vector plotting process that was too labor intensive to really use without bogging play down with the details. So I just handled such things off the cuff with no real idea of what would actually be taking place in space. I always dreamed of a program that would handle the maneuvering details, and thus was this project born. I'm tickled with the polar tick display, it was one of those rare bits that worked perfectly out of the gate.

I'm having an issue getting menu choices to display, but the controls are simple:

up/down arrows choose the active (highlighted) unit

"V" initiates vector input for the active unit, and asks for an azimuth direction, elevation and acceleration. Accleration is in "Gs", and a little goes a long way in a turn. Fractions of one G will make noticeable changes.

"T" executes a 1000 second game turn using the vectors input with "V" and updates the new positions at the end of the turn.

"Q" Quits

The display changes with the changes in viewpoint of the active unit. The active unit shows speed and heading, while the inactive ones show bearing and distance from the active unit. There are six units of data for debugging purposes, mostly sitting stationary to start, eventually I'll add input and editing functions. As the units speed away from each other the display scale changes to accomodate them. Don't know how far I'll go with it, as far as my poor tender head can accomodate...

While it's envisioned to track in three dimensions, (which apparently needs some work), it only displays two, the x,y plane. My pay grade has limits... ;)

There are no brakes in space so if you want to stop, you must counterthrust. Also any vector input is assumed to continue from one turn to another unless it's changed, so if you don't "take your foot off the pedal" on a subsequent turn you can really get haulin'. The numbers get big fast which _INTEGER64 made easy to deal with.

Edit: removing _DISPLAY from several places it shouldn't have been got my menu line back.
Installed dynamic scale grid. Installed range bands, turn counter, rudimentary ship editor and fixed aspect ratio bug.
Mouse support installed, and a Sol sized star at azimuth 45 from the starting point, don't fall into it...bad for ya ;)
Added display toggles: R for ranging, G for grid, and A for azimuth wheel
Added mouse choosing of new active unit in sensor display
Added planets, randomly placed in their orbit tracks. Added breaking counterthrust feature.
Started work on an inclinometer display.
Added selected interstellar bodies, this helped me to nail one persistent bug in the zoom display. 7-6-2019
Added satellites and turn based orbital movement. 7-10-2019
Added gravity effects on ships from system bodies. Ships can now crash into bodies. 7-14-2019
Added improved planet impact routine, and random placement of ships. 7-21-2019
Pushed fix of planet rendering bug. 11-22-2019
Added sensor occlusion of planetary bodies, active ship cannot see what's on the other side of a planet from it. Added a relative coordinate system to deal with calculation issues associated with ray tracing ops in the outer planets of the system. Added instant active ship placement via right mouse click in sensor display. Added orbit track on/off toggle. 12-5-2019

Updated GUI tools (with more to come) and scrolling data fields to handle additional ships. 12-9-2019

Added routines to add ships, delete ships, purge destroyed ships from data list, etc. Added a graphics based vector input routine. Cleaned up assorted bugs and tightened up code where possible. 12-14-19

Added a ship orientation and direction graphic (see attached image files) and a Z panning slider on right side of screen that rotates views around the X axis for visual aid to ranging. 12-25-2019

Uploaded latest version. Lots of changes, bug fixes and a few new features over the last several weeks. Now attached in zip file with executable and subdirectory structure. 2-16-2020

Got rid of much of the zoom in slow down bug, added ring and planetoid belt display, and autosave crash protection. Added a quick and dirty system editor {syseditII} for creating alternate star systems, another work in progress. Also the humble beginnings of a user guide. 7-26-2020

Code: QB64: [Select]

$NOPREFIX
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CT-Vector (formerly Star Ruttier)
' 2D6 Sci Fi roleplaying utility
' coding by Richard Wessel
' using  QB64 v.1.4
' Made possible with guidance and code contributions by
' Bplus, Petr, SMcNeill, and many others at QB64.org forum. Thank you.
' Thanks to my son Erik for the idea to include an auto counter thrust
' development and beta test version 0.36  uploaded 7-26-2020
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'                                                               USER DEFINED VARIABLES
TYPE unitpoint '                                                relative unit placement
    pX AS INTEGER64 '                                           X coordinate / mem 0-7
    pY AS INTEGER64 '                                           Y coordinate / mem 8-15
    pZ AS INTEGER64 '                                           Z coordinate / mem 16-23
END TYPE
 
TYPE ship '                                                     unit info variable
    id AS BYTE '                                                unit ID / mem 0
    Nam AS STRING * 10 '                                        unit name / mem 1 - 10
    MaxG AS SINGLE '                                            Maximum thrust ship can use / mem 11-14
    op AS unitpoint '                                           previous turn x,y,z position op=old position / mem 15-22,23-30,31-38
    OSp AS SINGLE '                                             previous turn velocity / mem 39-42
    OHd AS SINGLE '                                             previous turn heading / mem 43-46
    OIn AS SINGLE '                                             previous turn inclination / mem 47-50
    Ostat AS BYTE '                                             previous turn status / mem 51
    ap AS unitpoint '                                           Absolute x,y,z position ap=absolute position / mem 52-59,60-67,68-75
    Sp AS SINGLE '                                              coasting velocity / mem 76-79
    Hd AS SINGLE '                                              coasting heading / mem 80-83
    In AS SINGLE '                                              coasting inclination / mem 84-87
    status AS BYTE '                                            0=destroyed 1=in flight 2=landed 3=disabled / mem 88
    bogey AS BYTE '                                             target of intercept/evade solution / mem 89
    bstat AS BYTE '                                             type of solution 0=none 1=evade 2=intercept 3=Planetfall / mem 90
    mil AS BYTE '                                               military sensors? true/false / mem 91
END TYPE
 
TYPE Maneuver '                                                 active thrust polar vector
    Azi AS SINGLE '                                             Thrust heading / mem 0-3
    Inc AS SINGLE '                                             Thrust inclination / mem 4-7
    Gs AS SINGLE '                                              Thrust acceleration / mem 8-11
END TYPE
 
TYPE body '                                                     Celestial bodies
    nam AS STRING * 20 '                                        Name / mem 0-19
    parnt AS STRING * 20 '                                      name of parent body / mem 20-39
    radi AS INTEGER64 '                                         Size (needs INTEGER64 in event of large star) / mem 40-47
    orad AS INTEGER64 '                                         Orbital radius / mem 48-55
    oprd AS SINGLE '                                            Orbital period (years) / mem 56-59
    rota AS SINGLE '                                            Rotational period / mem 60-63
    dens AS SINGLE '                                            Density, basis for grav(Gs) calculation / mem 64-67
    rank AS BYTE '                                              1=primary, 2=planet/companion, 3=satelite / mem 68
    star AS BYTE '                                              -1=star  0=non-stellar body 2=planetoid belt / mem 69
    class AS STRING * 2 '                                       Two digit code, use for stellar class, GG, etc. / mem 70-71
    siz AS STRING * 3 '                                         three digit code, use for stellar size, / mem 72-74
    ps AS unitpoint '                                           coordinate position / mem 75-98
END TYPE
 
'                                                               GLOBAL VARIABLES AND ARRAYS
DIM SHARED ttl AS STRING * 15
DIM SHARED clr&(0 TO 15) '                                      32 bit equivalent of SCREEN 0 colors
DIM SHARED hvns(x) AS body '                                    System stars and planets
DIM SHARED cmb(x) AS ship '                                     unit info array (Combatants)
DIM SHARED rcs(x) AS unitpoint '                                Relative Coordinate Ship- x,y,z relative to vpoint
DIM SHARED rcp(x) AS unitpoint '                                Relative Coordinate Planet- "   "   "    "    "
DIM SHARED dcs(x) AS unitpoint '                                Display Coordinate Ship
DIM SHARED dcp(x) AS unitpoint '                                Display Coordinate Planet
DIM SHARED zangle AS SINGLE '                                   Angle from overhead for Z-pan
DIM SHARED Ozang AS SINGLE '                                    Old 3D angle value for fast toggle
DIM SHARED vpoint AS UNSIGNED BYTE '                            active unit pointer
DIM SHARED shipoff AS UNSIGNED BYTE '                           display offset for ship data scroll
DIM SHARED units AS UNSIGNED BYTE '                             number of combatant units
DIM SHARED collision AS BYTE '                                  collision check variable
DIM SHARED Thrust(x) AS Maneuver '                              Applied acceleration
DIM SHARED Gwat AS Maneuver '                                   Acceleration vector of gravitational influences
DIM SHARED Turncount AS INTEGER '                               number of turns of play
DIM SHARED etd AS INTEGER '                                     elapsed time days
DIM SHARED eth AS BYTE '                                        elapsed time hours
DIM SHARED etm AS BYTE '                                        elapsed time minutes
DIM SHARED ets AS BYTE '                                        elapsed time seconds
DIM SHARED t1%
DIM SHARED chr_img(255) AS LONG '                               handle array for resizeable font
DIM SHARED mouse_x AS INTEGER '                                 for passing mouse click x coordinate to other SUBs
DIM SHARED mouse_y AS INTEGER '                                 for passing mouse click y coordinate to other SUBs
DIM SHARED mouse_left AS BYTE '                                 mouse left button pressed
DIM SHARED mouse_right AS BYTE '                                mouse right button pressed
DIM SHARED ZoomFac AS SINGLE '                                  Display zoom
DIM SHARED orbs AS INTEGER '                                    number of stars/planets/satellites
DIM SHARED oryr AS SINGLE '                                     # of years since 000-0000
DIM SHARED A& '                                                 Main screen handle
DIM SHARED AW& '                                                Azimuth wheel overlay handle
DIM SHARED SS& '                                                Sensor screen handle
DIM SHARED ZS& '                                                Z-pan screen handle
DIM SHARED ORI& '                                               Orientation screen handle
REDIM SHARED ship_box(20) AS LONG '                             Ship data display box
DIM SHARED flight& '                                            Flightplan solution buttons
DIM SHARED evade& '                                             Evade solution buttons
DIM SHARED intercept& '                                         Intercept solution buttons
DIM SHARED XZ& '                                                Zoom extents button
DIM SHARED IZ& '                                                Zoom in button
DIM SHARED OZ& '                                                Zoom out button
DIM SHARED RG& '                                                Ranging button
DIM SHARED OB& '                                                Orbit track button
DIM SHARED GD& '                                                Grid button
DIM SHARED AZ& '                                                Azimuth wheel button
DIM SHARED IN& '                                                Inclinometer button
DIM SHARED JP& '                                                Jump envelope button
DIM SHARED DI& '                                                Jump Diameter button
DIM SHARED DN& '                                                Jump Density button
DIM SHARED QT& '                                                Quit button (program end)
DIM SHARED cancel& '                                            Cancel solution
DIM SHARED strfld AS LONG '                                     Gatekeeper background
DIM SHARED ShpT AS LONG '                                       Thrusting ship image handle
DIM SHARED ShpO AS LONG '                                       Non-thrusting ship image handle
DIM SHARED TLoc AS LONG '                                       Target lock icon handle
DIM SHARED TLocn AS LONG '                                      Target lock not available handle
DIM SHARED Px AS INTEGER '                                      System primary X position
DIM SHARED Py AS INTEGER '                                      System primary Y position
DIM SHARED Pz AS INTEGER '                                      System primary Z position
DIM SHARED togs AS UNSIGNED INTEGER '                           display toggles
'                                                               Undo toggle- prevents more than one turn undo       togs bit=0
'                                                               Z-pan toggle                                        togs bit=1
'                                                               Azimuth wheel toggle                                togs bit=2
'                                                               Grid toggle                                         togs bit=3
'                                                               Ranging circle toggle                               togs bit=4
'                                                               Inclinometer toggle                                 togs bit=5
'                                                               Jump diameter toggle                                togs bit=6
'                                                               Orbit track display toggle                          togs bit=7
'                                                               Gravity zone toggle                                 togs bit=8
'                                                               compute jump diameters accounting for density       togs bit=9
'                                                               Belt/ring display toggle                            togs bit=10
'                                                               bits 11-15 for future expansions
 
'                                                               DEBUGGING VARIABLES (if any present for beta testing)
 
 
'                                                               INITIAL PARAMETERS
ttl = "CT Vector 0.36"
Px = 0: Py = 0: Pz = 0 '                                        (x,y,z) position of system primary aka ORIGIN
cmb(0).ap.pX = 0 '                                              No ships left active unit
cmb(0).ap.pY = 0
cmb(0).ap.pZ = 0
Turncount = 0 '                                                 game turn number- determines elapsed time in scenario
vpoint = 1 '                                                    active unit pointer
ZoomFac = 1 '                                                   Zoom factor
togs = &B0000010110001101 '                                     set toggle initial state
shipoff = 0 '                                                   ship list scrolling offset value
 
CONST KMtoAU = 149597900
 
REDIM SHARED Thrust(x) AS Maneuver '                            unit accelerations/vector
REDIM SHARED Sensor(x, x) AS BYTE '                             Sensor ops- planetary obscuration array, who can see who?
'                                                               bit 0 = Sensor occlusion flag
'                                                               bit 1 = Target lock flag
'                                                               bit 2 = Contact indistinct/Extreme range flag
 
RESTORE colors
FOR x = 0 TO 15 '                                               iterate colors 0 thru 15
    READ r% '                                                   get red component
    READ g% '                                                   get green component
    READ b% '                                                   get blue component
    clr&(x) = RGB32(r%, g%, b%) '                               mix color x into array
NEXT x
 
'                                                               IMAGES AND BUTTONS
FOR Ascii = 0 TO 255 '                                          PETR'S CHARACTER IMAGE LOADER
    chr_img(Ascii) = NEWIMAGE(8, 16, 32) '                      create image for each ASCII character
    DEST chr_img(Ascii) '                                       set image destination of ASCII character
    PRINTMODE KEEPBACKGROUND '                                  transparency for graphics overlays
    COLOR &HFFF5F5F5
    PRINTSTRING (0, 0), CHR$(Ascii), chr_img(Ascii) '           put ASCII character in image
NEXT Ascii '                                                    now any size ASCII character can be printed
 
A& = NEWIMAGE(1250, 700, 32) '                                  Main display
SS& = NEWIMAGE(620, 620, 32) '                                  Sensor screen display
AW& = NEWIMAGE(620, 620, 32) '                                  Azimuth wheel overlay
ZS& = NEWIMAGE(40, 650, 32) '                                   Z-pan slider display
ORI& = NEWIMAGE(254, 254, 32) '                                 Orientation display
flight& = NEWIMAGE(80, 16, 32) '                                Flightplan solution button
evade& = NEWIMAGE(40, 16, 32) '                                 Evade solution button
intercept& = NEWIMAGE(72, 16, 32) '                             Intercept solution button
cancel& = NEWIMAGE(48, 16, 32) '                                Cancel solution button
XZ& = NEWIMAGE(64, 32, 32) '                                    Zoom extents button
IZ& = NEWIMAGE(64, 32, 32) '                                    Zoom In button
OZ& = NEWIMAGE(64, 32, 32) '                                    Zoom Out button
RG& = NEWIMAGE(56, 32, 32) '                                    Ranging button
OB& = NEWIMAGE(56, 32, 32) '                                    Orbit track button
GD& = NEWIMAGE(48, 32, 32) '                                    Grid button
AZ& = NEWIMAGE(40, 32, 32) '                                    Azimuth button
IN& = NEWIMAGE(40, 32, 32) '                                    Inclinometer button
JP& = NEWIMAGE(48, 32, 32) '                                    Jump envelope button
DI& = NEWIMAGE(48, 32, 32) '                                    Jump Diameter button
DN& = NEWIMAGE(48, 32, 32) '                                    Jump Density button
QT& = NEWIMAGE(48, 32, 32) '                                    Quit button (program end)
strfld = LOADIMAGE("images\starfield.jpg", 32) '                Gatekeeper background image
ShpT = LOADIMAGE("images\suleimant.png", 32) '                  ship- thrusting
ShpO = LOADIMAGE("images\suleimano.png", 32) '                  ship- no thrust
TLoc = LOADIMAGE("images\tlock.png", 32) '                      target lock icon
TLocn = LOADIMAGE("images\tlockn.png", 32) '                    target lock n/a
 
Make_Images '                                                   Create overlays
Make_Buttons '                                                  Create control buttons
 
SCREEN A& '                                                     Initiate main screen
DO: LOOP UNTIL SCREENEXISTS
TITLE "CT-vector 0.352 beta testing"
SCREENMOVE 5, 5
 
GateKeeper
SetUp '                                                         Read/Load ships and planets
 
t1% = FREETIMER '                                               Autosave timer
ON TIMER(t1%, 60) Save_Scenario 0 '                             save every minute
TIMER(t1%) ON
 
MainLoop '                                                      Enter main program loop
Terminus '                                                      do housekeeping and exit
CLEAR
SYSTEM
 
'                                                               DATA SECTION
colors:
'                                                               colors 0-4
DATA 0,0,0,0,0,168,0,168,0,0,168,168,168,0,0
'                                                               colors 5-9
DATA 168,0,168,168,84,0,168,168,168,84,84,84,84,84,252
'                                                               colors 10-14
DATA 84,252,84,84,252,252,252,84,84,252,84,252,252,252,84
'                                                               color 15
DATA 252,252,252
 
ships: '                                                        Sample ships for demo and debugging
'index, name, MaxG,ap.pX,ap.pY,ap.pZ,Speed,Heading,Inclination,mil
'DATA 7
'DATA 1,"Crotalus",2,-5000000,-5000000,0,0,0,0,0
'DATA 2,"Zho Trader",2,-5500000,-5780000,0,30,90,0,0
'DATA 3,"Tigress",6,-5060000,-5300000,5,10,0,90,-1
'DATA 4,"SDB",6,-5500000,-5400000,0,0,0,0,-1
'DATA 5,"Corsair",2,-5660000,-5200000,0,0,0,0,0
'DATA 6,"Beowulf",1,-5400000,-5000000,0,0,0,0,0
'DATA 7,"Slow Boat",3,-5300000,-5300000,0,0,0,0,0
DATA 3
DATA 1,"PC vessel",2,-500000,-500000,0,0,0,0,0
DATA 2,"bogey 1",2,-650000,-530000,0,0,0,0,0
DATA 3,"bogey 2",2,-700000,230000,0,0,0,0,0
 
 
'                                                               END DATA SECTION
'                                                               END MAIN MODULE
'**********************************************************************************
'                                                               BEGIN SUB/FUNCTION SECTION
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB AddShip
 
    PanelBlank 420, 578, 64, 32, &HFF0F0F0F
    Con_Blok 420, 578, 64, 32, "Adding", 0, &H508C5B4C
    DISPLAY
 
    DIM ts(units, units) AS BYTE
    x = 0 '                                                     save state of Sensor & TLock
    DO
        x = x + 1
        y = 0
        DO
            y = y + 1
            ts(x, y) = Sensor(x, y)
        LOOP UNTIL y = units
    LOOP UNTIL x = units
    units = units + 1 '                                         increment ship counter
    REDIM Sensor(units, units)
    x = 0 '                                                     reload Sensor & TLock
    DO
        x = x + 1
        y = 0
        DO
            y = y + 1
            Sensor(x, y) = ts(x, y)
        LOOP UNTIL y = units - 1
    LOOP UNTIL x = units - 1
 
 
    REDIM PRESERVE cmb(units) AS ship
    REDIM PRESERVE Thrust(units) AS Maneuver
    ship_box(units) = NEWIMAGE(290, 96, 32)
    cmb(units).id = units
    cmb(units).status = 1
    cmb(units).ap.pX = cmb(vpoint).ap.pX + 100000 '             start near active unit
    cmb(units).ap.pY = cmb(vpoint).ap.pY + 100000 '             edit call can change this
    cmb(units).ap.pZ = 0
    FOR x = 1 TO orbs '                                         check planets for interference
        IF Pyth(cmb(units).ap, hvns(x).ps) < hvns(x).radi THEN 'if inside planet
            DO
                cmb(units).ap.pX = cmb(units).ap.pX + 100000 '  move ship until beyond planet radius
            LOOP UNTIL Pyth(cmb(units).ap, hvns(x).ps) > hvns(x).radi
        END IF
    NEXT x
    vpoint = units
    EditShip -1
    Refresh
 
END SUB 'AddShip
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION Azimuth! (x AS INTEGER64, y AS INTEGER64)
 
    'Returns the azimuth bearing of a relative (x,y) offset
 
    IF x < 0 AND y >= 0 THEN
        Azimuth! = 450 - ABS(R2D(ATAN2(y, x)))
    ELSE
        Azimuth! = 90 - (R2D(ATAN2(y, x)))
    END IF
 
END FUNCTION 'Azimuth!
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB AzimuthWheel (var AS INTEGER)
 
    'Draw Azimuth wheel display - controlled by Aztog
    $CHECKING:OFF
    IF var AND NOT READBIT(togs, 1) THEN
        PUTIMAGE (-1000, 1000)-(1000, -1000), AW& '             Overlay azimuth scale wheel
 
        'Direction to Primary indicator- draw yellow primary azimuth indicator along azimuth wheel
        FCirc 990 * SIN(D2R(Azimuth!(Px - cmb(vpoint).ap.pX, Py - cmb(vpoint).ap.pY))),_
          990 * COS(D2R(Azimuth!(Px - cmb(vpoint).ap.pX, Py - cmb(vpoint).ap.pY))), 10, clr&(14)
 
        'Heading indicator
        'draw heading arrow
        LINE (950 * SIN(D2R(cmb(vpoint).Hd - 1)), 950 * COS(D2R(cmb(vpoint).Hd - 1)))-_
        (1000 * SIN(D2R(cmb(vpoint).Hd)), 1000 * COS(D2R(cmb(vpoint).Hd))), clr&(10)
        LINE (1000 * SIN(D2R(cmb(vpoint).Hd)), 1000 * COS(D2R(cmb(vpoint).Hd)))-_
        (950 * SIN(D2R(cmb(vpoint).Hd + 1)), 950 * COS(D2R(cmb(vpoint).Hd + 1))), clr&(10)
        'heading leader line
        LINE (0, 0)-(1000 * SIN(D2R(cmb(vpoint).Hd)), 1000 * COS(D2R(cmb(vpoint).Hd))), RGBA32(168, 0, 168, 40)
    END IF
    $CHECKING:ON
 
END SUB 'AzimuthWheel
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION Bearing (unit AS INTEGER)
 
    'determine azimuth bearing on ecliptic plane of 'unit' from viewpoint
    'and check for possible collision/docking
 
    IF rcs(unit).pX = 0 AND rcs(unit).pY = 0 AND rcs(unit).pZ = 0 THEN
        collision = -1
    ELSE
        collision = 0
    END IF
    Bearing = Azimuth!(rcs(unit).pX, rcs(unit).pY)
 
END FUNCTION 'Bearing
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB ButtonBlock
 
    'MANEUVER AND PROGRAM CONTROLS - temorary images
    'Upper corner @ (0,578) just under unit data blocks
    'First tier
    Con_Blok 0, 578, 64, 32, "Vector", 1, &HFF2C9B2C
    Con_Blok 70, 578, 64, 32, "n/a", 0, &HFF2C9B2C 'Con_Blok 70, 578, 64, 32, "Brake", 0, &HFF2C9B2C
    Con_Blok 140, 578, 64, 32, "Turn", 1, &HFF2C9B2C
    Con_Blok 210, 578, 64, 32, "Undo", 1, &HFF2C9B2C
    Con_Blok 280, 578, 64, 32, "Edit", 1, &HFFA6A188 '&HFF8C5B4C
    Con_Blok 350, 578, 64, 32, "Delete", 0, &HFFC80000
    Con_Blok 420, 578, 64, 32, "LoadAll", 0, &HFF2C9B2C
    Con_Blok 490, 578, 64, 32, "SaveAll", 1, &HFF8C5B4C
    'Second tier
    Con_Blok 0, 614, 64, 32, "Gs= 0", 0, &HFF2C9B2C
    Con_Blok 70, 614, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 140, 614, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 210, 614, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 280, 614, 64, 32, "Add", 0, &HFFA6A188 '&HFF8C5B4C
    Con_Blok 350, 614, 64, 32, "Purge", 0, &HFFC80000
    Con_Blok 420, 614, 64, 32, "LoadSys", 0, &HFF2C9B2C
    Con_Blok 490, 614, 64, 32, "SaveSys", 0, &HFF8C5B4C
    'Third tier
    Con_Blok 0, 650, 64, 32, "Brake", 0, &HFF2C9B2C 'Con_Blok 0, 650, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 70, 650, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 140, 650, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 210, 650, 64, 32, "n/a", 0, &HFF2C9B2C
    Con_Blok 280, 650, 64, 32, "Help", 1, &HFF4CCB9C
    IF cmb(vpoint).status = 3 THEN
        Con_Blok 350, 650, 64, 32, "Repair", 0, &HFFC80000
    ELSE
        Con_Blok 350, 650, 64, 32, "Adrift", 0, &HFFC80000
    END IF
    Con_Blok 420, 650, 64, 32, "LoadShp", 0, &HFF2C9B2C
    Con_Blok 490, 650, 64, 32, "SaveShp", 0, &HFF8C5B4C
 
    'sensor screen put @ 560,18 dimensions 620 x 620
    '560,18 -  1180,638
 
    'DISPLAY CONTROL TOGGLES - permanent images
    PUTIMAGE (560, 660), XZ&, A& '                              Zoom Extents
    PUTIMAGE (626, 660), IZ&, A& '                              Zoom In
    PUTIMAGE (692, 660), OZ&, A& '                              Zoom Out
    COLOR clr&(7)
    PRINTSTRING (560, 641), "Zoom Factor: " + STR$(ZoomFac), A&
    PUTIMAGE (762, 660), RG&, A& '                              Ranging Band toggle
    PUTIMAGE (820, 660), OB&, A& '                              Orbit track toggle
    PUTIMAGE (878, 660), GD&, A& '                              Grid toggle
    PUTIMAGE (928, 660), AZ&, A& '                              Azimuth Wheel toggle
    PUTIMAGE (970, 660), IN&, A& '                              Inclinometer toggle
    PUTIMAGE (1012, 660), JP&, A& '                             Jump Envelope toggle
    IF READBIT(togs, 6) THEN
        IF READBIT(togs, 9) THEN
            PUTIMAGE (1062, 660), DI&, A& '                     Jump Diameter toggle
        ELSE
            PUTIMAGE (1062, 660), DN&, A& '                     Jump Density toggle
        END IF
    END IF
    PUTIMAGE (1132, 660), QT&, A& '                             Quit (program) button
    IF READBIT(togs, 1) THEN
        Con_Blok 1204, 660, 40, 32, "3D", 0, &HFFB5651D
    ELSE
        Con_Blok 1204, 660, 40, 32, "2D", 0, &HFFB5651D
    END IF
 
END SUB 'ButtonBlock
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Cancel_AI (var AS BYTE)
 
    FOR x = 1 TO units '                                        cancel any intercept/evades targeting the wreck
        IF (cmb(x).bstat = 1 OR cmb(x).bstat = 2) AND cmb(x).bogey = var THEN
            cmb(x).bstat = 0: cmb(x).bogey = 0
        END IF
    NEXT x
 
END SUB 'Cancel_AI
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB ColCheck (var AS INTEGER)
 
    'CHECK FOR COLLISION WITH STAR/PLANET
    DIM sphr AS unitpoint '                                     center point of sphere
    DIM strt AS unitpoint '                                     start point of unit vector
    DIM nd AS unitpoint '                                       end point of unit vector
    DIM neari AS unitpoint '                                    near intersection point on surface of sphere
    FOR p = 1 TO orbs '                                         iterate for each body in system against unit (var)
        IF hvns(p).star <> 2 THEN
            IF Pyth(cmb(var).ap, hvns(p).ps) < hvns(p).radi THEN
                cmb(var).status = 0 '                               ends turn within sphere- crashed
            ELSE
                IF Pyth(hvns(p).ps, cmb(var).op) - hvns(p).radi < cmb(var).Sp * 1000 THEN 'wait for proximity to calculate
                    sphr = hvns(p).ps
                    strt = cmb(var).op
                    nd = cmb(var).ap
                    'Use FLOAT variables, these numbers are friggin' enormous!
                    dx## = nd.pX - strt.pX: dy## = nd.pY - strt.pY: dz## = nd.pZ - strt.pZ
                    A## = (dx## * dx##) + (dy## * dy##) + (dz## * dz##)
                    B## = 2 * dx## * (strt.pX - sphr.pX) + 2 * dy## * (strt.pY - sphr.pY) + 2 * dz## * (strt.pZ - sphr.pZ)
                C## = (sphr.pX * sphr.pX) + (sphr.pY * sphr.pY) + (sphr.pZ * sphr.pZ) + (strt.pX * strt.pX) +_
                 (strt.pY * strt.pY) + (strt.pZ * strt.pZ) + -2 * (sphr.pX * strt.pX + sphr.pY * strt.pY + sphr.pZ * strt.pZ)_
                  - (hvns(p).radi * hvns(p).radi)
                    disabc## = (B## * B##) - 4 * A## * C## ' if disabc <0 then no intersection =0 tangent >0 intersects two points
 
                    IF disabc## < 0 THEN
                        'No intersection detected, go on checking other bodies.
                    ELSE '                                          course intersects body
                        t## = (-B## - ((B## * B##) - 4 * A## * C##) ^ .5) / (2 * A##) 'Near intersect quadratic
                        neari.pX = strt.pX + t## * dx##: neari.pY = strt.pY + t## * dy##: neari.pZ = strt.pZ + t## * dz##
 
                        IF Pyth(neari, strt) <= Pyth(nd, strt) THEN ' impact
                            cmb(var).status = 0
                            cmb(var).ap = neari
                            Cancel_AI var
                            'if neari impact point needed in future upgrades, such as landing options, determine that point here
                            'landing option would entail a speed vs maximum thrust potential check.
                            'interestingly a ghost is left on the screen where the ship "died", probably a remnant of vector indicators.
                            'Purge will remove the ghosts.
                        END IF '                                    end: if vector intersects
                    END IF '                                        end: check for intersection
                END IF '                                            end: if close proximity do the check
            END IF
        END IF
    NEXT p
 
END SUB 'ColCheck
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Coming
 
    PRINTSTRING (300, 560), "Coming soon...maybe", A&
    DISPLAY
    SLEEP 2
 
END SUB 'Coming
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Comments
 
    'VERSION COMMENTS
    'Basic algorithm for rewrite of STARRUTR.BAS
    'starship vector movement handler for Classic Traveller RPG
    '
    '
    'HISTORIC COMMENTS
    '              STARRUTR.BAS (8.3 short for Star Ruttier)
    '   The ruttier being an archaic term for the charts and directions
    'that a sailing ships pilot would use to navigate, Star Ruttier is
    'a QBasic based program for tracking 3 dimensional space craft
    'maneuvers in an interplanetary setting.
    '   Conceived as a ship to ship combat game aid for the Traveller
    'Role Playing system, Star Ruttier displays graphic position and numeric
    'data for vector maneuvers in a turn based 3D cartesian (X,Y,Z) system.
    '   On the left each ship unit is displayed with Unit index, Name, Azimuth
    'Heading, Inclination, and Speed with one ship highlighted as the active
    'unit.  All inactive units are additionally displayed with Azimuth Bearing,
    'Inclination, and Distance from the active unit. On the right of the screen
    'a graphics window is displayed showing the relative positions of each
    'indexed unit.  The active unit is displayed in the center of the graphics
    'window, with the other units positioned relative to the active unit. The
    'active unit can be chosen by using the up and down arrows.
    '   The display is dynamically resized to include all units displayed
    'regardless of distance from the active unit. The display is viewed from
    'the Galactic zenith with the top edge being Coreward. Other viewpoints
    'may be offered in subsequent versions. In this release units above or
    'below the active unit are displayed Blue shift and Red shift
    'respectively.
    '   The 'chose' menu in the lower left corner displays the menu options
    'which can be accessed by typing the highlighted letter of each choice.
    'Type 'V' for vector to input new thrust, Azimuth, and Inclination
    'headings for the active unit. If no new values are entered the active
    'unit will default to the last entered values. The unit will continue
    'to thrust until the power is cut by entering zero values for thrust,
    'though the unit will continue to coast at the current vector.
    '   Type 'T' for turn after all desired vectors have been entered and
    'the new vectors will be applied for the current turn. All unit positions
    'will be updated and displayed and new vectors can be entered.
    '   Type 'Q' to quit program
 
    'CT Vector.bas comments
 
    'HOT KEYS       accessible in main loop
 
    ' "S"           Ship display mode (proposed)
    ' "P"           Planet display mode (proposed)
    '[up arrow]     increments active unit pointer
    '[down arrow]   decrements active unit pointer
    '[Delete]       delete the active unit
    '[Insert]       Add new unit and make active
    ' "+"           zoom in
    ' "-"           zoom out
    ' "X"           zoom extents (default zoom factor 1)
    ' "A"           toggle azimuth wheel....................... [default=on]
    ' "B"           toggle planetoid belt/ring display......... [default=on]
    ' "G"           toggle grid................................ [default=on]
    ' "I"           toggle inclinometer........................ [default=off]
    ' "R"           toggle ranging bands....................... [default=off]
    ' "J"           toggle jump diameters...................... [default=off]
    ' "D"           toggle density based jump diameters........ [default=off]
    ' "O"           toggle orbit tracks........................ [default=on]
    ' "Z"           toggle gravity zones....................... [default=on]
    ' "3"           toggle 3D panning.......................... [default=off]
    ' "V"           enter new vector for active unit. Enter azimuth "c" to counter vector
    ' "T"           apply vectors to game turn
    ' "U"           undo previous turn
    ' "E"           edit active unit data
    ' "Q"           end program
 
    'CT Vector has updated displays to 32 bit images. Mouse support has been added.
    'Navigation aids of azimuth wheel, inclinometer, scale grid as well as jump
    'diameter and combat range bands have been added. All may be toggled on and off
    'as needed. Planetary bodies will now occlude sensors of active ship.
    'Right mouse click will reposition active unit, in x,y, to anywhere on the visible
    'sensor screen limits. Z-pan slider rotates view 180 deg. around Y axis. Systems,
    'ships and scenarios may be saved and recalled.
 
    'The program will zoom out to distances of many parsecs, but has difficulty
    'zooming in tightly under several circumstances.
 
    'Tentative ideas for data system...
    'File system: [name].tss for star systems, [name].tvg for vessel group
    '             [scenario].tgn for loading both (game name for saving state for later recall)
 
    'TRAVEL FORMULAE (from Traveller Book)
 
    'Time[s] = 2 * ((Distance[m] / Acceleration[m/s^2])^.5)
 
    'Distance[m] = Acceleration[m/s^2] * Time[s]^2 / 4
 
    'Acceleration[m/s^2] = 4 * Distance[m] / Time[s]^2
 
 
    'GRAVITY FORMULAE (from Traveller Book)
 
    'Radius[100km] = 8 * Diameter[UPP]
 
    'Mass[earth mass] = K[earth densities] * (diameter[UPP] / 8)^3
    'Gs = K[earth densities] * (Diameter[UPP] / 8)
 
    'L = 64 * (Mass / G)^.5
 
    'OTHER USEFUL THINGS
    'from http://braeunig.us/space/vectors.htm
    'longitude=l=azimuth, latitude=b=inclination, and radial distance, r.
    'x = r cos b cos l   it must be noted that x & y are transposed with respect to
    'y = r cos b sin l   this application.
    'z = r sin b
 
    'color legend- for clr&(x) assignments
    '0=black,1=blue,2=green,3=aqua,4=red,5=purple,6=brown,7=white
    '8=gray, +8=bright color, except 14=yellow,
 
    'Mean Density of Earth = 5.514
 
    'LINKS
    'http://www.batesville.k12.in.us/Physics/PhyNet/Mechanics/Gravity/lab/excel_orbits.htm
 
    'USEFUL ALGORITHMS that are faster implemented outside of FUNCTION
    'find the x coordinate of a magnitude and azimuth: x = magnitude * SIN(_D2R(Azimuth))
    'find the y coordinate of a magnitude and azimuth: y = magnitude * COS(_D2R(Azimuth))
 
    'Deceleration = v^2 - u^2 / 2s
    'Where,
    'v = The Final Velocity
    'u = The Initial Velocity
    's = Distance
 
 
    'BUG LIST
 
    'somebody please shoot me...
 
END SUB 'Comments
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Con_Blok (xpos AS INTEGER, ypos AS INTEGER, xsiz AS INTEGER, ysiz AS INTEGER, label AS STRING, high AS INTEGER, col AS UNSIGNED LONG)
 
    'Create control block
    'upper left corner @ (xpos,ypos), size of (xsiz,ysiz), label, high= highlight character position, col= box color
    $CHECKING:OFF
    CN& = NEWIMAGE(xsiz, ysiz, 32)
    DEST CN&
    COLOR , col
    CLS
    LINE (1, 1)-(xsiz - 2, ysiz - 2), clr&(0), B
    PRINTMODE KEEPBACKGROUND
    x = LEN(label)
    sx = xsiz / 2 - x * 4
    sy = ysiz / 2 - 8
    FOR p = 1 TO x
        IF p = high THEN
            COLOR clr&(4)
        ELSE
            COLOR clr&(0)
        END IF
        IF col = &HFFC80000 THEN COLOR clr&(15)
        PRINTSTRING (sx + (p - 1) * 8, sy), MID$(label, p, 1)
    NEXT p
    PUTIMAGE (xpos, ypos), CN&, A&
    FREEIMAGE CN&
    $CHECKING:ON
 
END SUB 'Con_Blok
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB CoordUpdate (var1 AS INTEGER, var2 AS STRING)
 
    'convert polar data to cartesian and updates coordinates.x
    'var1 sends unit index
    'var2 sends origin T for turn or I for intercept/evade
    $CHECKING:OFF
    DIM CoastD AS unitpoint
    DIM ThrstD AS unitpoint
    DIM TotalD AS unitpoint
    DIM ms AS MEM
    DIM mt AS MEM
    ms = MEM(cmb())
    mt = MEM(Thrust())
 
    'Determine coasting deltaXYZ
    'CoastDeltaZ&& = cmb(var1).Sp * SIN(_D2R(cmb(var1).In))
    CoastD.pZ = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 76, SINGLE)_
     * SIN(D2R(MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 84, SINGLE)))
    'CoastDeltaX&& = cmb(var1).Sp * COS(_D2R(cmb(var1).In)) * SIN(_D2R(cmb(var1).Hd))
    CoastD.pX = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 76, SINGLE)_
     * COS(D2R(MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 84, SINGLE)))_
      * SIN(D2R(MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 80, SINGLE)))
    'CoastDeltaY&& = cmb(var1).Sp * COS(_D2R(cmb(var1).In)) * COS(_D2R(cmb(var1).Hd))
    CoastD.pY = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 76, SINGLE)_
     * COS(D2R(MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 84, SINGLE)))_
      * COS(D2R(MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 80, SINGLE)))
 
    ''determine coasting deltaXYZ using vector addition  ...experimental but won't add accelerations...????
    'CoastD = cmb(var1).ap: VecAdd CoastD, cmb(var1).op, -1
 
    'Determine thrusting delta XYZ for MoveTurn, InterVade assumes coasting vector
    IF var2 = "T" THEN
        'ThrstD.pZ = (Thrust(var1).Gs * 10000) * SIN(_D2R(Thrust(var1).Inc))
        ThrstD.pZ = (MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 8, SINGLE) * 10000)_
         * SIN(D2R(MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 4, SINGLE)))
        'ThrstD.pX = (Thrust(var1).Gs * 10000) * COS(_D2R(Thrust(var1).Inc)) * SIN(_D2R(Thrust(var1).Azi))
        ThrstD.pX = (MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 8, SINGLE) * 10000)_
         * COS(D2R(MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 4, SINGLE)))_
          * SIN(D2R(MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE , SINGLE)))
        'ThrstD.pY = (Thrust(var1).Gs * 10000) * COS(_D2R(Thrust(var1).Inc)) * COS(_D2R(Thrust(var1).Azi))
        ThrstD.pY = (MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 8, SINGLE) * 10000)_
         * COS(D2R(MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE + 4, SINGLE)))_
          * COS(D2R(MEMGET(mt, mt.OFFSET + var1 * mt.ELEMENTSIZE , SINGLE)))
    END IF
 
    'Sum Cumulative Coordinates
    TotalD = CoastD: VecAdd TotalD, ThrstD, 1
 
    'Update unit coordinates
    IF var2 = "T" THEN '                                        Permanent position change for MoveTurn
        'cmb(var1).ap.pX = cmb(var1).ap.pX + TotalDeltaX&&
        cmb(var1).ap.pX = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 52, INTEGER64) + TotalD.pX
        'cmb(var1).ap.pY = cmb(var1).ap.pY + TotalDeltaY&&
        cmb(var1).ap.pY = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 60, INTEGER64) + TotalD.pY
        'cmb(var1).ap.pZ = cmb(var1).ap.pZ + TotalDeltaZ&&
        cmb(var1).ap.pZ = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 68, INTEGER64) + TotalD.pZ
        Grav_Well var1
    ELSEIF var2 = "I" THEN '                                    Temporary data for InterVade
        'soltemp.pX = cmb(var1).ap.pX + TotalDeltaX&&
        soltemp.pX = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 52, INTEGER64) + TotalD.pX
        'soltemp.pY = cmb(var1).ap.pY + TotalDeltaY&&
        soltemp.pY = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 60, INTEGER64) + TotalD.pY
        'soltemp.pZ = cmb(var1).ap.pZ + TotalDeltaZ&&
        soltemp.pZ = MEMGET(ms, ms.OFFSET + var1 * ms.ELEMENTSIZE + 68, INTEGER64) + TotalD.pZ
    END IF
    MEMFREE ms: MEMFREE mt
    $CHECKING:ON
 
END SUB 'CoordUpdate
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB DelShip '
 
    DialogBox "You're about to delete " + RTRIM$(cmb(vpoint).Nam) + ". Continue?", 400, 200, 100, clr&(4), clr&(15)
    Con_Blok 450, 225, 120, 32, "Yes [enter]", 0, clr&(4)
    Con_Blok 630, 225, 120, 32, "No [Esc]", 0, clr&(4)
    DISPLAY
    Cancel_AI vpoint
 
    DO
        x$ = UCASE$(INKEY$)
        Mouse_Loop 0, 0
        mouse_left = MOUSEBUTTON(1)
        IF mouse_left THEN
            SELECT CASE mouse_y
                CASE 225 TO 257
                    SELECT CASE mouse_x
                        CASE 450 TO 570 '                       delete with mouseclick on "Yes"
                            dl% = -1
                        CASE 630 TO 750 '                       abort delete with mouseclick on "No"
                            EXIT SUB
                    END SELECT
            END SELECT
        END IF
        IF x$ = CHR$(13) THEN dl% = -1 '                        delete with ENTER
        IF x$ = CHR$(27) THEN EXIT SUB '                        abort delete with ESC keypress
    LOOP UNTIL dl%
    FOR p = vpoint TO units '                                   pancake the variables down on deleted unit
        IF p < units THEN
            cmb(p) = cmb(p + 1)
            Thrust(p) = Thrust(p + 1)
            Sensor(p, p) = Sensor(p + 1, p + 1)
            cmb(p).id = p
        ELSE '                                                  uppermost unit?
            FREEIMAGE ship_box(units) '                         free data box memory
            vpoint = vpoint - 1 '                               decrement the active counter avoiding subscript range fault
            IF vpoint < 1 THEN
                IF units >= 1 THEN
                    vpoint = 1
                ELSE
                    vpoint = 0
                END IF
            END IF
            EXIT FOR '                                          let redims handle the rest
        END IF
    NEXT p
    units = units - 1 '                                         decrement unit counter
    REDIM PRESERVE cmb(units) AS ship
    REDIM PRESERVE Thrust(units) AS Maneuver
    REDIM PRESERVE Sensor(units, units) AS BYTE
    Refresh
 
END SUB 'DelShip
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB DialogBox (heading AS STRING, xsiz AS INTEGER, ysiz AS INTEGER, ypos AS INTEGER, bcol AS UNSIGNED LONG, tcol AS UNSIGNED LONG)
 
    'superimpose a screen centered input box for various input routines
 
    'call syntax: DialogBox <heading string>, box x, box y, y position, bounding box color, text color
    T& = NEWIMAGE(xsiz, ysiz, 32) '                             define box
    DEST T&
    COLOR tcol, clr&(0) '                                       set text color with black background
    CLS
    FOR x = 0 TO 5 '                                            draw bounding box 3 pixels thick
        IF x < 2 THEN
            LINE (0 + x, 0 + x)-(WIDTH(T&) - 1 - x, HEIGHT(T&) - 1 - x), clr&(0), B
        ELSE
            LINE (0 + x, 0 + x)-(WIDTH(T&) - 1 - x, HEIGHT(T&) - 1 - x), bcol, B
        END IF
    NEXT x
    l = WIDTH(T&) / 2 - (LEN(heading) * 8) / 2 '                set heading position
    PRINTSTRING (l, 31), heading, T& '                          print heading
    PUTIMAGE (WIDTH(A&) / 2 - WIDTH(T&) / 2, ypos), T&, A& '    display box
    DEST A&
    FREEIMAGE T&
 
END SUB 'DialogBox
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB DispShipData
 
    '**************************************************************************************************
    FOR x = 1 TO units
        DEST ship_box(x)
        IF x = vpoint THEN '                                    Active white others aqua
            COLOR clr&(15), clr&(8)
        ELSE
            IF READBIT(Sensor(vpoint, x), 0) OR cmb(x).status = 0 THEN
                COLOR clr&(8), clr&(0)
            ELSE
                COLOR clr&(3), clr&(0)
            END IF
        END IF
        CLS
        PRINT cmb(x).id; " ";
        PRINT cmb(x).Nam;
 
        IF Pyth(cmb(vpoint).ap, cmb(x).ap) > 1500000000 THEN
            PRINT: PRINT "Contact Indistinct/ Extreme Range"
        ELSE
 
            IF READBIT(Sensor(vpoint, x), 0) THEN
                PRINT: PRINT "Sensor Occluded"
            ELSE
                IF cmb(x).status = 0 THEN '                         has unit been destroyed?
                    PRINT " destroyed";
                    IF x = vpoint THEN '                            was destroyed unit active?
                        ct% = 0
                        DO '                                        find next available unit to be active
                            vpoint = vpoint + 1
                            IF vpoint > units THEN vpoint = 1
                            IF cmb(vpoint).status > 0 THEN EXIT DO
                            ct% = ct% + 1
                        LOOP UNTIL ct% = units
                        IF ct% = units THEN '                       if all units destroyed center on primary
                            vpoint = 0
                        END IF
                    END IF
                    UDest x '                                       if destroyed set movement to zero
                END IF
                IF x = vpoint THEN '                                Active unit title line
                    PRINT "  active unit"
                ELSE
                    PRINT
                END IF
                PRINT "X:";: TruncCoord cmb(x).ap.pX: PRINT " "; '  Absolute coordinate position
                PRINT "Y:";: TruncCoord cmb(x).ap.pY: PRINT " ";
                PRINT "Z:";: TruncCoord cmb(x).ap.pZ: PRINT
                PRINT "Sp:";
                IF Thrust(x).Gs > cmb(x).MaxG THEN COLOR clr&(12) ' Red speed if overdrive  subscript out of range when loading new ships???
                PRINT INT((cmb(x).Sp / 1000) * 100) / 100; '        round to 100th km for display
                IF x = vpoint THEN '                                Return to original colors
                    COLOR clr&(15)
                ELSE
                    IF READBIT(Sensor(vpoint, x), 0) OR cmb(x).status = 0 THEN
                        COLOR clr&(8)
                    ELSE
                        COLOR clr&(3)
                    END IF
                END IF
                PRINT "kps Hdg:";
                PRINT USING "###.##"; cmb(x).Hd;
                PRINT " Z:"; USING "##.##"; cmb(x).In
                IF x <> vpoint THEN
                    d = Bearing(x)
                    IF collision THEN COLOR clr&(12)
                    PRINT "Brng:"; USING "###.#"; d;
                    LOCATE , 11: PRINT " "; "Z="; INT(Slope!(cmb(x).ap, cmb(vpoint).ap) * 100) / 100; "";
                    PRINT "Dist:";
                    IF Pyth(cmb(vpoint).ap, cmb(x).ap) < 10000000 THEN
                        PRINT USING "#######"; Pyth(cmb(vpoint).ap, cmb(x).ap);: PRINT "km"
                    ELSE
                        PRINT USING "###.###"; Pyth(cmb(vpoint).ap, cmb(x).ap) / KMtoAU;: PRINT "AU"
                    END IF
                    IF collision THEN COLOR clr&(3)
                    collision = NOT collision
                END IF
                IF cmb(x).status <> 0 THEN
                    IF x <> vpoint THEN
                        IF x = cmb(vpoint).bogey THEN
                            PUTIMAGE (0, 63), cancel&, ship_box(x)
                        ELSE
                            PUTIMAGE (0, 63), evade&, ship_box(x)
                            PUTIMAGE (49, 63), intercept&, ship_box(x)
                        END IF
                        IF READBIT(Sensor(vpoint, x), 1) THEN
                            COLOR clr&(12)
                            PRINTSTRING (3, 79), ">>Target Locked<<", ship_box(x)
                        ELSE
                            IF cmb(vpoint).mil THEN
                                b = 600000
                            ELSE
                                b = 150000
                            END IF
                            IF Pyth(cmb(vpoint).ap, cmb(x).ap) <= b THEN
                                PUTIMAGE (273, 63), TLoc, ship_box(x)
                            ELSE
                                PUTIMAGE (273, 63), TLocn, ship_box(x)
                            END IF
 
                        END IF
                    ELSE
                        PUTIMAGE (0, 63), flight&, ship_box(x)
                    END IF
                END IF
            END IF
 
        END IF
 
        LINE (0, 0)-(289, 95), clr&(4), B
    NEXT x
    '**************************************************************************************************
    c% = 0: g% = 0
    IF units >= 6 THEN '                                        if enough units to fill display area
        lp% = 6 '                                               then fill it
    ELSE
        lp% = units '                                           otherwise only use what you got
    END IF
    FOR y = 1 TO lp%
        g% = g% + 1
        IF units <= 6 THEN shipoff = 0
        PUTIMAGE (0, c%), ship_box(y + shipoff), A& '           invalid handle error thrown once
        c% = c% + 96
    NEXT y
    DEST A&
    COLOR clr&(15)
 
END SUB 'DispShipData
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB EditShip (var AS BYTE)
 
    IF var THEN
        u$ = "Editing new vessel"
    ELSE
        PanelBlank 280, 578, 64, 32, &HFF0F0F0F
        Con_Blok 280, 578, 64, 32, "Editing", 1, &H508C5B4C
        u$ = "Editing " + TRIM$(cmb(vpoint).Nam)
    END IF
 
    t% = 400: r% = 5
    DialogBox u$, t%, 250, 100, &HFF8C5B4C, clr&(15)
    in1$ = "Enter new value or press ENTER to default"
    l = WIDTH(A&) / 2 - (LEN(in1$) * 8) / 2
    PRINTSTRING (l, 320), in1$, A&
    DISPLAY
    col% = ((WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
    IF var = 0 THEN
        LOCATE 6 + r%, col%
        INPUT "new name:"; n$
        IF n$ <> "" THEN cmb(vpoint).Nam = n$
        LOCATE 7 + r%, col%
        INPUT "Max Gs:"; mg$
        IF mg$ <> "" THEN cmb(vpoint).MaxG = VAL(mg$)
        LOCATE 8 + r%, col%
        INPUT "X pos:"; xp$
        IF xp$ <> "" THEN cmb(vpoint).ap.pX = VAL(xp$)
        LOCATE 9 + r%, col%
        INPUT "Y pos:"; yp$
        IF yp$ <> "" THEN cmb(vpoint).ap.pY = VAL(yp$)
        LOCATE 10 + r%, col%
        INPUT "Z pos:"; zp$
        IF zp$ <> "" THEN cmb(vpoint).ap.pZ = VAL(zp$)
        LOCATE 11 + r%, col%
        INPUT "Speed (kps):"; sp$
        IF sp$ <> "" THEN cmb(vpoint).Sp = VAL(sp$) * 1000
        LOCATE 12 + r%, col%
        INPUT "Heading:"; hd$
        IF hd$ <> "" THEN cmb(vpoint).Hd = VAL(hd$)
        LOCATE 13 + r%, col%
        INPUT "Inclination:"; in$
        IF in$ <> "" THEN cmb(vpoint).In = VAL(in$)
        DO
            b = 0
            LOCATE 14 + r%, col%
            PRINT "                                         "
            LOCATE 14 + r%, col%
            INPUT "Scout/military sensors? y/n ", mil$
            SELECT CASE UCASE$(mil$)
                CASE IS = "Y"
                    cmb(vpoint).mil = -1: b = -1
                CASE IS = "N"
                    cmb(vpoint).mil = 0: b = -1
                CASE IS = ""
                    b = -1
                CASE ELSE
            END SELECT
        LOOP UNTIL b
    ELSE
        LOCATE 7 + r%, col%
        INPUT "Max Gs:"; mg$
        IF mg$ <> "" THEN cmb(vpoint).MaxG = VAL(mg$)
    END IF
 
END SUB 'EditShip
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB FCirc (CX AS INTEGER64, CY AS INTEGER64, RR AS INTEGER64, C AS UNSIGNED LONG)
    DIM R AS INTEGER64, RError AS INTEGER64
    DIM X AS INTEGER64, Y AS INTEGER64
 
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - X, CY)-(CX + X, CY), C, BF '                     draw equatorial line
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB 'FCirc
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION FindParent (var AS INTEGER)
 
    'Accepts a planetary body index (var) and finds the index of its parent body
 
    FOR x = 1 TO orbs
        IF hvns(var).parnt = hvns(x).nam THEN p = x
    NEXT x
    FindParent = p
 
END FUNCTION 'FindParent
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB FlightPlan
 
    'routine to choose planet- input box
    'DIM unitpoints for startpoint, midpoint and endpoint
    'FlightPlan to be called on vpoint each turn while bstat=3
    'check movement of end point and update, also update midpoint
    'acceleration until at or past updated midpoint, spread mathematically over remaining distance
    'deceleration after midpoint, spread mathematically over remaining distance.
 
    Coming
 
END SUB 'FlightPlan
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB GateKeeper
 
    SCREEN A&
    DEST A&
    COLOR , clr&(0)
    CLS
    PUTIMAGE (0, 0), strfld, A&
    Prnt TRIM$(ttl), 6, -6, 250, 100, 48, 0, &HFF5050A0
    Prnt "Classic Traveller starship maneuvers", 2, -2, 320, 200, 16, 0, &HFF505040
    COLOR clr&(7)
    PRINTSTRING (200, 250), "Ditch the compasses and protractors! CT-Vector will handle the starship maneuvers, and even do it in 3D.", A&
    PRINTSTRING (200, 270), "If you know a star system's name and path you may load it now, or press [enter] to default to Sol", A&
    DO
        T& = NEWIMAGE(950, 200, 32)
        DEST T&
        CLS
        FOR x = 0 TO 2
            LINE (0 + x, 0 + x)-(949 - x, 199 - x), &HFF5050A0, B
        NEXT x
        PUTIMAGE (150, 290), T&, A&
        DEST A&
        LOCATE 20, 25
        INPUT "Input {path/filename}.tss or [enter] to default to Sol :", sys$
        IF sys$ = "" THEN
            sys$ = "systems/Sol.tss"
        ELSE
            IF TRIM$(RIGHT$(sys$, 4)) = ".tss" THEN
                sys$ = TRIM$(sys$)
            ELSE
                sys$ = TRIM$(sys$) + ".tss"
            END IF
 
            IF MID$(sys$, 1, 7) = "systems/" THEN
            ELSE
                sys$ = "systems/" + TRIM$(sys$)
            END IF
        END IF
        IF FILEEXISTS(sys$) THEN
            'load file into hvns() array
            OPEN sys$ FOR RANDOM AS #1 LEN = LEN(hvns(0)) '     Open filename constructed above.
            orbs = LOF(1) / LEN(hvns(0))
            REDIM hvns(orbs) AS body
            FOR x = 1 TO orbs '                                 Load data array
                GET #1, x, hvns(x)
            NEXT x
            CLOSE #1
            LOCATE 22, 25: INPUT "Input year: ", yr
            LOCATE 23, 25: INPUT "Input day (0-365): ", dy
            IF dy = 0 THEN
                oryr = yr
            ELSE
                oryr = yr + (dy / 365)
            END IF
            FREEIMAGE T&
            EXIT DO
        ELSE
            LOCATE 22, 25: PRINT "File does not exist. Please check your path and file name."
            SLEEP 3
        END IF
    LOOP
    t$ = ttl + " " + sys$
    TITLE t$
    FREEIMAGE strfld
 
END SUB 'GateKeeper
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Grav_Well (var AS INTEGER)
 
    'Apply gravity perturbations of nearby massive bodies
    'Grav_Well call should probably go in CoordUpdate after AbsXYZ is set
 
    IF cmb(var).status > 0 THEN '                               if unit (var) is destroyed there's no point in doing this
        DIM grav AS Maneuver '                                  grav influence of every body in system
        DIM mdpnt AS unitpoint '                                midpoint of ship's vector
        DIM Ppnt AS unitpoint '                                 planetary gravity centers
        xdr! = 0: ydr! = 0: zdr! = 0
 
        'locate turn vector midpoint- now * 0.5, was / 2
        mdpnt.pX = cmb(var).op.pX + (cmb(var).ap.pX - cmb(var).op.pX) * 0.5
        mdpnt.pY = cmb(var).op.pY + (cmb(var).ap.pY - cmb(var).op.pY) * 0.5
        mdpnt.pZ = cmb(var).op.pZ + (cmb(var).ap.pZ - cmb(var).op.pZ) * 0.5
 
        'Iterate all bodies in system
        FOR O = 1 TO orbs
            IF hvns(O).star <> 2 THEN
                'find distance to massive body o from unit's vector mid point
                Ppnt = hvns(O).ps
                ds## = Pyth(Ppnt, mdpnt) '                          distance between bodies, use float variable
                IF ds## < hvns(O).radi THEN ds## = hvns(O).radi
 
                'compute gravitational force exerted upon unit at distance
                'multiply density by Earth volumes for G value then divide by square of distance
                'divide by 26687 setting one Earth mass to one G @ Earth radius
                radius## = hvns(O).radi '                           convert radii to float variable
                grav.Gs = ((hvns(O).dens * ((4 / 3) * PI * (radius## * radius## * radius##))) / 26687) / (ds## * ds##)
 
                'get relative offset positions of ship vector midpoint to gravity well source to obtain source of G force vector
                DIM Pull AS unitpoint
                Pull = hvns(O).ps: VecAdd Pull, mdpnt, -1
 
                grav.Azi = Azimuth!(Pull.pX, Pull.pY) '             Azimuth bearing of perturbation
                grav.Inc = Slope!(Ppnt, mdpnt) '                    Declination of perturbation
 
                'add vector to a vector tally
                zgrav! = (grav.Gs * 10000) * SIN(D2R(grav.Inc))
                xgrav! = (grav.Gs * 10000) * COS(D2R(grav.Inc)) * SIN(D2R(grav.Azi))
                ygrav! = (grav.Gs * 10000) * COS(D2R(grav.Inc)) * COS(D2R(grav.Azi))
                xdr! = xdr! + xgrav!
                ydr! = ydr! + ygrav!
                zdr! = zdr! + zgrav!
            END IF
        NEXT O
 
        'apply the combined vector to unit
        cmb(var).ap.pX = cmb(var).ap.pX + ROUND(xdr!)
        cmb(var).ap.pY = cmb(var).ap.pY + ROUND(ydr!)
        cmb(var).ap.pZ = cmb(var).ap.pZ + ROUND(zdr!)
 
        'temporary for watch variable of active unit- need to exprapolate out the Maneuver data
        IF var = vpoint THEN
            'find the distance of xdr!, ydr! & zdr!
            DIM xu AS unitpoint
            xu.pX = xdr!: xu.pY = ydr!: xu.pZ = zdr!
            Gwat.Gs = HYPOT(HYPOT(xdr!, ydr!), zdr!) / 10000
            Gwat.Azi = Azimuth!(xdr!, ydr!)
            Gwat.Inc = Slope!(xu, cmb(var).ap)
        END IF
 
    END IF
 
END SUB 'Grav_Well
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB IncMeter (var AS BYTE, vecin AS BYTE)
 
    'togs bit 5= inclinometer display
 
    IF var AND NOT READBIT(togs, 1) THEN '                      true and not z-pan
        'Display inclinometer scale
        c& = RGBA32(127, 127, 127, 127)
        COLOR c&
        IF vecin THEN
            a = 0: b = 180: c = -90: d = -1
        ELSE
            SELECT CASE cmb(vpoint).Hd
                CASE 0 TO 180
                    a = 0: b = 180: c = -90: d = -1
                CASE IS > 180
                    a = 180: b = 360: c = -270: d = 1
            END SELECT
        END IF
        FOR whl = a TO b
            IF whl MOD 45 = 0 THEN
                y = 800
                Prnt STR$((whl + c) * d), 2.8, 2.8, ((y + 20) * SIN(D2R(whl))) - 60, (y + 20) * COS(D2R(whl)), 24, 0, c&
            ELSEIF whl MOD 10 = 0 THEN
                y = 850
            ELSEIF whl MOD 5 = 0 THEN
                y = 870
            ELSE
                y = 890
            END IF
            LINE (900 * SIN(D2R(whl)), 900 * COS(D2R(whl)))-(y * SIN(D2R(whl)), y * COS(D2R(whl))), c&
        NEXT whl
 
        'Display unit inclination arrow
        IF cmb(vpoint).In >= 0 THEN '                           Moving with or toward the zenith of the plane
            IF cmb(vpoint).Hd <= 180 THEN '                     right side
                zdeg! = ABS(cmb(vpoint).In - 90)
            ELSE '                                              left side
                zdeg! = ABS(270 - NOT SGN(d) * cmb(vpoint).In)
            END IF
        ELSE '                                                  Moving toward the nadir of the plane
            IF cmb(vpoint).Hd > 180 THEN '                      left side
                zdeg! = ABS(270 - NOT SGN(d) * cmb(vpoint).In)
            ELSE '                                              right side
                zdeg! = ABS(cmb(vpoint).In - 90)
            END IF
        END IF
        LINE (850 * SIN(D2R(zdeg! - 1)), 850 * COS(D2R(zdeg! - 1)))-(900 * SIN(D2R(zdeg!)), 900 * COS(D2R(zdeg!))), RGBA32(127, 127, 127, 200)
        LINE (900 * SIN(D2R(zdeg!)), 900 * COS(D2R(zdeg!)))-(850 * SIN(D2R(zdeg! + 1)), 850 * COS(D2R(zdeg! + 1))), RGBA32(127, 127, 127, 200)
 
    END IF
 
END SUB 'IncMeter
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB InterVadeII (tar AS INTEGER, sol AS INTEGER, mode AS INTEGER)
 
    '"The others are as archaic as dinosaurs compared to InterVadeII, a whole new approach..."
    '-Dr. Richard Daystrom ;)
    'and this one's turning out just about as well...
 
    ' Conduct evade/intercept calculations
    ' tar = target unit: tar is also carried in cmb(sol).bogey
    ' sol is solution unit, i.e. unit executing the nav solution
    ' mode is mode of call 0 from MoveTurn or 1+ from MouseOps
    '       MoveTurn mode (0) automatically applies computed maneuvers
    '       MouseOps mode queries user to accept solution upon initiation
    '           mode is now carried in cmb(sol).bstat for automation
    '               1=evade
    '               2=intercept
    'typical syntax: InterVadeII cmb(x).bogey, cmb(x).id, [0 - 2]
    'we can later expand mode mode to include flightplan maneuvers
    'using .bogey to hold planet index.
 
    'We cannot know the future, so we must use the past as the basis of calculation
    DIM origin AS unitpoint '                                   used as 0,0,0 base for Pyth distance calculations
    DIM tarpos AS unitpoint '                                   target unit position
    DIM solpos AS unitpoint '                                   solution unit position
    DIM tarmov AS unitpoint '                                   last target movement vector
    DIM solmov AS unitpoint '                                   last solution movement vector
    DIM tarfut AS unitpoint '                                   projected future target position
    DIM solfut AS unitpoint '                                   projected future solution position
    DIM difmov AS unitpoint '
    DIM clsmov AS unitpoint '
    origin.pX = 0: origin.pY = 0: origin.pZ = 0
    tarpos = cmb(tar).ap: solpos = cmb(sol).ap
    tarmov = cmb(tar).ap: VecAdd tarmov, cmb(tar).op, -1 '  compute last target movement vector (target velocity)
    solmov = cmb(sol).ap: VecAdd solmov, cmb(sol).op, -1 '  compute last solution movement vector (solution velocity)
    tarfut = tarpos: VecAdd tarfut, tarmov, 1 '             compute projected future target position
    solfut = solpos: VecAdd solfut, solmov, 1 '             compute projected future solution position   Do we need this? the whole point is to change it
 
    SELECT CASE mode '                                          is unit evading or intercepting?
        '_____________________________________________________________________________________________________________________________EVADE
        CASE IS = 1 'TO EVADE
            'what movement vector (solmov) maximizes distance between tarfut and solfut
            'take a break from intercept
 
            '_________________________________________________________________________________________________________________________INTERCEPT
        CASE IS = 2 'TO INTERCEPT will move to intercept, but need timely braking thrust
            'need a match vector AND a close vector to intercept, subject to maxG of solution unit
            DIM uclsmov AS unitpoint
            DIM usolmov AS unitpoint
 
            clsmov = tarfut: VecAdd clsmov, solfut, -1 'now clsmov has the cartesian vector to close range with the target this turn
            difmov = solmov: VecAdd difmov, tarmov, -1 'now difmov has the cartesian vector that adjusts to the target movement this turn
            VecAdd clsmov, difmov, 1 'combine the two ...and this is the vector to close with target's future position
 
            uclsmov = clsmov: VecNorm uclsmov
            usolmov = solmov: VecNorm usolmov
            dotP&& = uclsmov.pX * usolmov.pX + uclsmov.pY * usolmov.pY + uclsmov.pZ * usolmov.pZ '<<<<DOT PRODUCT equation if needed
            'dotP&& = clsmov.pX * solmov.pX + clsmov.pY * solmov.pY + clsmov.pZ * solmov.pZ '<<<<DOT PRODUCT equation if needed
            IF dotP&& > 0.8 THEN
                T2m## = Pyth(origin, difmov) / (cmb(sol).MaxG * 10000) 'turns to match target speed
                T2c## = Pyth(origin, clsmov) / (cmb(sol).MaxG * 10000)
                d2m## = Pyth(origin, clsmov) '                      distance between future points (kms)
                vav## = (Pyth(origin, solmov) + Pyth(origin, tarmov)) / 2
                IF d2m## / vav## <= T2m## + 1 THEN
                    l% = -1
                ELSE
                    l% = 1
                END IF
            ELSE
                l% = 1
            END IF
            'apply results to Thrust of solution unit
            Thrust(sol).Azi = Azimuth!(clsmov.pX * l%, clsmov.pY * l%)
            Thrust(sol).Inc = Slope!(tarfut, solfut) * l%
            IF Pyth(solfut, tarfut) < cmb(sol).MaxG * 10000 THEN
                Thrust(sol).Gs = Pyth(solfut, tarfut) / 10000
            ELSE
                Thrust(sol).Gs = cmb(sol).MaxG
            END IF
    END SELECT
 
    'dotP&& = tarmov.pX * solmov.pX + tarmov.pY * solmov.pY + tarmov.pZ * solmov.pZ '<<<<DOT PRODUCT equation if needed
    's = (v * t) - (.5 * a * t ^ 2) 'where
    'Deceleration = v^2 - u^2 / 2s 'Where, v = The Final Velocity  u = The Initial Velocity  s = Distance
    'Time[s] = 2 * ((Distance[m] / Acceleration[m/s^2])^.5)
    'Distance[m] = Acceleration[m/s^2] * Time[s]^2 / 4
    'Acceleration[m/s^2] = 4 * Distance[m] / Time[s]^2
    'Deceleration Distance[m] = Acceleration[m/s^2] * Time[sec]^2 / 2
 
 
END SUB 'InterVadeII
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Load_System
 
    'Load star system file
    'call syntax: DialogBox <heading string>, box x, box y, y position, bounding box color, text color
    DialogBox "LOAD NEW STAR SYSTEM", 400, 250, 50, &HFF2C9B2C, clr&(15)
    in1$ = "Enter path and filename of system"
    l = WIDTH(A&) / 2 - (LEN(in1$) * 8) / 2
    PRINTSTRING (l, 113), in1$, A&
    DISPLAY
    LOCATE 10, 57
    INPUT "systems\+ :", fn$
    IF RIGHT$(fn$, 4) <> ".tss" THEN
        fn$ = "systems\" + fn$ + ".tss"
    ELSE
        fn$ = "systems\" + fn$
    END IF
    IF FILEEXISTS(fn$) THEN
        ERASE hvns
        OPEN fn$ FOR RANDOM AS #1 LEN = LEN(hvns(0))
        orbs = LOF(1) / LEN(hvns(0))
        REDIM hvns(orbs) AS body
        Turncount = 0
        FOR x = 1 TO orbs
            GET #1, x, hvns(x)
        NEXT x
        CLOSE #1
        PlanetMove 1 '                                          planets to date positions
    ELSE
        LOCATE 12, 57
        PRINT "File not found, check path and name."
        _DISPLAY
        SLEEP 3
    END IF
 
END SUB 'Load_System
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Load_Ships
 
    DialogBox "LOAD NEW VESSEL GROUP", 400, 250, 50, &HFF2C9B2C, clr&(15)
    in1$ = "Enter filename of ships"
    l = WIDTH(A&) / 2 - (LEN(in1$) * 8) / 2
    PRINTSTRING (l, 113), in1$, A&
    DISPLAY
    LOCATE 10, 57
    INPUT "ships/+ :", fn$
    IF RIGHT$(fn$, 4) <> ".tvg" THEN
        fn$ = "ships/" + fn$ + ".tvg"
    ELSE
        fn$ = "ships/" + fn$
    END IF
    IF FILEEXISTS(fn$) THEN
        ERASE cmb
        FOR x = 1 TO units '                                    erase old ship data displays
            FREEIMAGE ship_box(x)
        NEXT x
        OPEN fn$ FOR RANDOM AS #1 LEN = LEN(cmb(0))
        units = LOF(1) / LEN(cmb(0))
        REDIM cmb(units) AS ship
        REDIM Sensor(units, units)
        REDIM Thrust(units) AS Maneuver
        REDIM ship_box(units)
        FOR x = 1 TO units
            ship_box(x) = NEWIMAGE(290, 96, 32)
        NEXT x
        Turncount = 0: vpoint = 1: shipoff = 0
        FOR x = 1 TO units
            GET #1, x, cmb(x)
        NEXT x
        CLOSE #1
        FOR x = 1 TO units '                                    nested loop to avoid planet/star collisions here
            FOR y = 1 TO orbs
                IF Pyth(cmb(x).ap, hvns(y).ps) < hvns(p).radi THEN 'inside a body's radius? then move it
                    DO '                                        loop to accomodate large stars/GGs
                        cmb(x).ap.pX = cmb(x).ap.pX + 100000 '  Move ship 100K coreward and trailing
                        cmb(x).ap.pY = cmb(x).ap.pY + 100000
                    LOOP UNTIL Pyth(cmb(x).ap, hvns(y).ps) > hvns(p).radi 'stop once the unit's clear
                END IF
            NEXT y
        NEXT x
        VCS
    ELSE
        LOCATE 12, 57
        PRINT "File not found, check path and name."
        SLEEP 3
    END IF
 
END SUB 'Load_Ships
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Load_Scenario
 
    t% = 400: r% = 2
    DialogBox "LOAD SCENARIO", t%, 250, 50, &HFF8C5B4C, clr&(15)
    DISPLAY
    LOCATE r% + 5, ((WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
    INPUT "Enter a scenario name: ", fl$
    IF TRIM$(fl$) = "auto" THEN fl$ = "autosave/auto"
    LOCATE r% + 7, ((WIDTH(A&) / 2) - 40) / 8
    vl$ = "scenarios\" + TRIM$(fl$) + ".tvg" '                  Vessel group #2
    pl$ = "scenarios\" + TRIM$(fl$) + ".tss" '                  Planets #1
    sl$ = "scenarios\" + TRIM$(fl$) + ".tgn" '                  saved state #4
    tl$ = "scenarios\" + TRIM$(fl$) + ".tvt" '                  Thrust keeper (.tvt) #3
    tt$ = "scenarios\" + TRIM$(fl$) + ".ttl" '                  Sensor state keeper #5
    IF FILEEXISTS(vl$) AND FILEEXISTS(pl$) THEN
        ERASE hvns, cmb, Thrust, Sensor '                       reset environment/ remove TLock
        OPEN pl$ FOR RANDOM AS #1 LEN = LEN(hvns(0)) '          Load new planetary system
        orbs = LOF(1) / LEN(hvns(0))
        REDIM hvns(orbs) AS body
        FOR x = 1 TO orbs
            GET #1, x, hvns(x)
        NEXT x
        CLOSE #1
        OPEN vl$ FOR RANDOM AS #2 LEN = LEN(cmb(0))
        units = LOF(2) / LEN(cmb(0))
        REDIM cmb(units) AS ship
        FOR x = 1 TO units
            GET #2, x, cmb(x)
        NEXT x
        CLOSE #2
        IF FILEEXISTS(tl$) THEN '                              important but not fatal if missing
            OPEN tl$ FOR RANDOM AS #3 LEN = LEN(Thrust(0))
            REDIM Thrust(units) AS Maneuver
            FOR x = 1 TO units
                GET #3, x, Thrust(x)
            NEXT x
            CLOSE #3
        ELSE
            REDIM Thrust(units) AS Maneuver
        END IF
        IF FILEEXISTS(sl$) THEN '
            OPEN sl$ FOR INPUT AS #4
            INPUT #4, Turncount, oryr, vpoint, shipoff
            CLOSE #4
        END IF
        IF FILEEXISTS(tt$) THEN '                               remove entire file structure TLock subsumed by Sensor
            OPEN tt$ FOR RANDOM AS #5 LEN = LEN(Sensor(0, 0))
            REDIM Sensor(units, units) AS BYTE
            FOR x = 1 TO units
                FOR y = 1 TO units
                    GET #5, ((x - 1) * units) + y, Sensor(x, y)
                NEXT y
            NEXT x
            CLOSE #5
        ELSE
            REDIM Sensor(units, units) AS BYTE
        END IF
        Turn2Clock Turncount
        Refresh
    ELSE
        'essential file(s) are not present, abort
        LOCATE r% + 9, ((WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
        PRINT "Essential files missing, check filename."
        SLEEP 3
    END IF
 
END SUB 'Load_Scenario
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Make_Buttons
 
    DEST flight& '                                             Create flightplan button
    CLS
    COLOR , RGBA32(22, 166, 211, 255)
    PRINTSTRING (0, 0), "FLIGHTPLAN", flight&
 
    DEST evade& '                                              Create evade button
    CLS
    COLOR , RGBA32(244, 11, 17, 255)
    PRINTSTRING (0, 0), "EVADE", evade&
 
    DEST intercept& '                                          Create intercept button
    CLS
    COLOR , RGBA32(17, 139, 17, 255)
    PRINTSTRING (0, 0), "INTERCEPT", intercept&
 
    DEST cancel& '                                             Create cancel button
    CLS
    COLOR , RGBA32(67, 67, 150, 255)
    PRINTSTRING (0, 0), "CANCEL", cancel&
 
    DEST XZ& ' 64x32                                           Create Zoom extents control
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(62, 30), clr&(4), B
    PRINTSTRING (8, 8), "Zoom", XZ&
    COLOR clr&(4)
    PRINTSTRING (48, 8), "X", XZ&
 
    DEST IZ& ' 64x32                                           Create Zoom in control
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(62, 30), clr&(4), B
    PRINTSTRING (8, 8), "Zoom", IZ&
    COLOR clr&(4)
    PRINTSTRING (48, 8), "+", IZ&
 
    DEST OZ& ' 64x32                                           Create Zoom out control
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(62, 30), clr&(4), B
    PRINTSTRING (8, 8), "Zoom", OZ&
    COLOR clr&(4)
    PRINTSTRING (48, 8), "-", OZ&
 
    DEST RG& ' 56x32                                           Create Range band toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(54, 30), clr&(4), B
    c& = RGBA(252, 252, 84, 100)
    FCirc 28, 16, 20, RGBA(252, 252, 84, 100)
    c& = RGBA(252, 84, 84, 100)
    FCirc 28, 16, 12, RGBA(0, 0, 0, 0)
    FCirc 28, 16, 12, RGBA(252, 84, 84, 200)
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "R", RG&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "ange", RG&
 
    DEST OB& ' 56x32                                           Create Orbit track toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(54, 30), clr&(4), B
    CIRCLE (-15, -5), 58, clr&(1)
    CIRCLE (40, 15), 10, clr&(1)
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "O", OB&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "rbit", OB&
 
    DEST GD& ' 48x32                                           Create Grid toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(46, 30), clr&(4), B
    FOR h = 8 TO 48 STEP 8
        LINE (0, h)-(47, h), clr&(8), BF
        LINE (h, 0)-(h, 31), clr&(8), BF
    NEXT h
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "G", GD&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "rid", GD&
 
    DEST AZ& ' 40x32                                           Create Azimuth toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(38, 30), clr&(4), B
    FOR whl = 0 TO 3375 STEP 225
        outerx = (14 * SIN(D2R(whl / 10))) + 20
        outery = (14 * COS(D2R(whl / 10))) + 16
        innerx = (12 * SIN(D2R(whl / 10))) + 20
        innery = (12 * COS(D2R(whl / 10))) + 16
        LINE (outerx, outery)-(innerx, innery), clr&(5) '  draw tick
    NEXT whl
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "A", AZ&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "zi", AZ&
 
    DEST IN& ' 40x32                                           Create Inclinometer toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(38, 30), clr&(4), B
    FOR whl = 0 TO 1800 STEP 225
        outerx = (14 * SIN(D2R(whl / 10))) + 20
        outery = (14 * COS(D2R(whl / 10))) + 16
        innerx = (12 * SIN(D2R(whl / 10))) + 20
        innery = (12 * COS(D2R(whl / 10))) + 16
        LINE (outerx, outery)-(innerx, innery), clr&(8) '  draw tick
    NEXT whl
    LINE (20, 16)-((14 * SIN(D2R(135))) + 20, (14 * COS(D2R(135))) + 16), clr&(8)
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "I", IN&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "nc", IN&
 
    DEST JP& ' 48x32                                           Create Jump envelope toggle
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(46, 30), clr&(4), B
    FCirc 24, 16, 12, RGBA(150, 116, 116, 200)
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "J", JP&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "ump", JP&
 
    DEST DI& ' 48x32                                           Create Jump Diameter button
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(46, 30), clr&(4), B
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "D", DI&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "iam.", DI&
 
    DEST DN& ' 48x32                                           Create Jump Density button
    COLOR clr&(0), RGBA32(72, 128, 222, 255)
    CLS
    LINE (1, 1)-(46, 30), clr&(4), B
    'density graphic
    PRINTMODE KEEPBACKGROUND
    COLOR clr&(4)
    PRINTSTRING (8, 8), "D", DN&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "ens.", DN&
 
    DEST QT& ' 48x32                                           Create Quit (program) button
    COLOR clr&(0), RGBA32(255, 0, 50, 255)
    CLS
    LINE (1, 1)-(46, 30), clr&(0), B
    COLOR clr&(11)
    PRINTSTRING (8, 8), "Q", QT&
    COLOR clr&(0)
    PRINTSTRING (16, 8), "uit", QT&
 
END SUB 'Make_Buttons
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Make_Images
 
    'Azimuth wheel image
    DEST AW&
    WINDOW (-1000, 1000)-(1000, -1000)
    SCREEN AW&
    CLEARCOLOR RGB(0, 0, 0)
    CLS
    FOR whl = 0 TO 359 '                                    iterate through azimuth wheel
        IF whl MOD 45 = 0 THEN '                            45 degree tick and number
            y = 900
            Prnt STR$(whl), 2.8, 2.8, (y + 20) * SIN(D2R(whl)) - 60, (y + 20) * COS(D2R(whl)), 24, 0, &H7FA800A8
        ELSEIF whl MOD 10 = 0 THEN '                        10 degree tick
            y = 950
        ELSEIF whl MOD 5 = 0 THEN '                         5 degree tick
            y = 970
        ELSE '                                              1 degree tick
            y = 990
        END IF
        'Draw azimuth tick
        LINE (1000 * SIN(D2R(whl)), 1000 * COS(D2R(whl)))-(y * SIN(D2R(whl)), y * COS(D2R(whl))), &H7FA800A8
    NEXT whl
 
END SUB 'Make_Images
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB MainLoop
 
    STATIC in AS BYTE
    Refresh '                                                   initial display refresh
    DO '                                                        outer loop running computations when inputs
        DO '                                                    inner loop waiting for inputs while no change
            IF units <= 6 THEN
                shipoff = 0: of%% = 0
            ELSE
                of%% = -1
            END IF
            x$ = INKEY$
            IF x$ <> "" THEN in = -1
            Mouse_Loop of%%, units
 
            mouse_left = MOUSEBUTTON(1)
            mouse_right = MOUSEBUTTON(2)
            IF mouse_left = -1 THEN
                DELAY .2
                Mouse_Ops mouse_x, mouse_y
                in = -1
            END IF
            IF mouse_right = -1 THEN
                DELAY .2
                Place_Ship mouse_x, mouse_y
                ZoomFac = 1
                in = -1
            END IF
            IF x$ = CHR$(66) OR x$ = CHR$(98) THEN togs = TOGGLEBIT(togs, 10) '     "B" belt/ring
            IF x$ = CHR$(82) OR x$ = CHR$(114) THEN togs = TOGGLEBIT(togs, 4) '
            IF x$ = CHR$(65) OR x$ = CHR$(97) THEN togs = TOGGLEBIT(togs, 2) '
            IF x$ = CHR$(71) OR x$ = CHR$(103) THEN togs = TOGGLEBIT(togs, 3) '
            IF x$ = CHR$(73) OR x$ = CHR$(105) THEN togs = TOGGLEBIT(togs, 5) '
            IF x$ = CHR$(74) OR x$ = CHR$(106) THEN togs = TOGGLEBIT(togs, 6) '
            IF x$ = CHR$(79) OR x$ = CHR$(111) THEN togs = TOGGLEBIT(togs, 7) '
            IF x$ = CHR$(68) OR x$ = CHR$(100) THEN togs = TOGGLEBIT(togs, 9) '
            IF x$ = CHR$(90) OR x$ = CHR$(122) THEN togs = TOGGLEBIT(togs, 8) '
            IF x$ = CHR$(51) THEN '                                                 2D/3D toggle
                togs = TOGGLEBIT(togs, 1)
                IF READBIT(togs, 1) THEN
                    zangle = Ozang
                ELSE
                    Ozang = zangle: zangle = 0
                END IF
            END IF
            IF x$ = CHR$(86) OR x$ = CHR$(118) THEN NewVector '
            IF x$ = CHR$(84) OR x$ = CHR$(116) THEN MoveTurn 0 '
            IF x$ = CHR$(85) OR x$ = CHR$(117) THEN MTurnUndo 0 '
            IF x$ = CHR$(69) OR x$ = CHR$(101) THEN EditShip 0 '
            IF x$ = CHR$(70) OR x$ = CHR$(102) THEN FlightPlan '
            IF x$ = CHR$(72) OR x$ = CHR$(104) THEN Help
            IF x$ = CHR$(88) OR x$ = CHR$(120) THEN ZoomFac = 1 '
            IF x$ = CHR$(43) THEN ZoomFac = ZoomFac / .5 '
            IF x$ = CHR$(45) THEN ZoomFac = ZoomFac * .5 '
            IF x$ = CHR$(81) OR x$ = CHR$(113) THEN
                TIMER(t1%) OFF: Save_Scenario 0: EXIT SUB '
            END IF
            IF x$ = CHR$(0) + CHR$(82) THEN AddShip
            IF x$ = CHR$(0) + CHR$(83) THEN DelShip '
            IF x$ = CHR$(0) + CHR$(80) THEN '                           down arrow  20480
                vpoint = vpoint + 1
                IF vpoint > units THEN vpoint = 1: shipoff = 0
                IF units > 6 AND vpoint > 6 THEN shipoff = vpoint - 6
                DO
                    IF cmb(vpoint).status = 0 THEN vpoint = vpoint + 1
                    IF vpoint > units THEN vpoint = 1
                LOOP UNTIL cmb(vpoint).status > 0
            END IF
            IF x$ = CHR$(0) + CHR$(72) THEN '                           up arrow  18432
                vpoint = vpoint - 1
                IF vpoint < 1 THEN vpoint = units: shipoff = units - 6
                IF units > 6 AND vpoint <= shipoff THEN shipoff = vpoint - 1
                DO
                    IF cmb(vpoint).status = 0 THEN vpoint = vpoint - 1
                    IF vpoint < 1 THEN vpoint = units
                LOOP UNTIL cmb(vpoint).status > 0
            END IF
            KEYCLEAR
            OriScreen vpoint '                                  keep up with ori-screen animation while waiting
            DispShipData '                                      update ship data display via mouse wheel while waiting
            DISPLAY
            LIMIT 50
        LOOP UNTIL in
        in = 0
        Refresh
        LIMIT 50
    LOOP
 
END SUB 'MainLoop
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Mouse_Loop (var AS INTEGER, var2 AS INTEGER)
 
    '-------------------------ALGORITHM--------------------------------------------------CLEARED
    ' SUB: Mouse_Loop
    '
    ' Purpose:
    ' Primary mouse input loop. Controls mousewheel scrolling and conditions
    ' x,y position data.
    '
    ' Passed Variables:
    ' var sends whether data list is extensive enough for using offset printing values
    ' var2 sends maximum allowed offset value
    '
    '------------------------------------------------------------------------------------
 
    DO WHILE MOUSEINPUT '                                      scan for changes in mouse position and save to global variables
        IF var = -1 THEN
            shipoff = shipoff + MOUSEWHEEL '                   mousewheel offset determines starting element to print
            IF shipoff < 0 THEN shipoff = 0 '                   don't go beyond bottom of array
            IF shipoff + 6 > var2 THEN shipoff = var2 - 6 '     don't go beyond the end of the array
        END IF
        IF MOUSEBUTTON(1) OR MOUSEBUTTON(2) THEN
            mouse_y = MOUSEY '                                 get y on mouse click
            mouse_x = MOUSEX '                                 get x on mouse click
        END IF
    LOOP
 
END SUB 'Mouse_Loop
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Mouse_Ops (xpos AS INTEGER, ypos AS INTEGER)
    SELECT CASE xpos
        CASE 0 TO 559 '                                         Left text display
            DELAY .2
            SELECT CASE ypos '                                  Divide left into top and bottom
                CASE 0 TO 575
                    SELECT CASE xpos '                          Divide upper left into ship and center display
                        CASE 0 TO 287
                            'ship data display
                            y = INT(ypos / 96) + 1 '            unit # range - modify by shipoff for proper unit
                            IF y > units THEN y = units
                            y1 = INT(ypos / 16) + 1 '           row # of mouse click
                            IF y + shipoff <> vpoint AND y1 MOD 6 = 5 THEN 'not vpoint and 5th line of unit data
                                IF xpos < 121 THEN
                                    IF y + shipoff = cmb(vpoint).bogey THEN ' Cancel was clicked
                                        IF xpos < 48 THEN
                                            cmb(vpoint).bogey = 0 ' unit no longer a solution target
                                            cmb(vpoint).bstat = 0
                                        END IF
                                    ELSE
                                        IF cmb(vpoint).bogey = 0 THEN
                                            cmb(vpoint).bogey = y + shipoff
                                            SELECT CASE xpos
                                                CASE 0 TO 39 '      Evade
                                                    cmb(vpoint).bstat = 1
                                                CASE 49 TO 120 '    Intercept
                                                    cmb(vpoint).bstat = 2
                                            END SELECT
                                            InterVadeII y + shipoff, vpoint, cmb(vpoint).bstat 'then evade/intercept call
                                        END IF
                                    END IF
                                ELSEIF xpos > 272 THEN
                                    IF cmb(vpoint).mil THEN
                                        b = 600000 '            military sensor range
                                    ELSE
                                        b = 150000 '            civilian sensor range
                                    END IF
                                    IF Pyth(cmb(vpoint).ap, cmb(y + shipoff).ap) < b THEN
                                        Sensor(vpoint, y + shipoff) = SETBIT(Sensor(vpoint, y + shipoff), 1)
                                    END IF
                                ELSE
                                    vpoint = y + shipoff
                                END IF
                            ELSEIF y + shipoff = vpoint AND y1 MOD 6 = 5 THEN
                                IF xpos < 80 THEN
                                    FlightPlan
                                END IF
                            ELSE
                                vpoint = y + shipoff '          otherwise set new vpoint
                            END IF
                        CASE 288 TO 559
                            'center display
                            SELECT CASE ypos
                                CASE 0 TO 324
                                    'Upper center screen area
                                CASE 325 TO 573
                                    'OriScreen area
                            END SELECT
                    END SELECT
                CASE 576 TO 608
                    ' buttons tier 1
                    SELECT CASE xpos
                        CASE 0 TO 63
                            NewVector2
                        CASE 70 TO 133
                            Coming 'VectorBrake
                        CASE 140 TO 203
                            MoveTurn 1
                        CASE 210 TO 273
                            MTurnUndo 1
                        CASE 280 TO 343
                            EditShip 0
                        CASE 350 TO 413
                            DelShip
                        CASE 420 TO 483
                            Load_Scenario
                        CASE 490 TO 553
                            TIMER(t1%) OFF
                            Save_Scenario -1
                            TIMER(t1%) ON
                    END SELECT
                    ' buttons tier 2
                CASE 614 TO 646
                    SELECT CASE xpos
                        CASE 0 TO 63
                            PanelBlank 0, 614, 64, 32, &HFF0F0F0F
                            Con_Blok 0, 614, 64, 32, "Thrust 0", 0, &H502C9B2C
                            DISPLAY
                            DELAY .5
                            Thrust(vpoint).Gs = 0
                        CASE 70 TO 133
                            Coming
                        CASE 140 TO 203
                            Coming
                        CASE 210 TO 273
                            Coming
                        CASE 280 TO 343
                            AddShip
                        CASE 350 TO 413
                            Purge
                        CASE 420 TO 483
                            Load_System
                        CASE 490 TO 553
                            Save_System
                    END SELECT
                    ' buttons tier 3
                CASE 650 TO 682
                    SELECT CASE xpos
                        CASE 0 TO 63
                            VectorBrake 'Coming
                        CASE 70 TO 133
                            Coming
                        CASE 140 TO 203
                            Coming
                        CASE 210 TO 273
                            Coming
                        CASE 280 TO 343
                            Help
                        CASE 350 TO 413
                            IF cmb(vpoint).status = 3 THEN
                                cmb(vpoint).status = 1
                                EditShip 1
                            ELSE
                                Thrust(vpoint).Gs = 0
                                cmb(vpoint).MaxG = 0
                                cmb(vpoint).status = 3
                            END IF
                        CASE 420 TO 483
                            Load_Ships
                        CASE 490 TO 553
                            Save_Ships
                    END SELECT
            END SELECT
        CASE 560 TO 1179 '                                      Right graphics screen
            'DELAY .2
            SELECT CASE ypos
                CASE 19 TO 639
                    ' find relative sensor screen coordinates of mouse click
                    WindowMouseX = (xpos - 560) * (2000 / 620) - 1000 '      xpos was mouse_x
                    WindowMouseY = ((ypos - 18) * (2000 / 620) - 1000) * -1 'ypos was mouse_y
                    ' check to see if click is close to any combat units
                    q! = Prop!
                    DIM clk AS unitpoint
                    clk.pX = WindowMouseX / q! '                get screen click x position
                    clk.pY = WindowMouseY * SIN(_D2R(zangle)) / q! 'get screen click y position
                    prox = vpoint
                    FOR a = 1 TO units
 
                        IF a <> vpoint THEN '                   if not active unit
                            IF PythXY(clk, dcs(a)) < PythXY(clk, dcs(vpoint)) THEN 'if closer to 'a' then active
                                IF PythXY(clk, dcs(a)) < PythXY(clk, dcs(prox)) THEN 'if closer to 'a' then any other 'a' tested
                                    prox = a '                  set proximity unit
                                END IF
                            END IF
                        END IF
 
                        'IF a <> vpoint THEN '                   if not active unit
                        '    IF PythXY(clk, dcs(a)) < PythXY(clk, dcs(vpoint)) THEN 'if closer to 'a' then active
                        '        prox = a
                        '        FOR b = 1 TO units
                        '            IF PythXY(clk, dcs(b)) < PythXY(clk, dcs(prox)) THEN 'if closer to 'a' then any other 'a' tested
                        '                prox = b '                  set proximity unit
                        '            END IF
                        '        NEXT b
                        '    END IF
                        'END IF
 
                    NEXT a
                    vpoint = prox '                             set active to closest proximity unit
 
 
                CASE 660 TO 691
                    SELECT CASE xpos
                        CASE 560 TO 623
                            ZoomFac = 1 '                       Zoom to extents
                        CASE 626 TO 689
                            ZoomFac = ZoomFac / .5 '            Zoom in
                        CASE 692 TO 755
                            ZoomFac = ZoomFac * .5 '            Zoom out
                        CASE 762 TO 817
                            togs = TOGGLEBIT(togs, 4) '         Range toggle
                        CASE 820 TO 875
                            togs = TOGGLEBIT(togs, 7) '         Orbit toggle
                        CASE 878 TO 925
                            togs = TOGGLEBIT(togs, 3) '         Grid toggle
                        CASE 928 TO 967
                            togs = TOGGLEBIT(togs, 2) '         Azimuth wheel toggle
                        CASE 970 TO 1009
                            togs = TOGGLEBIT(togs, 5) '         Inclinometer toggle
                        CASE 1012 TO 1059
                            togs = TOGGLEBIT(togs, 6) '         Jump zone toggle
                        CASE 1062 TO 1109
                            IF READBIT(togs, 6) THEN '          if jump zone then
                                togs = TOGGLEBIT(togs, 9) '     Diameter/Density toggle
                            END IF
                        CASE 1132 TO 1179
                            TIMER(t1%) OFF
                            Save_Scenario 0
                            SYSTEM
                    END SELECT
            END SELECT
        CASE 1204 TO 1244 '                                     Z-pan slider      1204-1244 4-654
            SELECT CASE ypos
                CASE 4 TO 18
                    togs = SETBIT(togs, 1)
                    zangle = -90
                CASE 19 TO 321
                    togs = SETBIT(togs, 1)
                    zangle = ((ypos - 329) / 310) * 90
                CASE 322 TO 337
                    togs = RESETBIT(togs, 1)
                    zangle = 0
                CASE 338 TO 637
                    togs = SETBIT(togs, 1)
                    zangle = ((ypos - 329) / 310) * 90
                CASE 638 TO 653
                    togs = SETBIT(togs, 1)
                    zangle = 90
                CASE 660 TO 691
                    WHILE MOUSEINPUT: WEND
                    togs = TOGGLEBIT(togs, 1)
                    IF READBIT(togs, 1) THEN
                        zangle = Ozang
                    ELSE
                        Ozang = zangle: zangle = 0
                    END IF
            END SELECT
    END SELECT
 
END SUB 'Mouse_Ops
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB MoveTurn (var AS BYTE)
 
    'Apply all unit movements
    Turncount = Turncount + 1
    Turn2Clock Turncount
 
    '                                                           store previous turn for future turn undo
    IF units > 0 THEN
        DIM m AS MEM: DIM ms AS MEM: DIM mf AS MEM
        'm = MEM(cmb())
        'c = 1
        'DO '                                                    move all unit's current data to old data block
        '    MEMCOPY m, m.OFFSET + c * m.ELEMENTSIZE + 52, 37 TO m, m.OFFSET + c * m.ELEMENTSIZE + 15
        '    c = c + 1
        'LOOP UNTIL c = units + 1
        c = 1
        DO '                                                    iterate all units
            IF cmb(c).status > 0 THEN '                         if unit destroyed skip the computations
                DIM start AS unitpoint
                DIM finis AS unitpoint
                m = MEM(cmb())
                ms = MEM(start)
                mf = MEM(finis)
                MEMCOPY m, m.OFFSET + c * m.ELEMENTSIZE + 52, 24 TO ms, ms.OFFSET 'same as...
                'start = cmb(x).ap
                IF MEMGET(m, m.OFFSET + c * m.ELEMENTSIZE + 90, BYTE) > 0 THEN 'same as...
                    'IF cmb(c).bstat > 0 THEN
                    InterVadeII MEMGET(m, m.OFFSET + c * m.ELEMENTSIZE + 89, BYTE), c, MEMGET(m, m.OFFSET + c * m.ELEMENTSIZE + 90, BYTE) 'same as...
                    'InterVadeII cmb(c).bogey, c, cmb(c).bstat
                END IF
 
                '***********
 
                MEMCOPY m, m.OFFSET + c * m.ELEMENTSIZE + 52, 37 TO m, m.OFFSET + c * m.ELEMENTSIZE + 15 'same as...
                'cmb(c).op = cmb(c).ap
                '***********
 
                CoordUpdate c, "T" '                            Update unit position
                ColCheck c '                                    check for collision with star/planet
                MEMCOPY m, m.OFFSET + c * m.ELEMENTSIZE + 52, 24 TO mf, mf.OFFSET 'same as...
                'finis = cmb(x).ap
                MEMPUT m, m.OFFSET + c * m.ELEMENTSIZE + 76, Pyth(start, finis) AS SINGLE 'same as...
                'cmb(c).Sp = Pyth(start, finis)
                MEMPUT m, m.OFFSET + c * m.ELEMENTSIZE + 80, Azimuth!(finis.pX - start.pX, finis.pY - start.pY) AS SINGLE 'same as...
                'cmb(c).Hd = Azimuth!(finis.pX - start.pX, finis.pY - start.pY)
                MEMPUT m, m.OFFSET + c * m.ELEMENTSIZE + 84, Slope!(finis, start) AS SINGLE 'same as...
                'cmb(c).In = Slope!(finis, start)
            END IF
            c = c + 1
        LOOP UNTIL c = units + 1
    END IF
    PlanetMove 1
    togs = RESETBIT(togs, 0) '                                  clear turn undo flag
    IF var = 1 THEN
        PanelBlank 140, 578, 64, 32, &HFF0F0F0F
        Con_Blok 140, 578, 64, 32, "Applied", 0, &H502C9B2C
        DISPLAY
        DELAY .2
    END IF
    MEMFREE m: MEMFREE ms: MEMFREE mf
 
END SUB 'MoveTurn
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB MTurnUndo (var AS BYTE)
 
    IF READBIT(togs, 0) THEN
        'put "cannot undo" message here, if desired. Otherwise just disallow second consecutive undo
    ELSE
        Turncount = Turncount - 1
        Turn2Clock Turncount
        IF units > 0 THEN
            DIM m AS MEM '                                      move old ship data block back to current data block
            m = MEM(cmb())
            c = 1
            DO
                MEMCOPY m, m.OFFSET + c * m.ELEMENTSIZE + 15, 37 TO m, m.OFFSET + c * m.ELEMENTSIZE + 52
                c = c + 1
            LOOP UNTIL c = units + 1
            MEMFREE m
        END IF
 
        PlanetMove -1 '                                         back peddle the planets
        togs = SETBIT(togs, 0) '                                set turn undo flag
        IF var = 1 THEN
            PanelBlank 210, 578, 64, 32, &HFF0F0F0F
            Con_Blok 210, 578, 64, 32, "Undone", 0, &H502C9B2C
            DISPLAY
            DELAY .2
        END IF
    END IF
 
END SUB 'MTurnUndo
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB NewVector
 
    'Text based vector input
    'Input new thrust data for active unit.
    'Data is used to adjust heading & speed for that unit.
    cmb(vpoint).bstat = 0: cmb(vpoint).bogey = 0 '              taking back control from AI
    DialogBox "ENTER NEW VECTOR", 400, 250, 50, &HFF2C9B2C, clr&(15)
    LOCATE 8, 56 '+3, +16
    PRINT "c= counterthrust"
    LOCATE 9, 56
    INPUT "New Azimuth:"; x$
    IF x$ = "c" OR x$ = "C" THEN
        VectorBrake
    ELSE
        Thrust(vpoint).Azi = VAL(x$)
        LOCATE 10, 56
        INPUT "New Inclination:"; Thrust(vpoint).Inc
        LOCATE 11, 56
        INPUT "New Acceleration:"; Thrust(vpoint).Gs
        IF Thrust(vpoint).Gs > cmb(vpoint).MaxG THEN
            LOCATE 12, 56
            PRINT "Confirm overdrive"
            DISPLAY
            SLEEP 1
        END IF
    END IF
 
END SUB 'NewVector
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB NewVector2
 
    PanelBlank 0, 578, 64, 32, &HFF0F0F0F '                     dim vector button
    Con_Blok 0, 578, 64, 32, "Vector", 1, &H502C9B2C
 
    togs = RESETBIT(togs, 1) '                                  reset back to overhead view
    zangle = 0
    Refresh
 
    'Conduct graphic based vector input
 
    SST& = NEWIMAGE(620, 620, 32) '                             Vector input overlay
    DEST SST&
    VIEW (0, 0)-(619, 619), clr&(0), clr&(3) '                  set graphics port full image SS& w/box
    WINDOW (-1000, 1000)-(1000, -1000) '                        set relative cartesian coords
 
    DIM mosX: DIM mosY
    cmb(vpoint).bstat = 0: cmb(vpoint).bogey = 0 '              taking back control from AI
 
    DO
        LIMIT 60
        CLS
        Mouse_Loop 0, 0
        CLEARCOLOR RGBA(0, 0, 0, 0)
        IF NOT READBIT(togs, 2) THEN '                          draw azimuth if not already enabled
            AzimuthWheel -1
        END IF
        FOR x = 200 TO 800 STEP 200
            CIRCLE (0, 0), x, clr&(4) '                         Draw thrust percentage circle
            COLOR clr&(4)
            PRINTMODE KEEPBACKGROUND
            PRINTSTRING (310 + (x / 200) * 62, 294), STR$((x / 800) * cmb(vpoint).MaxG) + "Gs", SST&
        NEXT x
 
        mosX = (MOUSEX - 560) * (2000 / 620) - 1000 '           Set relative coordinates
        mosY = ((MOUSEY - 18) * (2000 / 620) - 1000) * -1
        az = Azimuth!(mosX, mosY)
        ds = HYPOT(mosX, mosY)
        IF ABS(mosX) < 1000 AND ABS(mosY) < 1000 THEN '         If mouse is in window then draw vector rays
            LINE (0, 0)-(1000 * SIN(_D2R(az)), 1000 * COS(_D2R(az))), clr&(4)
            LINE (0, 0)-(mosX, mosY), clr&(14)
            PRINTSTRING (3, 3), "Azi. " + STR$(az), SST& '      Echo info in top left corner
            PRINTSTRING (3, 21), "Acceleration " + STR$(INT((ds * cmb(vpoint).MaxG / 800) * 100) / 100) + " Gs", SST&
        END IF
        IF MOUSEBUTTON(1) THEN
            Thrust(vpoint).Azi = az '                           Set azimuth heading
            Thrust(vpoint).Gs = ds * cmb(vpoint).MaxG / 800 '   Apply percentage of 800 radius circle as thrust
            DO UNTIL NOT MOUSEBUTTON(1) '                       Clear the mouse button buffer
                WHILE MOUSEINPUT: WEND
            LOOP
            DO
                LIMIT 60
                CLS
                WHILE MOUSEINPUT: WEND
                CLEARCOLOR RGBA(0, 0, 0, 0)
                IF NOT READBIT(togs, 5) THEN
                    IncMeter -1, -1
                END IF
                mos.pX = (MOUSEX - 560) * (2000 / 620) - 1000 '        Set relative coordinates
                mos.pZ = ((MOUSEY - 18) * (2000 / 620) - 1000) * -1
                az = Azimuth!(mos.pX, mos.pZ)
                COLOR RGBA32(127, 127, 127, 255)
                IF mos.pX >= 0 THEN
                    LINE (0, 0)-(1000 * SIN(_D2R(az)), 1000 * COS(_D2R(az))), clr&(4)
                    PRINTSTRING (3, 21), "Inclination= " + STR$((az - 90) * -1) + " deg.", SST&
                ELSE
                    LINE (0, 0)-(1000, 0), clr&(4)
                    PRINTSTRING (3, 21), "Inclination= 0 ", SST&
                END IF
                PRINTSTRING (3, 37), "click left half for 0", SST&
                IF MOUSEBUTTON(1) THEN
                    IF mos.pX < 0 THEN
                        Thrust(vpoint).Inc = 0
                    ELSE
                        Thrust(vpoint).Inc = (az - 90) * -1 '   Set inclination
                    END IF
                    EXIT DO
                END IF
                PUTIMAGE (560, 18), SS&, A& '                   Erase previous rays
                PUTIMAGE (560, 18), SST&, A& '                  draw new ray
                DISPLAY
            LOOP
            EXIT DO
        END IF
        PUTIMAGE (560, 18), SS&, A& '                           Erase previous rays
        PUTIMAGE (560, 18), SST&, A& '                          draw new ray
        DISPLAY
    LOOP
 
    PUTIMAGE (560, 18), SS&, A& '                               return to normal
    DISPLAY
    FREEIMAGE SST&
    DO UNTIL NOT MOUSEBUTTON(1) '                               Clear the mouse button buffer
        WHILE MOUSEINPUT: WEND '                                to prevent changing active unit
    LOOP '                                                      by accidental click through
 
END SUB 'NewVector2
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB OriScreen (var AS BYTE)
 
    'Display orientation graphic
 
    'place and move stars according to heading and speed
    STATIC starx(12) AS SINGLE
    STATIC stary(12) AS SINGLE
    STATIC ovar AS BYTE
    IF ovar > units THEN ovar = units
    IF ovar <> var THEN '                                       if new active unit
        FOR x = 1 TO 12 '                                       Random star placement
            starx(x) = (INT(RND(1) * 254)) - 127
            stary(x) = (INT(RND(1) * 254)) - 127
        NEXT x
        ovar = var '                                            retain active unit # to keep stars
    END IF
 
    DEST ORI&
    WINDOW (-127, 127)-(127, -127)
    CLS
    IF cmb(var).Hd >= 180 THEN starhd = INT(cmb(var).Hd - 180)
    IF cmb(var).Hd < 180 THEN starhd = INT(cmb(var).Hd + 180)
    IF cmb(var).Sp = 0 THEN
        sp = 0
    ELSE
        sp = cmb(var).Sp / 10000
        IF sp < 1 THEN sp = 1
        IF sp > 8 THEN sp = 8
    END IF
    xm = sp * SIN(D2R(starhd)) '                                Removed INT as it is in PSET below
    ym = sp * COS(D2R(starhd))
    FOR x = 1 TO 12 '                                           iterate through stars
        IF starx(x) > 127 THEN starx(x) = -127 '                recycle those that leave screen to the opposite side
        IF starx(x) < -127 THEN starx(x) = 127
        IF stary(x) > 127 THEN stary(x) = -127
        IF stary(x) < -127 THEN stary(x) = 127
        PSET (INT(starx(x)), INT(stary(x)))
        starx(x) = starx(x) + xm
        stary(x) = stary(x) + ym
    NEXT x
    LINE (-127, 127)-(127, -127), clr&(4), B
    PRINTMODE KEEPBACKGROUND
    PRINTSTRING (127 - LEN((_TRIM$(cmb(var).Nam))) * 4, 2), cmb(var).Nam, ORI&
    IF Thrust(var).Gs = 0 THEN
        RotoZoom2 127, 127, ShpO, 1, 1, Thrust(var).Azi
    ELSE
        RotoZoom2 127, 127, ShpT, 1, 1, Thrust(var).Azi
    END IF
    PUTIMAGE (295, 325)-(543, 573), ORI&, A&
 
END SUB 'OriScreen
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB PanelBlank (xpos AS INTEGER, ypos AS INTEGER, xsiz AS INTEGER, ysiz AS INTEGER, col AS LONG)
 
    'Background blank to mark and mask button use and/or changes
    CN& = NEWIMAGE(xsiz, ysiz, 32) '                            active button overlay
    DEST CN&
    COLOR , col '                                               set overlay background color
    CLS
    PUTIMAGE (xpos, ypos), CN&, A& '                            cover button
    FREEIMAGE CN&
 
END SUB 'PanelBlank
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Place_Ship (xpos AS INTEGER, ypos AS INTEGER)
 
    'Moves active ship, on right click, to new x,y coordinate on the screen.
    'Use <E>dit to set new z coordinate.
 
    SELECT CASE xpos
        CASE 560 TO 1199 '                                      Right graphics screen
            SELECT CASE ypos
                CASE 19 TO 639
                    ' find relative sensor screen coordinates of mouse click
                    WindowMouseX = (xpos - 560) * (2000 / 620) - 1000 '      xpos was mouse_x
                    WindowMouseY = ((ypos - 18) * (2000 / 620) - 1000) * -1 'ypos was mouse_y
                    'WindowMouseX & Y both divided by results of Prop! give .Abs offsets from active position
                    q! = Prop!
                    'cmb(vpoint).ap.pX = (WindowMouseX / q!) + cmb(vpoint).ap.pX 'This is the old way that works well
                    'cmb(vpoint).ap.pY = (WindowMouseY / q!) + cmb(vpoint).ap.pY 'but only in zangle=0
 
                    'TRANSFORMATION MATRIX CALCULATION- extending ship placement into 3D based upon display plane
                    'account for zangle by defining new screen plane, don't have a clue how to go about it...yet
                    'transformation should probably occur at the windowmouse/q! element and then add to cmb(vpoint).ap
                    cmb(vpoint).ap.pX = (WindowMouseX / q!) + cmb(vpoint).ap.pX ' x-axis stays the same at all times
                    WMY_Ycomp = WindowMouseY * COS(_D2R(-zangle))
                    WMY_Zcomp = WindowMouseY * -SIN(_D2R(-zangle))
                    cmb(vpoint).ap.pY = WMY_Ycomp / q! + cmb(vpoint).ap.pY
                    cmb(vpoint).ap.pZ = WMY_Zcomp / q! + cmb(vpoint).ap.pZ
 
                    q2! = Prop!
                    ZoomFac = ZoomFac * (q! / q2!) '            reset zoom factor to new limits
            END SELECT
    END SELECT
 
END SUB 'Place_Ship
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB PlanetDist
 
    T& = NEWIMAGE(248, 315, 32)
    DEST T&
    CLS
    LINE (0, 0)-(247, 314), clr&(4), B
    PRINTSTRING (156, 2), "AU", T&
    PRINTSTRING (202, 2), "Brng", T&
    x = 0: yp = 2
    DO
        x = x + 1
        IF hvns(x).star <> 2 THEN '                             don't show planetoid belts or rings
            IF hvns(x).rank < 3 THEN '                          show only main planets
                IF yp MOD 2 = 0 THEN
                    bb& = &H1F7F7F7F
                ELSE
                    bb& = &HFF000000
                END IF
                COLOR , bb&
                ds = INT((Pyth(cmb(vpoint).ap, hvns(x).ps) / KMtoAU) * 100) / 100
                br = INT(Azimuth!(rcp(x).pX, rcp(x).pY) * 10) / 10
                LOCATE yp, 2
                PRINT TRIM$(hvns(x).nam); SPC(16 - LEN(TRIM$(hvns(x).nam)));
                LOCATE , 18
                PRINT USING "###.##"; ds; SPC(2);
                LOCATE , 26
                PRINT USING "###.#"; br
                yp = yp + 1
            END IF
        END IF
    LOOP UNTIL x = orbs
    PUTIMAGE (295, 5)-(543, 320), T&, A&
    DEST A&
    FREEIMAGE T&
 
END SUB 'PlanetDist
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB PlanetMove (var AS BYTE)
 
    'Using orbital period figures, move the planets and their satellites
    'along their orbit tracks. Convert orbital periods into 1000 sec turns
    'divide 360 by the number of turns to get an azimuth change value.
    'Azimuth change can be applied to update x,y,z of moving planet.
    'At this point the exact same azimuth update should be applied to the
    'satellites relative to the primary, the same as their parent. Only
    'then can the azimuth changes of the satellites be applied relative to
    'their parent planets. Also called for initial date setup.
    'var=turncount (1 for normal turn, -1 for undo)
    'outermost iteration should be for .rank
    DIM t AS unitpoint
    DIM c AS unitpoint
    FOR x = 2 TO 4 '                                            rank iteration, rank 1 primary doesn't move
        FOR v = 1 TO orbs '                                     iterate all bodies
            IF hvns(v).star <> 2 THEN '                         don't move belt/ring systems except relative to parent
                IF hvns(v).rank = x THEN
                    'compute new x,y,z for body v of x rank relative to primary/parent
                    c = hvns(FindParent(v)).ps: t = hvns(v).ps
                    d&& = Pyth(t, c)
                    przaz## = Azimuth!(t.pX - c.pX, t.pY - c.pY) 'get present azimuth
 
                    IF Turncount = 0 THEN '                     Initial date setup
                        IF oryr > 0 THEN '                      If year/day not zero compute rotation from baseline
                            rot = oryr / hvns(v).oprd '         Divide years from baseline by orbital period of body
                            IF rot <> INT(rot) THEN rot = rot - INT(rot) 'discard all full periods and get remainder
                            prdtrnaz## = (rot * 360) '          multiply remainder by 360 for azimuth change
                        END IF
                    ELSE '                                      Not initial setup so compute turn change
                        prdtrnaz## = 360 / (hvns(v).oprd * 31557.6 * var) 'azimuth change / turn  negative .oprd yields retrograde motion
                    END IF
                    '  \/ \/ \/     add azimuth change to present azimuth or subtract with if newaz!<0 then newaz=newaz+360 for opposite rotation
                    newaz## = przaz## + prdtrnaz##
                    oldx&& = hvns(v).ps.pX '                    preserve old x,y,z temporarily for
                    oldy&& = hvns(v).ps.pY '                    baseline satellite movement calculation
                    oldz&& = hvns(v).ps.pZ
                    hvns(v).ps.pX = (hvns(v).orad * SIN(D2R(newaz##))) + c.pX
                    hvns(v).ps.pY = (hvns(v).orad * COS(D2R(newaz##))) + c.pY
                    'put new planet Z position here if the option for tilted orbits is later added
 
                    'reiterate to pick out the children to drag along
                    FOR s = 1 TO orbs
                        IF hvns(s).parnt = hvns(v).nam THEN
                            'apply same motion as parent relative to parent's primary
                            hvns(s).ps.pX = hvns(s).ps.pX + (hvns(v).ps.pX - oldx&&)
                            hvns(s).ps.pY = hvns(s).ps.pY + (hvns(v).ps.pY - oldy&&)
                            hvns(s).ps.pZ = hvns(s).ps.pZ + (hvns(v).ps.pZ - oldz&&)
                        END IF
                    NEXT s
 
                END IF
            END IF 'end belt/ring test
        NEXT v
    NEXT x
 
 
END SUB 'PlanetMove
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Prnt (text AS STRING, wsize AS SINGLE, hsize AS SINGLE, StartX AS INTEGER64, StartY AS INTEGER64, Xspace AS INTEGER, Yspace AS INTEGER, col AS UNSIGNED LONG)
 
    '------------------------------------------------------------------------------------
    ' SUB: Prnt (adaptation of Petr's excellent approach to text resizing)
    '
    ' Purpose:
    ' Display text as resizable and recolorable images that have been previously
    ' defined in the main module.
    '
    ' Passed parameters:
    ' text sends string value to be printed
    ' wsize sends width size of text to be displayed: 1=original
    ' hsize sends height size of text to be displayed: 1=original
    ' StartX sends upper left x position for PUTIMAGE
    ' StartY sends upper left y position for PUTIMAGE
    ' Xspace sends horizontal spacing
    ' Yspace sends vertical spacing
    ' col sends color of character
    '
    '------------------------------------------------------------------------------------
 
    x = StartX
    y = StartY
    FOR f = 1 TO LEN(text)
        ch = ASC(text, f)
        x = x + Xspace
        y = y + Yspace
        ColoredChar = swapcolor(chr_img(ch), &HFFF5F5F5, col) ' colorize character:
        _PUTIMAGE (x, y)-(x + (wsize * 8), y - (hsize * 16)), ColoredChar, 0
        _FREEIMAGE ColoredChar
    NEXT
 
END SUB 'Prnt
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION Prop!
 
    'keep it in proportion...
    'find the relative offsets of all units to the active unit and
    'resize to keep all in the picture, subject to zoom factor override.
 
    DIM deltamax AS INTEGER64 ' carries the widest axial separation of units in km
 
    IF units > 1 THEN '                                         multiple units present
        deltamax = 1000
        x = 0
        DO
            x = x + 1
            IF cmb(x).status > 0 AND x <> vpoint THEN '         skip if active, destroyed or immobile
                IF ABS(dcs(x).pX) > deltamax THEN deltamax = ABS(dcs(x).pX) 'X limits
                IF ABS(dcs(x).pY) > deltamax THEN deltamax = ABS(dcs(x).pY) 'Y limits
            END IF
        LOOP UNTIL x = units
    ELSE '                                                      only single unit present
        deltamax = 1000000: ZoomFac = 1
    END IF
 
    Prop! = 800 * (ZoomFac / deltamax) '                        all units on screen subject to zoom factor
 
END FUNCTION 'Prop!
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Purge
 
    'Remove wrecked vessels from list if not desired
 
    ct = 0
    I$ = cmb(vpoint).Nam '                                      preserve an active unit identifier
    FOR x = 1 TO units
        IF cmb(x).status = 0 THEN
            ct = ct + 1 '                                       count the number if units to remove
        END IF
    NEXT x
    IF ct = 0 THEN '                                            No destroyed units?
        EXIT SUB '                                              leave without unnecessary processing
    ELSE
        n% = units - ct '                                       dim sufficient temp variables
        DIM tmpshp(n%) AS ship
        DIM tmpthrs(n%) AS Maneuver
        DIM tmpsens(n%, n%) AS BYTE
        y = 0
        FOR x = 1 TO units '                                    keep all existing units in temps
            IF cmb(x).status <> 0 THEN
                y = y + 1
                tmpshp(y) = cmb(x)
                tmpthrs(y) = Thrust(x)
                FOR q = 1 TO units
                    tmpsens(x, q) = Sensor(x, q)
                NEXT q
            END IF
        NEXT x
        units = n% '                                            redimension primary variables
        REDIM cmb(units) AS ship
        REDIM Thrust(units) AS Maneuver
        REDIM Sensor(units, units) AS _BYTE
        FOR x = 1 TO units '                                    Move temps back into primary variables
            cmb(x) = tmpshp(x)
            Thrust(x) = tmpthrs(x)
            FOR y = 1 TO units
                Sensor(x, y) = tmpsens(x, y)
            NEXT y
            cmb(x).id = x
            IF cmb(x).Nam = I$ THEN vpoint = x '                set active to new position
        NEXT x
        a = units + 1: b = n% + ct
        FOR x = a TO b '                                        free abandoned ship display memory
            _FREEIMAGE ship_box(x)
        NEXT x
    END IF
 
END SUB 'Purge
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION Pyth (var1 AS unitpoint, var2 AS unitpoint)
 
    'Use to find distance between two 3D points
    'Also calculate speed/magnitude of updated vectors
 
    Pyth = HYPOT(HYPOT(ABS(var1.pX - var2.pX), ABS(var1.pY - var2.pY)), ABS(var1.pZ - var2.pZ))
 
END FUNCTION 'Pyth
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION PythXY (var1 AS unitpoint, var2 AS unitpoint)
 
    'Use to find distance between two 2D points
    'Also calculate speed/magnitude of updated vectors
 
    PythXY = HYPOT(ABS(var1.pX - var2.pX), ABS(var1.pY - var2.pY))
 
END FUNCTION 'PythXY
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION RayTrac## (var1 AS unitpoint, var2 AS unitpoint, var3 AS unitpoint, var4 AS INTEGER64)
 
    'Same algorithm as in ColCheck with following substitutions
    'strt=var1 : first ship
    'nd=  var2 : second ship
    'sphr=var3 : planet position
    '     var4 : planet radius
    'checking only for intersection of body in line of sight, not impact position
 
    dx## = var2.pX - var1.pX: dy## = var2.pY - var1.pY: dz## = var2.pZ - var1.pZ
    A## = (dx## * dx##) + (dy## * dy##) + (dz## * dz##)
    B## = 2 * dx## * (var1.pX - var3.pX) + 2 * dy## * (var1.pY - var3.pY) + 2 * dz## * (var1.pZ - var3.pZ)
    C## = (var3.pX * var3.pX) + (var3.pY * var3.pY) + (var3.pZ * var3.pZ) + (var1.pX * var1.pX) + (var1.pY * var1.pY) +_
                (var1.pZ * var1.pZ) + -2 * (var3.pX * var1.pX + var3.pY * var1.pY + var3.pZ * var1.pZ) - (var4 * var4)
    disabc## = (B## * B##) - 4 * A## * C## ' if disabc## < 0 then no intersection =0 tangent >0 intersects two points
    RayTrac## = disabc##
 
END FUNCTION 'RayTrac##
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Refresh
 
    VCS '                                                   Set viewpoint coordinate system
    SensorMask '                                            determine sensor occlusions
    ScreenLimits '                                          Open sensor display viewport
    SensorScreen '                                          Display sensor data
    DispShipData '                                          Print unit positions, speeds and headings
    ButtonBlock '                                           control panel
    PlanetDist '                                            show main planet bearings and distances
    DISPLAY
 
END SUB 'Refresh
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB RotoZoom2 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, Rotation AS SINGLE)
 
    '------------------------------------------------------------------------------------CLEARED
    ' SUB: RotoZoom2 (author Bplus of QB64 forum, not my own creation, but damn useful)
    '
    ' Purpose:
    ' Locate and display image, scaling and/or rotating the displayed image around
    ' its central point.
    '
    ' Passed parameters:
    ' X, Y sends the center point of where the image is to be displayed
    ' Image sends the source image handle
    ' xScale and yScale send width and height stretching parameters 1=original size
    ' Rotation sends rotation of image in degrees 0=east, 270=north
    '
    '------------------------------------------------------------------------------------
 
    DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
    W& = WIDTH(Image&): H& = HEIGHT(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR i& = 0 TO 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
        px(i&) = x2&: py(i&) = y2&
    NEXT
    MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
 
END SUB 'RotoZoom2
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Save_Scenario (var AS BYTE)
 
    'Save present system state and vessel group
    IF var THEN
        t% = 400: r% = 2
        DialogBox "SAVING PRESENT SCENARIO", t%, 250, 50, &HFF8C5B4C, clr&(15)
        DISPLAY
        LOCATE r% + 5, ((_WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
        INPUT "Enter a scenario name: ", fl$
        LOCATE r% + 7, ((_WIDTH(A&) / 2) - 40) / 8
        PRINT "Saving..."
    ELSE
        fl$ = "autosave/auto"
    END IF
    vl$ = "scenarios/" + TRIM$(fl$) + ".tvg"
    pl$ = "scenarios/" + TRIM$(fl$) + ".tss"
    sl$ = "scenarios/" + TRIM$(fl$) + ".tgn"
    tl$ = "scenarios/" + TRIM$(fl$) + ".tvt"
    tt$ = "scenarios/" + TRIM$(fl$) + ".ttl"
    IF FILEEXISTS(pl$) THEN KILL pl$
    OPEN pl$ FOR RANDOM AS #1 LEN = LEN(hvns(0))
    FOR x = 1 TO orbs
        PUT #1, x, hvns(x)
    NEXT x
    CLOSE #1
    IF FILEEXISTS(vl$) THEN KILL vl$
    OPEN vl$ FOR RANDOM AS #2 LEN = LEN(cmb(0))
    FOR x = 1 TO units
        PUT #2, x, cmb(x)
    NEXT x
    CLOSE #2
    IF FILEEXISTS(tl$) THEN KILL tl$
    OPEN tl$ FOR RANDOM AS #3 LEN = LEN(Thrust(0))
    FOR x = 1 TO units
        PUT #3, x, Thrust(x)
    NEXT x
    CLOSE #3
    IF FILEEXISTS(sl$) THEN KILL sl$
    OPEN sl$ FOR OUTPUT AS #4
    WRITE #4, Turncount, oryr, vpoint, shipoff
    CLOSE #4
    IF FILEEXISTS(tt$) THEN KILL tt$
    OPEN tt$ FOR RANDOM AS #5 LEN = LEN(Sensor(0, 0))
    FOR x = 1 TO units
        FOR y = 1 TO units
            PUT #5, ((x - 1) * units) + y, Sensor(x, y)
        NEXT y
    NEXT x
    CLOSE #5
 
END SUB 'Save_Scenario
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Save_Ships
 
    'Save the present ship scenario
    'call syntax: DialogBox <heading string>, box x, box y, y position, bounding box color, text color
    t% = 400
    DialogBox "SAVING PRESENT VESSEL(S) & POSITION(S)", t%, 250, 50, &HFF8C5B4C, clr&(15)
    DISPLAY
    LOCATE r% + 5, ((_WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
    INPUT "Enter a vessel group name: ", fl$
    LOCATE r% + 7, ((_WIDTH(A&) / 2) - 40) / 8
    PRINT "Saving..."
    fl$ = "ships\" + fl$ + ".tvg"
    OPEN fl$ FOR RANDOM AS #2 LEN = LEN(cmb(0))
    FOR x = 1 TO units
        PUT #2, x, cmb(x)
    NEXT x
    CLOSE #2
    'add thrust file
 
END SUB 'Save_Ships
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Save_System
 
    t% = 600
    DialogBox "SAVING SYSTEM", t%, 250, 50, &HFF8C5B4C, clr&(15)
 
    in1$ = "Enter system name or press ENTER to default to " + TRIM$(hvns(1).nam)
    l = WIDTH(A&) / 2 - (LEN(in1$) * 8) / 2
    PRINTSTRING (l, 217), in1$, A&
    col% = ((WIDTH(A&) / 2) - (t% / 2)) / 8 + 4
    DISPLAY
    LOCATE 10, col%
    INPUT "System name:"; n$
    IF n$ <> "" THEN
        n$ = TRIM$(n$)
    ELSE
        n$ = TRIM$(hvns(1).nam)
    END IF
 
    sys$ = "systems/" + n$ + ".tss"
    OPEN sys$ FOR RANDOM AS #1 LEN = LEN(hvns(1))
    FOR x = 1 TO orbs
        PUT #1, x, hvns(x)
    NEXT x
    CLOSE #1
 
END SUB 'Save_System
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB ScreenLimits
 
    '0=black,1=blue,2=green,3=aqua,4=red,5=purple,6=brown,7=white
    '8=gray, +8=bright color, except 14=yellow,
 
    DEST A&
    SCREEN A&
    COLOR , RGBA32(15, 15, 15, 10)
    CLS
    c = 3 'color variable (local)
 
    PRINTSTRING (560, 0), "Turn #" + STR$(Turncount), A& '     Turn and time elapsed
    IF etd THEN tm$ = TRIM$(STR$(etd)) + "d "
    IF eth OR Turncount > 3 THEN tm$ = tm$ + TRIM$(STR$(eth)) + "h "
    IF Turncount > 0 THEN tm$ = tm$ + TRIM$(STR$(etm)) + "m " + TRIM$(STR$(ets)) + "s"
    PRINTSTRING (672, 0), tm$, A&
 
    IF READBIT(togs, 1) THEN
        SELECT CASE zangle '                                    set galactic orientation strings to rotation angle
            CASE IS < -45
                bt$ = "NADIR facing rimward"
                bb$ = "ZENITH facing rimward"
            CASE -45 TO 45
                bt$ = "COREWARD"
                bb$ = "RIMWARD"
            CASE IS > 45
                bt$ = "ZENITH facing coreward"
                bb$ = "NADIR facing coreward"
        END SELECT
    ELSE
        bt$ = "COREWARD"
        bb$ = "RIMWARD"
    END IF
 
    PRINTSTRING (839, 0), bt$, A& '                             Galactic orientation screen top
    PRINTSTRING (839, 639), bb$, A& '                           Galactic orientation screen bottom
 
    FOR x = 1 TO 8 '                                            Galactic orientation screen right
        PRINTSTRING (1187, 249 + (x * 16)), MID$("TRAILING", x, 1), A&
    NEXT x
    FOR x = 1 TO 8 '                                            Galactic orientation screen left
        PRINTSTRING (547, 249 + (x * 16)), MID$("SPINWARD", x, 1), A&
    NEXT x
    OriScreen vpoint
    ZPanner
 
END SUB 'ScreenLimits
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB SensorMask
 
    'Determine which units may be sensor occluded by planetary bodies.
    'this must be refreshed each turn, but we should do something to
    'avoid it each display loop. Sensor(x,y) will handle display loop.
    'Sensor occlusion will break target locks.
 
    $CHECKING:OFF
    'Determine which units are visible to others
    FOR x = 1 TO units '                                        Active unit iteration  x=active
        FOR y = 1 TO units '                                    Passive unit iteration  y=passive
            Sensor(x, y) = RESETBIT(Sensor(x, y), 0)
            IF x <> y THEN '                                    if unit is self then skip and leave at zero
                FOR z = 1 TO orbs '                             Planetary body iteration
                    IF hvns(z).star <> 2 THEN '                 Skip belt/ring systems
                        IF Pyth(rcs(x), rcp(z)) < Pyth(rcs(x), rcs(y)) THEN ' is planet closer to active than passive?
                            IF Pyth(rcs(y), rcp(z)) < Pyth(rcs(x), rcs(y)) THEN ' is planet closer to passive than active?
                                'We've now determined that the planet is generally
                                'within the separation radius of both units simultaneously
                                'so that we won't waste processing resources in ray tracing
                                'distant objects.
                                IF RayTrac##(rcs(x), rcs(y), rcp(z), hvns(z).radi) < 0 THEN 'if ray trace indicates LOS then
                                    'do nothing as above reset has already made passives visible by default
                                ELSE '                              LOS not available
                                    Sensor(x, y) = SETBIT(Sensor(x, y), 0) '             Passive is sensor occluded and not visible to Active
                                    IF READBIT(Sensor(x, y), 1) THEN Sensor(x, y) = RESETBIT(Sensor(x, y), 1) 'no target lock if occluded
                                END IF
                            END IF '                            end is planet between?
                        END IF '                                end is planet close?
                    END IF '                                    end belt/ring test
                NEXT z '                                        end planetary body iteration
            END IF '                                            end self unit skip
        NEXT y '                                                end passive unit iteration
    NEXT x '                                                    end active unit iteration
    $CHECKING:ON
 
END SUB 'SensorMask
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB SensorScreen
 
    'Graphic navigation screen
    SCREEN SS& '                                                set output to sensor screen display
    DEST SS&
    CLS
 
    c = 4
    COLOR clr&(c)
    VIEW (1, 1)-(618, 618), clr&(0), clr&(c) '                  set graphics port full image SS& w/box
    WINDOW (-1000, 1000)-(1000, -1000) '                        set relative cartesian coords
    AzimuthWheel READBIT(togs, 2)
    IncMeter READBIT(togs, 5), 0
    LINE (0, 50)-(0, 25), clr&(c) '                             draw active unit reference point xhair
    LINE (0, -25)-(0, -50), clr&(c)
    LINE (-50, 0)-(-25, 0), clr&(c)
    LINE (25, 0)-(50, 0), clr&(c)
    COLOR clr&(15)
 
    SysMap '                                                    draw system details
    'SysMapII
 
    'Dynamic scale grid display
    DIM q!
    q! = Prop!
    IF READBIT(togs, 3) THEN '                                  If grid toggle is TRUE
        DIM dynagrid AS SINGLE
        dynagrid = .001 '                                       start at 1 meters grid size
        DO
            IF (q! * dynagrid) > 60 THEN '                      adjust the number to change the grid behaviour
                EXIT DO
            END IF
            dynagrid = dynagrid * 10 '                          jump by power of 10 when necessary
        LOOP
 
        g = 0: c = 0
        DO UNTIL g > 1000 '                                     Draw grid
            IF c MOD 10 = 0 THEN
                COLOR RGBA32(255, 255, 255, 40) '               semi-transparent white for grid by 10s
            ELSE
                COLOR RGBA32(255, 255, 255, 15) '               semi-transparent white for grid
            END IF
            LINE (-1000, g)-(1000, g) '                         horizontal grid lines
            IF g > 0 THEN LINE (-1000, (-1 * g))-(1000, (-1 * g))
            LINE (g, -1000)-(g, 1000) '                         vertical grid lines
            IF g > 0 THEN LINE ((-1 * g), -1000)-((-1 * g), 1000)
            g = g + (q! * dynagrid)
            c = c + 1
        LOOP
        scalelegend$ = "grid=" + STR$(dynagrid) + " km"
        Prnt scalelegend$, 2.8, 2.8, -990, -950, 24, 0, &H48FFFFFF 'print legend in lower left corner
    END IF
 
    'UNIT PLACEMENTS, VECTORS, RANGES AND ID                   Draw each unit and index number on screen
    'Translate/Transform variables
    DIM UDisp AS unitpoint '                                    proportional dcs unit placement
    DIM IDisp AS unitpoint '                                    vector indicator
    DIM VDisp AS unitpoint '                                    vector indicator transformation
 
    shipcl& = clr&(2) '                                         set default ship name color to green (going)
    FOR x = 1 TO units '                                        Iterate through all ships
        UDisp = dcs(x): VecMult UDisp, q! '                     unit positions for display
        'This gives the vector tail displayed from zenith view
        IDisp.pX = rcs(x).pX + cmb(x).Sp * COS(D2R(cmb(x).In)) * SIN(D2R(cmb(x).Hd)) '
        IDisp.pY = rcs(x).pY + cmb(x).Sp * COS(D2R(cmb(x).In)) * COS(D2R(cmb(x).Hd)) '
        IDisp.pZ = rcs(x).pZ + cmb(x).Sp * SIN(D2R(cmb(x).In)) '
        'This skews the vector tail relative to the dcs plane, coordinate transformation of IDisp
        VDisp.pX = IDisp.pX * q!
        VDisp.pY = (IDisp.pY * COS(D2R(zangle)) + IDisp.pZ * SIN(_D2R(zangle))) * q!
        VDisp.pZ = (IDisp.pY * -SIN(D2R(zangle)) + IDisp.pZ * COS(D2R(zangle))) * q!
 
        'maybe this could go in CoordUpdate; resets target lock bit if beyond 3 light seconds
        IF Pyth(cmb(vpoint).ap, cmb(x).ap) > 900000 THEN Sensor(vpoint, x) = RESETBIT(Sensor(vpoint, x), 1)
 
        'put an out of frame if then here also
        IF ABS(UDisp.pX) > 1300 AND ABS(UDisp.pY) > 1300 THEN ' skip draw if out of frame
        ELSE
            IF READBIT(Sensor(vpoint, x), 0) THEN '             If ship x is invisible to active unit then skip display
            ELSE '                                              if not occluded then display it
                c = 7
                IF dcs(x).pZ > dcs(vpoint).pZ THEN c = 9 '      zenith color (blue shift)
                IF dcs(x).pZ < dcs(vpoint).pZ THEN c = 12 '     nadir color (red shift)
 
                IF cmb(x).status > 0 THEN '                     Draw point box and name
                    LINE (UDisp.pX - 5, UDisp.pY + 5)-(UDisp.pX + 5, UDisp.pY - 5), clr&(c), BF
                    IF x <> vpoint AND READBIT(Sensor(vpoint, x), 1) THEN 'Draw target "X box" lock indicator if targeted by active
                        LINE (UDisp.pX - 20, UDisp.pY + 20)-(UDisp.pX + 20, UDisp.pY - 20), &H3FFC5454, B
                        LINE (UDisp.pX - 20, UDisp.pY + 20)-(UDisp.pX + 20, UDisp.pY - 20), &H3FFC5454
                        LINE (UDisp.pX + 20, UDisp.pY + 20)-(UDisp.pX - 20, UDisp.pY - 20), &H3FFC5454
                    END IF
                    IF x = vpoint AND cmb(x).status <> 3 THEN ' bright green unless damaged
                        shipcl& = clr&(10)
                        Prnt cmb(x).Nam, 2.8, 2.8, UDisp.pX + 10, UDisp.pY - 10, 24, 0, shipcl&
                        shipcl& = clr&(2)
                    ELSE
                        IF cmb(x).status = 3 THEN '             red if damaged and drifting, active or otherwise
                            shipcl& = clr&(4)
                            Prnt cmb(x).Nam, 2.8, 2.8, UDisp.pX + 10, UDisp.pY - 10, 24, 0, shipcl&
                            shipcl& = clr&(2)
                        ELSE '                                  green undamaged non-active units
                            Prnt cmb(x).Nam, 2.8, 2.8, UDisp.pX + 10, UDisp.pY - 10, 24, 0, shipcl&
                            shipcl& = clr&(2)
                        END IF
                    END IF
                END IF
 
                ' VECTOR INDICATORS adjusted for Z-pan
                IF x = vpoint THEN '                            draw active unit's vector indicator
                    LINE (0, 0)-(VDisp.pX, VDisp.pY), RGB32(222, 188, 17)
                ELSE
                    LINE (UDisp.pX, UDisp.pY)-(VDisp.pX, VDisp.pY), RGB32(17, 188, 222)
                END IF
            END IF '                                            end Sensor(vpoint,x) check
        END IF '                                                end out of frame skip
 
        ' RANGING BANDS & CIRCLES
        IF READBIT(togs, 4) THEN '                              if range toggle is true
            IF x = vpoint THEN '                                Draw ranging circles of active unit
                FCirc 0, 0, 500000 * q!, RGBA(252, 252, 84, 5) 'Medium range band  clr&(14)w/alpha
                FCirc 0, 0, 250000 * q!, RGBA(252, 84, 84, 20) 'Short range band
                IF cmb(vpoint).mil THEN
                    dtct = 600000 '                             military detection range
                ELSE
                    dtct = 150000 '                             civilian detection range
                END IF
                CIRCLE (0, 0), dtct * q!, clr&(8) '             minimum detection range .5 or 2 light seconds
                CIRCLE (0, 0), 900000 * q!, clr&(4) '           maximum detection range 3 light seconds
            END IF
        END IF
    NEXT x
 
    'Grav watcher- upper right sensor screen
    PRINTMODE KEEPBACKGROUND
    COLOR RGBA(0, 255, 0, 50) 'clr&(2)
    PRINTSTRING (550, 5), STR$(_ROUND(Gwat.Gs * 100) / 100), SS&
    PRINTSTRING (550, 21), STR$(Gwat.Azi), SS&
    PRINTSTRING (550, 37), STR$(Gwat.Inc), SS&
 
    DEST A& '                                                   return output to main screen
    SCREEN A&
    PUTIMAGE (560, 18), SS&, A& '                               update sensor screen to mainscreen
 
END SUB 'SensorScreen
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB SetUp
 
    'Debugging setup- to be replaced by file inputs eventually
 
    RESTORE ships
    READ a
    units = a
    REDIM cmb(a) AS ship '                                      set up ships (units)
    REDIM Thrust(units) AS Maneuver '                           unit accelerations/vector
    REDIM Sensor(units, units) AS BYTE '                        Sensor ops- planetary obscuration array, who can see who?
    FOR x = 1 TO units '                                        Ship data display handle array
        ship_box(x) = NEWIMAGE(290, 96, 32)
    NEXT x
 
    FOR x = 1 TO units '                                        initialize unit data
        READ cmb(x).id: READ cmb(x).Nam: READ cmb(x).MaxG
        READ cmb(x).ap.pX: READ cmb(x).ap.pY: READ cmb(x).ap.pZ
        READ cmb(x).Sp: READ cmb(x).Hd: READ cmb(x).In: READ cmb(x).mil
        cmb(x).op = cmb(x).ap
        cmb(x).status = 1
        Thrust(x).Azi = INT(RND(1) * 360) '                     random orientation
    NEXT x
 
    'Initial planet position determined by date
    PlanetMove 1
 
    RANDOMIZE TIMER '                                           temporary random placement seed
    'Put units randomly around a random body
    DO
        pl% = INT(RND * orbs) + 1
    LOOP UNTIL hvns(pl%).star <> 2 '                            don't place in belt/ring
    'or place around a specific body
    'pl% = 3 'Terra/Earth
    FOR y = 1 TO units
        AZ = RND * 360 '                                        random azimuth placement
        ds = RND * 500 + 40 '                                   random distance in radii of body
        dz = RND * 20 - 10
        cmb(y).ap.pX = (hvns(pl%).radi * ds) * SIN(D2R(AZ)) + hvns(pl%).ps.pX
        cmb(y).ap.pY = (hvns(pl%).radi * ds) * COS(D2R(AZ)) + hvns(pl%).ps.pY
        cmb(y).ap.pZ = hvns(pl%).radi * dz
        'cmb(y).ap.pZ = 0
    NEXT y
 
END SUB 'SetUp
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION Slope! (var1 AS unitpoint, var2 AS unitpoint)
 
    'returns degree declination of var1 point relative to var2
 
    DIM D AS INTEGER64
    D = HYPOT(var1.pX - var2.pX, var1.pY - var2.pY) '          distance on X,Y plane
    Slope! = R2D(ATAN2(var1.pZ - var2.pZ, D))
 
 
END FUNCTION 'Slope!
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION swapcolor (handle&, oldcolor~&, newcolor~&)
 
    'Petr's character color swapping function, called from SUB Prnt
 
    DIM m AS _MEM, c AS _UNSIGNED LONG
    swapcolor = _COPYIMAGE(handle&, 32)
    m = _MEMIMAGE(swapcolor)
    DO UNTIL x& = m.SIZE - 4
        x& = x& + 4
        c = _MEMGET(m, m.OFFSET + x&, _UNSIGNED LONG)
        IF c = oldcolor~& THEN _MEMPUT m, m.OFFSET + x&, newcolor~&
    LOOP
    _MEMFREE m
 
END FUNCTION 'swapcolor
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB SysMap
 
    'Displays the star system, called from SUB SensorScreen
 
    DIM g! '                                                    holds result of Prop! call for this display loop
    DIM OT AS unitpoint '                                       locates orbit tracks & belt/ring systems
    g! = Prop!
 
    'Iterate through all system bodies
    FOR p = 1 TO orbs
 
        'on jump toggle display diameters- rejecting those out of frame
        IF READBIT(togs, 6) AND hvns(p).star <> 2 THEN '    jump zones toggled & not asteroid belt
            IF READBIT(togs, 9) THEN l! = hvns(p).dens ELSE l! = 1 'density or diameter jump zone
            '100 diameters/densities
            bug = FrameSect(rcs(vpoint), rcp(p), hvns(p).radi * 200 * l!, g!)
            IF bug > 1 THEN
                FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi * 200 * l!) * g!, RGBA(150, 116, 116, 10)
            END IF
            '10 diameters/densities
            bug = FrameSect(rcs(vpoint), rcp(p), hvns(p).radi * 20 * l!, g!)
            IF bug > 1 THEN
                FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi * 20 * l!) * g!, RGBA(200, 116, 116, 5)
            END IF
        END IF
 
        'If star then build star and star corona otherwise set planet color
        IF hvns(p).star = -1 THEN '                              if a star then build star corona
            'DETERMINE ANY STELLAR CLASS CONSTANTS HERE- use them in place of 50000
            bug = FrameSect(rcs(vpoint), rcp(p), hvns(p).radi + (30 * 50000), g!)
            IF bug > 0 THEN
                FOR x = 1 TO 30
                    bug = FrameSect(rcs(vpoint), rcp(p), hvns(p).radi + (x * 50000), g!)
                    IF bug > 0 THEN
                        FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi + (x * 50000)) * g!, RGBA32(127, 127, 227, 30 - x)
                    END IF
                NEXT x
            END IF
            c& = &HFFFC5454 '                               star photosphere color
        ELSE
            c& = &HFF545454 '                               planet color
        END IF
 
        'find orbit track center
        IF hvns(p).rank > 1 THEN
            OT = rcp(FindParent(p))
        ELSE
            OT.pX = 0: OT.pY = 0: OT.pZ = 0
        END IF
 
        IF hvns(p).star < 2 THEN
 
            'display orbit tracks
            IF READBIT(togs, 7) THEN '                          if orbit toggle is true
                IF READBIT(togs, 1) THEN '                      if Z-pan toggle is true
                    'adjust so orbit track center moves with parent body
                    'draw all orbit tracks as some may be visible on extreme Z-pan
                        CIRCLE (OT.pX * g!, (OT.pY * (COS(D2R(zangle))) + (OT.pZ * SIN(D2R(zangle)))) * g!),_
                         hvns(p).orad * g!, RGBA(111, 72, 233, 70), , , 1 * COS(D2R(zangle))
                ELSE
                    bug = FrameSect(rcs(vpoint), rcp(FindParent(p)), hvns(p).orad, g!)
                    IF bug = 3 THEN 'exclude circles that don't intersect view port to speed zoom in
                        CIRCLE (OT.pX * g!, OT.pY * g!), hvns(p).orad * g!, RGBA(111, 72, 233, 70)
                    END IF
                END IF
            END IF
 
            'display gravity zones
            IF READBIT(togs, 8) THEN '                          if grav zone toggle is true
                IF hvns(p).star <> 2 THEN
                    grv! = 0
                    radius## = hvns(p).radi
                    dsx## = hvns(p).dens * ((4 / 3) * PI * (radius## * radius## * radius##)) / 26687
                    DO
                        grv! = grv! + .25
                        ds## = (dsx## / grv!) ^ .5
                        bug = FrameSect(rcs(vpoint), rcp(p), ds##, g!)
                        IF bug = 3 THEN
                            CIRCLE (dcp(p).pX * g!, dcp(p).pY * g!), ds## * g!, RGBA(0, 255, 0, 25)
                        END IF
                    LOOP UNTIL ds## < hvns(p).radi
                END IF 'end belt/ring test
            END IF
 
            'display star/planet body, rejecting those that are out of frame
            bug = FrameSect(dcs(vpoint), dcp(p), hvns(p).radi, g!)
            IF bug > 0 THEN
                FCirc dcp(p).pX * g!, dcp(p).pY * g!, hvns(p).radi * g!, c&
                CIRCLE (dcp(p).pX * g!, dcp(p).pY * g!), hvns(p).radi * g!, &HFF777777
 
                'display name if there's room
                IF g! > .0003 AND hvns(p).rank = 3 THEN '       drop satellite names first
                    GOSUB print_name
                END IF
                IF g! > .00000003 AND hvns(p).rank = 2 THEN '   Then drop planets names
                    GOSUB print_name
                END IF
                IF hvns(p).star THEN '                          always keep star names visible
                    GOSUB print_name
                END IF
            END IF '                                            end planet out of frame reject
        ELSE
            'Display planetoid belts and rings
            IF READBIT(togs, 10) THEN
                IF hvns(p).orad * 2 * g! > 100 THEN
                    aster& = &H087F7F7F '                               belt/ring color
                    IF hvns(p).dens > 0 THEN '                          belt/ring width- stored in dens element
                        wid = hvns(p).dens / 2
                    ELSE
                        wid = .15
                    END IF
                    inbnd&& = (hvns(p).orad - (hvns(p).orad * wid)) 'inner limit of planetoid/ring belt wid% orbital radius
                    outbnd&& = (hvns(p).orad + (hvns(p).orad * wid)) 'outer limit of planetoid/ring belt wid% orbital radius
                    bug = FrameSect(rcs(vpoint), rcp(FindParent(p)), outbnd&&, g!)
                    IF bug > 1 THEN
                        rng = INT(outbnd&& - inbnd&&)
                        'If belt/ring fills frame, then exclude it for speed & clarity.
                        bugin = FrameSect(rcs(vpoint), rcp(FindParent(p)), inbnd&&, g!)
                        bugout = FrameSect(rcs(vpoint), rcp(FindParent(p)), outbnd&&, g!)
                        IF bugin = 0 AND bugout = 1 THEN
                            'Don't display belt/ring when fully encompassing screen
                            'PUT A LOW ALPHA CALL TO [GOSUB print_name] HERE
                            'B& = NEWIMAGE(620, 620, 32)
                            'DEST B&
                            'CLEARCOLOR RGBA32(0, 0, 0, 0)
                            'Prnt hvns(p).nam, 14, 14, 100, 280, 24, 0, &H7000FF70
                            'DEST SS&
                            'PUTIMAGE , B&, SS&
                            'FREEIMAGE B&
                        ELSEIF bugout = 0 THEN
                            'Don't display when belt/ring is beyond screen
                        ELSE
                            FOR pb = 0 TO rng STEP 1 / g!
                                IF READBIT(togs, 1) THEN '                  if Z-pan toggle is true
                                    CIRCLE (OT.pX * g!, (OT.pY * (COS(D2R(zangle))) + (OT.pZ * SIN(D2R(zangle)))) * g!), (inbnd&& + pb) * g!, aster&, , , 1 * COS(D2R(zangle))
                                ELSE
                                    bug = FrameSect(rcs(vpoint), rcp(FindParent(p)), (inbnd&& + pb), g!)
                                    IF bug > 0 THEN
                                        CIRCLE (OT.pX * g!, OT.pY * g!), (inbnd&& + pb) * g!, aster&
                                    END IF
                                END IF 'end Z-pan test
                            NEXT pb
                        END IF '                                            end full frame exclusion
                    END IF
                END IF
            END IF
        END IF '                                                end planetary or belt display
    NEXT p
 
    EXIT SUB
    print_name:
    fl$ = ""
    IF zangle < 0 THEN
        fl = -1
        FOR n = LEN(TRIM$(hvns(p).nam)) TO 1 STEP -1
            fl$ = fl$ + MID$(hvns(p).nam, n, 1)
        NEXT n
    ELSE
        fl = 1
        fl$ = hvns(p).nam
    END IF
    Prnt fl$, 3.5 * fl, 3.5 * fl, (dcp(p).pX * g!) + (hvns(p).radi * g! * .7), (dcp(p).pY * g!) - (hvns(p).radi * g! * .7), 24, 0, RGBA32(200, 67, 55, 170)
    RETURN
 
END SUB 'SysMap
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB SysMapII
 
    'REDESIGN IN PROGRESS...
    DIM g! '                                                    holds result of Prop! call for this display loop
    DIM OBC AS unitpoint '                                      locates center of orbits & belt/ring systems
    DIM ctr AS unitpoint
    DIM ptr AS unitpoint
 
    g! = Prop!
    ctr = rcs(vpoint)
 
    FOR p = 1 TO orbs '                                         iterate through all bodies
 
        'ptr = dcp(p)
 
        'find orbit/belt/ring track center
        IF hvns(p).rank > 1 THEN
            OBC = rcp(FindParent(p))
        ELSE
            OBC.pX = 0: OBC.pY = 0: OBC.pZ = 0
        END IF
 
        'Planetary rendering
        IF hvns(p).star < 2 THEN
 
            'Orbit tracks
            IF READBIT(togs, 7) THEN '                          if orbit toggle is true
                p_ot = FrameSect(ctr, rcp(FindParent(p)), hvns(p).orad, g!)
                IF READBIT(togs, 1) THEN '                      if Z-pan toggle is true
                    'adjust so orbit track center moves with parent body
                    'draw all orbit tracks as some may be visible on extreme Z-pan
                CIRCLE (OBC.pX * g!, (OBC.pY * (COS(D2R(zangle))) + (OBC.pZ * SIN(D2R(zangle)))) * g!),_
                 hvns(p).orad * g!, RGBA(111, 72, 233, 70), , , 1 * COS(D2R(zangle))
                ELSE
                    IF p_ot = 3 THEN 'exclude circles that don't intersect view port to speed zoom in
                        CIRCLE (OBC.pX * g!, OBC.pY * g!), hvns(p).orad * g!, RGBA(111, 72, 233, 70)
                    END IF
                END IF
            END IF
 
            IF READBIT(togs, 9) THEN l! = hvns(p).dens ELSE l! = 1 'density or diameter jump zone
            p_jmp100% = FrameSect(ctr, rcp(p), hvns(p).radi * 200 * l!, g!)
            p_jmp10% = FrameSect(ctr, rcp(p), hvns(p).radi * 20 * l!, g!)
            p_rad% = FrameSect(ctr, rcp(p), hvns(p).radi, g!)
            IF p_jmp100% > 0 THEN
                IF READBIT(togs, 6) THEN '                      Jump zones activated
                    IF p_jmp100% > 1 THEN '                     100 diameters/densities
                        FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi * 200 * l!) * g!, RGBA(150, 116, 116, 10)
                    END IF
                    IF p_jmp10% > 1 THEN '                      10 diameters/densities
                        FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi * 20 * l!) * g!, RGBA(200, 116, 116, 5)
                    END IF
                END IF
                IF hvns(p).star = -1 THEN
                    'ADD STELLAR CLASS CORONA EFFECTS HERE AND PUT IN PLACE OF 50000
                    p_cron% = FrameSect(ctr, rcp(p), hvns(p).radi + (30 * 50000), g!)
                    IF p_cron% > 0 THEN
                        FOR x = 1 TO 30
                            p_cr_bd% = FrameSect(ctr, rcp(p), hvns(p).radi + (x * 50000), g!)
                            IF p_cr_bd% > 0 THEN
                                FCirc (dcp(p).pX) * g!, (dcp(p).pY) * g!, (hvns(p).radi + (x * 50000)) * g!, RGBA32(127, 127, 227, 31 - x)
                            END IF
                        NEXT x
                    END IF
                    c& = &HFFFC5454 '                           star photosphere color
                ELSE
                    c& = &HFF545454 '                           planet color
                END IF
                IF p_rad% > 0 THEN
                    FCirc dcp(p).pX * g!, dcp(p).pY * g!, hvns(p).radi * g!, c&
                    CIRCLE (dcp(p).pX * g!, dcp(p).pY * g!), hvns(p).radi * g!, &HFF777777
                    'display name if there's room
                    IF g! > .0003 AND hvns(p).rank = 3 THEN '       drop satellite names first
                        GOSUB print_name
                    END IF
                    IF g! > .00000003 AND hvns(p).rank = 2 THEN '   Then drop planets names
                        GOSUB print_name
                    END IF
                    IF hvns(p).star THEN '                          always keep star names visible
                        GOSUB print_name
                    END IF
 
                END IF
            END IF
 
            'Belt/ring rendering
        ELSE
            IF READBIT(togs, 10) THEN '                         belt/ring toggle
                IF hvns(p).orad * 2 * g! > 100 THEN '           only draw if big enough to see
                    aster& = &H087F7F7F '                       belt/ring color
                    IF hvns(p).dens > 0 THEN '                  belt/ring width- stored in dens element
                        wid = hvns(p).dens / 2
                    ELSE
                        wid = .15
                    END IF
                    inbnd&& = hvns(p).orad - (hvns(p).orad * wid)
                    outbnd&& = hvns(p).orad + (hvns(p).orad * wid)
                    p_bi% = FrameSect(ctr, rcp(FindParent(p)), inbnd&&, g!)
                    p_bo% = FrameSect(ctr, rcp(FindParent(p)), outbnd&&, g!)
                    IF p_bo% > 0 OR p_bi% <> 1 THEN '                         outer boundary within frame
                        IF p_bi% = 0 AND p_bo% = 1 THEN
                            'fully within the confines of the belt/ring
                        ELSE
                            rng&& = INT(outbnd&& - inbnd&&)
                            FOR pb = 0 TO rng&& STEP 1 / g!
                                IF READBIT(togs, 1) THEN '                  if Z-pan toggle is true
                                    CIRCLE (OBC.pX * g!, (OBC.pY * (COS(D2R(zangle))) + (OBC.pZ * SIN(D2R(zangle)))) * g!),_
                                     (inbnd&& + pb) * g!, aster&, , , 1 * COS(D2R(zangle))
                                ELSE
                                    frm_chk = FrameSect(ctr, rcp(FindParent(p)), (inbnd&& + pb), g!)
                                    IF frm_chk > 1 THEN
                                        CIRCLE (OBC.pX * g!, OBC.pY * g!), (inbnd&& + pb) * g!, aster&
                                    END IF
                                END IF 'end Z-pan test
                            NEXT pb
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT p
 
    EXIT SUB
    print_name:
    fl$ = ""
    IF zangle < 0 THEN
        fl = -1
        FOR n = LEN(TRIM$(hvns(p).nam)) TO 1 STEP -1
            fl$ = fl$ + MID$(hvns(p).nam, n, 1)
        NEXT n
    ELSE
        fl = 1
        fl$ = hvns(p).nam
    END IF
    Prnt fl$, 3.5 * fl, 3.5 * fl, (dcp(p).pX * g!) + (hvns(p).radi * g! * .7), (dcp(p).pY * g!) - (hvns(p).radi * g! * .7), 24, 0, RGBA32(200, 67, 55, 170)
    RETURN
 
END SUB 'SysMapII
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
FUNCTION FrameSect (active AS unitpoint, feature AS unitpoint, range AS INTEGER64, ratio AS SINGLE)
 
    'Determine feature's relation to active's viewport
    'SYNTAX: FrameSect(active unitpoint, feature center unitpoint, feature radius, result of Prop! call)
    Sact = 1415 / ratio '                                       gives display sphere radius
    dist## = PythXY(active, feature) '                          distance between active unit and feature center point
    'dist## = Pyth(active, feature) '                          distance between active unit and feature center point
 
    IF dist## > Sact + range THEN FrameSect = 0 ' feature is beyond display
    IF dist## < range - Sact THEN FrameSect = 1 ' feature encompasses entire display
    IF dist## < Sact - range THEN FrameSect = 2 ' feature is encompassed by display
    IF dist## < Sact + range AND dist## > range - Sact THEN FrameSect = 3 ' feature intersects display
 
END FUNCTION 'FrameSect
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Turn2Clock (var AS INTEGER)
 
    s = var * 1000 '                                            convert turns to seconds
    etd = INT(s / 86400) '                                      elapsed time days
    eth = INT((s - etd * 86400) / 3600) '                       elapsed time hours
    etm = INT((s - (etd * 86400 + eth * 3600)) / 60) '          elapsed time minutes
    ets = s - (etd * 86400 + eth * 3600 + etm * 60) '           elapsed time seconds
 
END SUB 'Turn2Clock
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB TruncCoord (var AS INTEGER64)
 
    'convert long coordinates to abbreviated versions
    IF ABS(var) >= 100000000 THEN
        x$ = STR$(INT(var / 1000000)) + "M"
    ELSEIF ABS(var) >= 100000000000 THEN
        x$ = STR$(INT(var / 1000000000)) + "G"
    ELSE
        x$ = STR$(var)
    END IF
    PRINT x$;
 
END SUB 'TruncCoord
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB UDest (var AS INTEGER)
 
    'Unit (var) destroyed set all vectors to zero
    cmb(var).ap = cmb(var).op
    cmb(var).Sp = 0
    Thrust(var).Azi = 0
    Thrust(var).Inc = 0
    Thrust(var).Gs = 0
 
END SUB ' UDest
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB VCS
 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '//       VCS - Viewpoint Coordinate System
    '// local coordinate system centered on active unit
    '// used to improve action of SensorMask and MouseOps
    '// sensor screen click active unit choices in the outer
    '// system by reducing absolute coordinate number ranges.
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    $CHECKING:OFF
    REDIM rcs(units) AS unitpoint '                             Relative Coordinate / Ship
    REDIM rcp(orbs) AS unitpoint '                              Relative Coordinate / Planet
    REDIM dcs(units) AS unitpoint '                             Display Coordinate / Ship
    REDIM dcp(orbs) AS unitpoint '                              Display Coordinate / Planet
    DIM ms AS MEM: ms = MEM(cmb())
    DIM mp AS MEM: mp = MEM(hvns())
    DIM msr AS MEM: msr = MEM(rcs())
    DIM msd AS MEM: msd = MEM(dcs())
    DIM mpr AS MEM: mpr = MEM(rcp())
    DIM mpd AS MEM: mpd = MEM(dcp())
 
    IF units = 0 THEN vpoint = 0
    IF READBIT(togs, 1) THEN '                                  if Z-pan toggle is true then alternate Z view coordinates
        c = 1
        DO
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 52, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 52, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE, t&& 'SAME AS
            'rcs(c).pX = (cmb(c).ap.pX - cmb(vpoint).ap.pX)
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 60, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 60, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE + 8, t&& 'SAME AS
            'rcs(c).pY = (cmb(c).ap.pY - cmb(vpoint).ap.pY)
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 68, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 68, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE + 16, t&& 'SAME AS
            'rcs(c).pZ = (cmb(c).ap.pZ - cmb(vpoint).ap.pZ)
            MEMCOPY msr, msr.OFFSET + c * msr.ELEMENTSIZE, 8 TO msd, msd.OFFSET + c * msd.ELEMENTSIZE 'SAME AS
            'dcs(c).pX = rcs(c).pX
            t&& = (MEMGET(msr, msr.OFFSET + c * msr.ELEMENTSIZE + 8, INTEGER64) * COS(D2R(zangle)))_
             + ((MEMGET(msr, msr.OFFSET + c * msr.ELEMENTSIZE + 16, INTEGER64)) * SIN(D2R(zangle)))
            MEMPUT msd, msd.OFFSET + c * msd.ELEMENTSIZE + 8, t&& 'SAME AS
            'dcs(c).pY = (rcs(c).pY * COS(_D2R(zangle))) + ((rcs(c).pZ) * SIN(_D2R(zangle)))
            t&& = (MEMGET(msr, msr.OFFSET + c * msr.ELEMENTSIZE + 8, INTEGER64) * -SIN(D2R(zangle)))_
             + ((MEMGET(msr, msr.OFFSET + c * msr.ELEMENTSIZE + 16, INTEGER64)) * COS(D2R(zangle)))
            MEMPUT msd, msd.OFFSET + c * msd.ELEMENTSIZE + 16, t&& 'SAME AS
            'dcs(c).pZ = (rcs(c).pY * -SIN(D2R(zangle))) + (rcs(c).pZ * COS(D2R(zangle)))
            c = c + 1
        LOOP UNTIL c = units + 1
        c = 1
        DO
            IF hvns(c).star <> 2 THEN
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 75, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 52, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE, t&& 'SAME AS
                'rcp(c).pX = (hvns(c).ps.pX - cmb(vpoint).ap.pX)
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 83, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 60, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 8, t&& 'SAME AS
                'rcp(c).pY = (hvns(c).ps.pY - cmb(vpoint).ap.pY)
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 91, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 68, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 16, t&& 'SAME AS
                'rcp(c).pZ = (hvns(c).ps.pZ - cmb(vpoint).ap.pZ)
                MEMCOPY mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE, 8 TO mpd, mpd.OFFSET + c * mpd.ELEMENTSIZE 'SAME AS
                'dcp(c).pX = rcp(c).pX
            t&& = (MEMGET(mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 8, INTEGER64) * COS(D2R(zangle)))_
             + ((MEMGET(mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 16, INTEGER64)) * SIN(D2R(zangle)))
                MEMPUT mpd, mpd.OFFSET + c * mpd.ELEMENTSIZE + 8, t&& 'SAME AS
                'dcp(c).pY = (rcp(c).pY * COS(_D2R(zangle))) + ((rcp(c).pZ) * SIN(_D2R(zangle)))
            t&& = (MEMGET(mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 8, INTEGER64) * -SIN(D2R(zangle)))_
             + ((MEMGET(mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 16, INTEGER64)) * COS(D2R(zangle)))
                MEMPUT mpd, mpd.OFFSET + c * mpd.ELEMENTSIZE + 16, t&& 'SAME AS
                'dcp(c).pZ = (rcp(c).pY * -SIN(D2R(zangle))) + (rcp(c).pZ * COS(D2R(zangle)))
            END IF
            c = c + 1
        LOOP UNTIL c = orbs + 1
    ELSE '                                                      Top down 2D coordinates
        c = 1
        DO
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 52, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 52, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE + 0, t&& 'rcs(c).pX = cmb(c).ap.pX - cmb(vpoint).ap.pX
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 60, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 60, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE + 8, t&& 'rcs(c).pY = cmb(c).ap.pY - cmb(vpoint).ap.pY
            t&& = MEMGET(ms, ms.OFFSET + c * ms.ELEMENTSIZE + 68, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 68, INTEGER64)
            MEMPUT msr, msr.OFFSET + c * msr.ELEMENTSIZE + 16, t&& 'rcs(c).pZ = cmb(c).ap.pZ - cmb(vpoint).ap.pZ
            MEMCOPY msr, msr.OFFSET + c * msr.ELEMENTSIZE, 24 TO msd, msd.OFFSET + c * msd.ELEMENTSIZE 'dcs(c) = rcs(c)
            c = c + 1
        LOOP UNTIL c = units + 1
        c = 1
        DO
            IF hvns(c).star <> 2 THEN
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 75, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 52, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE, t&& 'rcp(y).pX = hvns(y).ps.pX - cmb(vpoint).ap.pX
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 83, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 60, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 8, t&& 'rcp(y).pY = hvns(y).ps.pY - cmb(vpoint).ap.pY
                t&& = MEMGET(mp, mp.OFFSET + c * mp.ELEMENTSIZE + 91, INTEGER64) - MEMGET(ms, ms.OFFSET + vpoint * ms.ELEMENTSIZE + 68, INTEGER64)
                MEMPUT mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE + 16, t&& 'rcp(y).pZ = hvns(y).ps.pZ - cmb(vpoint).ap.pZ
                MEMCOPY mpr, mpr.OFFSET + c * mpr.ELEMENTSIZE, 24 TO mpd, mpd.OFFSET + c * mpd.ELEMENTSIZE 'dcp(y) = rcp(y)
            END IF
            c = c + 1
        LOOP UNTIL c = orbs + 1
    END IF
    MEMFREE ms: MEMFREE mp: MEMFREE msr: MEMFREE msd: MEMFREE mpr: MEMFREE mpd:
    $CHECKING:ON
 
END SUB 'VCS
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB VectorBrake
 
    PanelBlank 0, 650, 64, 32, &HFF0F0F0F
    Con_Blok 0, 650, 64, 32, "Applied", 0, &H502C9B2C
    DISPLAY
    DELAY .5
 
    IF cmb(vpoint).Hd >= 180 THEN Thrust(vpoint).Azi = cmb(vpoint).Hd - 180
    IF cmb(vpoint).Hd < 180 THEN Thrust(vpoint).Azi = cmb(vpoint).Hd + 180
    Thrust(vpoint).Inc = -cmb(vpoint).In
    IF cmb(vpoint).Sp / 10000 < Thrust(vpoint).Gs THEN
        Thrust(vpoint).Gs = cmb(vpoint).Sp / 10000
    END IF
    IF Thrust(vpoint).Gs > cmb(vpoint).MaxG THEN
        Thrust(vpoint).Gs = cmb(vpoint).MaxG
    END IF
 
END SUB 'VectorBrake
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB ZPanner
 
    DEST ZS&
    SCREEN ZS&
    CLS
    LINE (0, 0)-(39, 649), clr&(4), B '                         red border
    LINE (2, 2)-(37, 15), clr&(8), BF '                         top button
    LINE (2, 317)-(37, 332), clr&(8), BF '                      centering button
    LINE (2, 634)-(37, 647), clr&(8), BF '                      bottom button
    IF READBIT(togs, 1) THEN '                                  if Z-pan toggle is true
        yp = ((zangle / 90) * 310) + 325
        LINE (1, yp)-(6, yp - 5), clr&(12) '                    arrow indicator
        LINE (1, yp)-(6, yp + 5), clr&(12)
        COLOR clr&(12)
        PRINTMODE KEEPBACKGROUND
        PRINTSTRING (10, yp - 8), TRIM$(STR$(INT(90 - zangle))) + CHR$(248) 'degree value and degree symbol
    END IF
    PUTIMAGE (1204, 4), ZS&, A&
 
END SUB 'ZPanner
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Help
 
    DialogBox "HELP", 1200, 650, 25, &HFF4CCB9C, clr&(15)
    DISPLAY
    DO
        x$ = INKEY$
        PRINTSTRING (0, 639), "Press any key to continue...", A&
        DISPLAY
    LOOP UNTIL x$ <> ""
 
END SUB 'Help
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB VecAdd (var AS unitpoint, var2 AS unitpoint, var3 AS INTEGER)
 
    var.pX = var.pX + (var2.pX * var3) '                        add (or subtract) two vectors defined by unitpoint
    var.pY = var.pY + (var2.pY * var3) '                        var= base vector, var2= vector to add
    var.pZ = var.pZ + (var2.pZ * var3) '                        var3 multiple of var2 to add (-sign to subtract)
 
END SUB 'VecAdd
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB VecMult (vec AS unitpoint, multiplier AS SINGLE)
 
    'multiply vector by scalar value
    vec.pX = vec.pX * multiplier
    vec.pY = vec.pY * multiplier
    vec.pZ = vec.pZ * multiplier
 
END SUB 'VecMult
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB VecNorm (var AS unitpoint)
 
    'convert var to unit vector
    m = SQR(var.pX * var.pX + var.pY * var.pY + var.pZ * var.pZ)
    var.pX = var.pX / m
    var.pY = var.pY / m
    var.pZ = var.pZ / m
 
END SUB 'VecNorm
 
 
'±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
SUB Terminus
 
    FREEIMAGE SS&
    FREEIMAGE AW&
    FREEIMAGE ZS&
    FREEIMAGE ORI&
    FREEIMAGE flight&
    FREEIMAGE evade&
    FREEIMAGE intercept&
    FREEIMAGE cancel&
    FREEIMAGE XZ&
    FREEIMAGE IZ&
    FREEIMAGE OZ&
    FREEIMAGE RG&
    FREEIMAGE OB&
    FREEIMAGE GD&
    FREEIMAGE AZ&
    FREEIMAGE IN&
    FREEIMAGE JP&
    FREEIMAGE DI&
    FREEIMAGE DN&
    FREEIMAGE QT&
    FREEIMAGE ShpT
    FREEIMAGE ShpO
    FREEIMAGE TLoc
    FREEIMAGE TLocn
 
END SUB 'Terminus
 

CT Vec 036.zip

TempodiBasic · « **Reply #1 on:** June 16, 2019, 06:01:11 pm »

Hi OldMoses
I like this your begin version of your rpg...
waiting future developing

bplus · « **Reply #2 on:** June 16, 2019, 09:00:27 pm »

Hi OldMoses,

Wow, this is going to be something. Were you a pilot or navigator? this has realistic technical look and jargon.

OldMoses · « **Reply #3 on:** June 16, 2019, 09:54:24 pm »

Quote from: bplus on June 16, 2019, 09:00:27 pm

Hi OldMoses,

Wow, this is going to be something. Were you a pilot or navigator? this has realistic technical look and jargon.

Never did anything that cool, I'm a farmer/gamer nerd that knows just enough trig to get himself into trouble. My head's full of ideas that I likely don't have the skill to implement, but if I don't try it I achieve nothing. I gotta pump the iron to build the muscle. I started this one way back in the QBasic days, and I just couldn't get it to work much at all. Shelved it for a long time, and I'm still not sure I understand the algorithm I started developing. Now it's starting to behave and look like something with a few tweaks.

I conceived this one as more of a Gamemaster aid than an actual game in itself, but the display is starting to have a cool look to it, to where it would make a cool sensor visual for players too.

I'm working on a dynamically resizing scale grid for it now. Hoping I can get it to resize anywhere from 1 Km squares out to 1 light second squares. Once you get these things moving it's hard to slow them down, much less stop them. I guess I better add an ALL STOP button.

OldMoses · « **Reply #4 on:** June 17, 2019, 07:59:27 am »

I've installed the grid I mentioned above. As units fly farther from, or nearer to, each other the grid will resize by factors of ten as the necessary display scale changes. It was a head scratcher, but I managed to do it in 18 lines of code, in SUB SensorScreen.

I'm pushing all changes into the original posting. I assume this is good etiquette, but correct me if I'm wrong.

bplus · « **Reply #5 on:** June 17, 2019, 09:39:12 am »

Quote from: OldMoses on June 17, 2019, 07:59:27 am

...

I'm pushing all changes into the original posting. I assume this is good etiquette, but correct me if I'm wrong.

Good etiquette question might be properly discussed in Discussion board or Off-Topic, I think too distracting from your game to be discussed here. In your particular case, I agree with your choice, you are just adding to work in progress.

Petr · « **Reply #6 on:** June 17, 2019, 12:47:00 pm »

Hi Oldmoses, I'm honored. I am pleased that some of my programs are so useful for you. I was very interested in the ways of calculating space in your program. I wish you much success in further developing this program. If I can, I'll be happy to advise. So far I'm in the space novice - i am something as programmer's toddler ...

OldMoses · « **Reply #7 on:** June 17, 2019, 11:14:40 pm »

Thanks Petr, I've learned a lot from you guys in the last year or so, to the point that I felt like I could finally tackle some of the stickier aspects of this thing. I ran it through 42 turns at 14 Gs and covered something like 88 billion km with no overflow errors like the old version would do. I plugged the signed range of _INTEGER64 into a Km to lightyear converter and came up with 974911.19 ly. Seems like it has room to grow.

Tonight I pushed a quick and dirty ship editor, added range band circles to the active unit and a turn counter.

Adding the range bands revealed an aspect ratio bug, as the perfect circles should have met the grid perfectly too, but didn't. It turned out the VIEW statement in SUB ScreenLimits was out of square and was squishing the vertical axis slightly. It took a while to find that one.

OldMoses · « **Reply #8 on:** June 20, 2019, 09:52:32 am »

After some display redesign with a lot of help from the forum and a few bug hunts, I've got the latest installment.

Some mouse support has been added. Clicking on the unit name line will choose the unit as the active unit, and clicking on the menu items at the bottom left will invoke those functions.

For those who like a little drama, vector the opening unit "1 Crotalus" at 45 degrees 0 inclination and 2 G thrust. Then toggle "Turn" for 17 turns....

"OMG we're flying straight for the sun at 340 kilometers per second!!!!"

Quick!! We need a new vector! ;)

OldMoses · « **Reply #9 on:** June 28, 2019, 10:38:24 pm »

Added a few display toggles to help clean up the sensor display of things the user may not need or want
"R" toggles ranging circles for the active unit on/off
"A" toggles the azimuth wheel display on/off
"G" toggles the grid on/off
Just some easy peasy stuff, while working myself up to tackle thornier puzzles.

Also put in some quick and dirty solar system details just to see how it would work

Forgive the artifact numbers displayed on the left, they're debugging feedback for tweaking the mouse locating equations Steve showed me.

OldMoses · « **Reply #10 on:** July 01, 2019, 08:28:21 pm »

Todays additions are a zoom function. The program defaults to a 'zoom extents' display that resizes to keep all units on the screen. This can now be bypassed to zoom in on areas around the active unit, or zoom out to get "the bigger picture". Hotkey "+" zooms in on the active unit, "-" zooms out to wider views. Hotkey "X" returns to the default state.

I also added image buttons for vector solutions, specifically to evade or to intercept an opponent. The buttons work, as evidenced by the momentary string display unique to each, but the actual algorithms are still in the conceptual stage. More easy peasy...

"But Mommy, I don't wanna do the math..." ;)

I find that I tend to program to the display and try to shoe horn the actual data crunching into it later.

OldMoses · « **Reply #11 on:** July 04, 2019, 12:42:51 am »

Still avoiding math, I am the arch procrastinator.

Added randomly placed, stationary planetary and stellar bodies along their orbit tracks. Perfect circle orbits at this stage. Damn, but space is big! Moving to a planet is like finding the needle in a haystack without some flight plan feedback. Maybe something for later.

The planets don't move or exert gravity...yet...

While able to zoom out to interstellar scales, I find the program gets really glitchy when zooming in to around 10,000km per grid. Stellar auras start cropping up where they don't belong as well as planets appearing in odd places. That's a head scratcher for sure.

My son suggested a counterthrust feature which I've implemented, proud father that I am. He's a thinker, that one. It's as good as having a break pedal. When queried for an azimuth in the vector input, typing "c" [enter] automatically applies the exact opposite thrust to the ship's heading. "All stop, Scotty."

OldMoses · « **Reply #12 on:** July 06, 2019, 07:41:02 pm »

Added a rather neandertal intercept/evade subroutine, some more sophisticated math should make it a little smarter. Any unit tasked with evading or intercepting another unit will attempt to flee from, or close with, that chosen unit, respectively. The algorithm is dead simple and sometimes results in a "rebounding spring" effect during interceptions. Too much pedal to the metal...

Added some interstellar points, the Alpha Centauri complex as well as Barnard's Star, Wolf 359, Sirius and even Betelgeuse (222 parsecs distant). All as a quick and dirty test just to see the program zoom them all in proportion to each other. The actual placement is probably wrong with respect to galactic positioning, but I just converted right ascension coordinates to what was already set up in the program. It did help me to find and swat a persistent bug that was placing ghost images in the display at certain zoom factors. I probably won't implement things on that scale ultimately, but it's amusing to see QB64 field it nicely.

The bug turned out to be that I was using SUB fcirc; to fill celestial body orbs, stars and coronas, which was originally designed with INTEGER values for X & Y, but in my application it needed _INTEGER64 due to the extreme distances and sizes. My poor ships kept finding themselves in the core of Betelgeuse as fcirc couldn't figure out where to place it. It's a long way off...

Whew!....gotta love it....

Close in zooming still bogs down, but this is a vast improvement.

OldMoses · « **Reply #13 on:** July 10, 2019, 11:40:31 pm »

Fleshed out the system details.

Planets now "orbit", that is, they change position based upon the turn based time criteria. They also have moons that orbit them via the same algorithm. Moons and inner planets move noticeably, the outer planets... eh...not sure. They are subjected to the same process, but the effect is too small to see. I'll have to watch the coordinate data to tell. The process is data based rather than gravity computational, in keeping with the nature of a game utility as opposed to an astrophysics simulator.

I generally only included the biggest moons. When you're a planet walking around, swinging moons, size matters.

OldMoses · « **Reply #14 on:** July 14, 2019, 02:45:19 pm »

Ship vectors are now affected by gravity generated by nearby celestial bodies. "Nearby" being a function of the relative strength of that body's gravity. The numbers seem to track pretty well with game conventions. The Sun will reach out quite a ways, while smaller planets less so. Infinitesimally small gravity numbers are discarded. Neptune won't mess with you while you're flying around Mars.

It's been amusing trying to get a stable orbit on a moving planet, which I assume is theoretically possible, but maybe not. I usually end up spiraling in and crashing. The distance and vector would have to be very precise.

I also added a rudimentary crash routine, though that will need some work. It presently checks if the vector midpoint is within a star/planet radius. The take away from that is, if you are going fast enough, you can still fly clean through.

News:

Author Topic: WIP: Dog fight in space...sort of... (Read 10501 times)

OldMoses

WIP: Dog fight in space...sort of...

TempodiBasic

Re: WIP: Dog fight in space...sort of...

bplus

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

bplus

Re: WIP: Dog fight in space...sort of...

Petr

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...

OldMoses

Re: WIP: Dog fight in space...sort of...