Author Topic: Beyond The Stars (alpha) (Read 6970 times)

romichess · « **on:** January 15, 2020, 01:04:46 am »

With the inclusion of a crude game menu including a save game to file and load game from file I guess this is now a "complete" (not completed) game and can qualify as an alpha version.

Beyond.txt

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
 
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * 5) + 2
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    jay = 100
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 0
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist < 251 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                IF ok = 1 THEN
                                    dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                    IF dist < away THEN
                                        IF LL > 299 THEN
                                            away = dist
                                            jay = j
                                        ELSE
                                            IF star(i).t > star(j).t * 3 + dist / 4 - star(j).p ^ 2 THEN
                                                away = dist
                                                jay = j
                                            END IF
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF LL > 299 AND star(i).t < star(jay).t * 3 THEN jay = 100
                    IF jay < 100 THEN
                        SendFleet i, jay, star(i).t / 2
                        star(jay).d = 400
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 1.5 + star(i).p * 100 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$, gp
    LINE (80, 100)-(880, 100), 0
    COLOR 0, 7
    LINE (394, 180)-(566, 260), 7, BF
    _PRINTSTRING (408, 184), "Save", gp
    LINE (390, 360)-(570, 440), 7, BF
    _PRINTSTRING (400, 364), "Load", gp
    _FONT ttf36
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            I = Identify
            IF I = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 THEN
        I = Identify
        IF I = 100 AND src = 100 THEN
            gact = 1
            paused = 1
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 8 AND ABS(dy) <= star(i).s + 8 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 17
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            x1 = sw / 4 + 394: x2 = x1 + 172: y1 = sh / 4 + 180: y2 = y1 + 80
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN SaveGame: gact = 0
            x1 = sw / 4 + 390: x2 = x1 + 180: y1 = sh / 4 + 360: y2 = y1 + 80
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN LoadGame: gact = 0
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame
    OPEN "savegame.sav" FOR BINARY AS #2
    GET #2, , star()
    GET #2, , order()
    GET #2, , fleet()
    GET #2, , home()
    GET #2, , fltcnt
    GET #2, , LL
    CLOSE #2
    PRINT "Game Loaded"
END SUB
 
SUB SaveGame
    OPEN "savegame.sav" FOR BINARY AS #1
    CLOSE #1
    KILL "savegame.sav"
    OPEN "savegame.sav" FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 2
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            x = RND * (sw - sww) + swn
            y = RND * (sh - shw) + shn
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    FOR i = 1 TO 6
        ok = 0
        WHILE (ok < 1)
            ok = 1
            j = RND * 100
            FOR k = 1 TO i - 1
                dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                IF dist < 500 * ratio THEN
                    ok = 0
                    EXIT FOR
                END IF
            NEXT
            IF ok = 1 THEN
                ok = -1
                FOR k = 0 TO 99
                    dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                    IF dist <= 200 THEN ok = ok + 1
                    IF ok = 2 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
        star(j).s = 4
    NEXT
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "Quazzat"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 
 
 
 

Pete · « **Reply #1 on:** January 15, 2020, 02:31:20 am »

Neat star map...

Rating: I gave it 5 stars... and one of them was half filled in! :D

Kidding aside, I really liked it!

Pete

romichess · « **Reply #2 on:** January 15, 2020, 03:18:24 am »

Quote from: Pete on January 15, 2020, 02:31:20 am

Neat star map...

Rating: I gave it 5 stars... and one of them was half filled in! :D

Kidding aside, I really liked it!

Pete

Well I'll be darned, I do believe that thar there was a genuine compliment! :)

Kazman · « **Reply #3 on:** January 15, 2020, 05:52:05 am »

I'm going to test the game right now! :)

romichess · « **Reply #4 on:** January 15, 2020, 11:08:59 am »

Quote from: Kazman on January 15, 2020, 05:52:05 am

I'm going to test the game right now! :)

Cool! Testers are different from players. Testers are expected to make a report. Testers that do not report are downgraded to player, LOL. :)

romichess · « **Reply #5 on:** January 17, 2020, 02:30:03 pm »

When in a hurry it was too easy to miss with a left mouse click and bring up the game panel by accident. Now a left click on the screen will only bring up the game panel if the game is paused. So when the game is not paused just a right click on the screen to pause the game and a left click to bring up the game panel. Also there is a big improvement to the AI.

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
 
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * 5) + 2
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away = 10000
                    jay = 100
                    FOR j = 0 TO 99
                        dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                        IF star(j).o <> id AND star(j).o = o AND star(i).t > star(j).t * 5 + (dist * (o > 0)) THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                            IF dist < away THEN
                                                away = dist
                                                jay = j
                                            END IF
                                        END IF
                                    END IF
                                NEXT
                            END IF
                        END IF
                    NEXT
                    IF jay < 100 THEN
                        SendFleet i, jay, star(i).t / 3
                        star(jay).d = 400
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 1.5 + star(i).p * 50 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$, gp
    LINE (80, 100)-(880, 100), 0
    COLOR 0, 7
    LINE (394, 180)-(566, 260), 7, BF
    _PRINTSTRING (408, 184), "Save", gp
    LINE (390, 360)-(570, 440), 7, BF
    _PRINTSTRING (400, 364), "Load", gp
    _FONT ttf36
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
            lclk = 0
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 8 AND ABS(dy) <= star(i).s + 8 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 17
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            x1 = sw / 4 + 394: x2 = x1 + 172: y1 = sh / 4 + 180: y2 = y1 + 80
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN SaveGame: gact = 0
            x1 = sw / 4 + 390: x2 = x1 + 180: y1 = sh / 4 + 360: y2 = y1 + 80
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN LoadGame: gact = 0
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame
    OPEN "savegame.sav" FOR BINARY AS #2
    GET #2, , star()
    GET #2, , order()
    GET #2, , fleet()
    GET #2, , home()
    GET #2, , fltcnt
    GET #2, , LL
    CLOSE #2
    PRINT "Game Loaded"
END SUB
 
SUB SaveGame
    OPEN "savegame.sav" FOR BINARY AS #1
    CLOSE #1
    KILL "savegame.sav"
    OPEN "savegame.sav" FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            x = RND * (sw - sww) + swn
            y = RND * (sh - shw) + shn
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    FOR i = 1 TO 6
        ok = 0
        WHILE (ok < 1)
            ok = 1
            j = RND * 100
            FOR k = 1 TO i - 1
                dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                IF dist < 500 * ratio THEN
                    ok = 0
                    EXIT FOR
                END IF
            NEXT
            IF ok = 1 THEN
                ok = -1
                FOR k = 0 TO 99
                    dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                    IF dist <= 200 THEN ok = ok + 1
                    IF ok = 2 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
        star(j).s = 4
    NEXT
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 

romichess · « **Reply #6 on:** January 19, 2020, 01:26:12 am »

Fixed a bug. Can't remember what it was. Made a better game panel. Has up to 10 (0-9) saved games. Also added custom star maps. The custom starmap can only be set up at the very start of the game. As soon as the game comes up activate the game panel by left clicking the starmap. Then click on custom mode. The custom mode box will change color. Right click to close the game panel. Move the stars around! Save your custom starmap! :) Oh yeah, click "Custom Mode" again to continue game.

Code: QB64: [Select]

 TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED lmb AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * 5) + 2
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 1
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                            END IF
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away1 THEN
                                IF away1 < away2 THEN
                                    away2 = away1
                                    jay2 = jay1
                                END IF
                                away1 = dist
                                jay1 = j
                            ELSE
                                IF dist < away2 THEN
                                    away2 = dist
                                    jay2 = j
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(i).t / 1.5
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(i).t / 1.5
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 1.5 + star(i).p * 50 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    FOR i = 143 TO 874 STEP 81
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 7
    IF cm = 1 THEN c = 168
    l = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            IF fltcnt = 0 THEN
                _FONT ttf36
                x1 = 40 + sw / 4: x2 = x1 + 20 + _PRINTWIDTH("Custom Mode"): y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                END IF
            END IF
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            x = RND * (sw - sww) + swn
            y = RND * (sh - shw) + shn
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    FOR i = 1 TO 6
        ok = 0
        WHILE (ok < 1)
            ok = 1
            j = RND * 100
            FOR k = 1 TO i - 1
                dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                IF dist < 500 * ratio THEN
                    ok = 0
                    EXIT FOR
                END IF
            NEXT
            IF ok = 1 THEN
                ok = -1
                FOR k = 0 TO 99
                    dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                    IF dist <= 200 THEN ok = ok + 1
                    IF ok = 2 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
        star(j).s = 4
    NEXT
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 

romichess · « **Reply #7 on:** January 19, 2020, 03:15:25 am »

Fixed another small bug. This one I remember, "end if" in wrong place. Added "Demo Mode" to the game panel. Left click on "Demo Mode" and the computer will play for the human. Left click again to place back in human play mode. However, the human can still enter orders while in demo mode.

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED dm AS INTEGER
DIM SHARED lmb AS INTEGER
DIM SHARED ncp AS INTEGER
DIM SHARED bmp AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
ncp = 5
bmp = 2
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * ncp) + bmp
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 1
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                IF dist < away1 THEN
                                    IF away1 < away2 THEN
                                        away2 = away1
                                        jay2 = jay1
                                    END IF
                                    away1 = dist
                                    jay1 = j
                                ELSE
                                    IF dist < away2 THEN
                                        away2 = dist
                                        jay2 = j
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(i).t / 1.5
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(i).t / 1.5
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 1.5 + star(i).p * 50 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    FOR i = 143 TO 874 STEP 81
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 7
    IF cm = 1 THEN c = 168
    l = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    n$ = "Demo Mode"
    c = 7
    IF dm = 1 THEN c = 168
    l2 = _PRINTWIDTH(n$)
    LINE (80 + l, 235)-(100 + l + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (90 + l, 250), n$
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            IF fltcnt = 0 THEN
                _FONT ttf36
                x1 = 40 + sw / 4: x2 = x1 + 20 + _PRINTWIDTH("Custom Mode"): y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                END IF
            END IF
            _FONT ttf36
            x1 = 80 + sw / 4 + _PRINTWIDTH("Custom Mode"): x2 = x1 + 20 + _PRINTWIDTH("Demo Mode")
            y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                dm = 1 - dm
                IF dm = 0 THEN
                    ncp = 5
                    bmp = 2
                ELSE
                    ncp = 6
                    bmp = 1
                END IF
            END IF
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            x = RND * (sw - sww) + swn
            y = RND * (sh - shw) + shn
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    FOR i = 1 TO 6
        ok = 0
        WHILE (ok < 1)
            ok = 1
            j = RND * 100
            FOR k = 1 TO i - 1
                dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                IF dist < 500 * ratio THEN
                    ok = 0
                    EXIT FOR
                END IF
            NEXT
            IF ok = 1 THEN
                ok = -1
                FOR k = 0 TO 99
                    dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                    IF dist <= 200 THEN ok = ok + 1
                    IF ok = 2 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
        star(j).s = 4
    NEXT
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 
 

romichess · « **Reply #8 on:** January 19, 2020, 07:59:15 am »

I think that I fixed another bug but I'm not sure--way past my bedtime. Added a rectangular map and new game. If anyone wants to play on a rectangular map then click "Rectangle" and then click "New Game". gn!

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED dm AS INTEGER
DIM SHARED rm AS INTEGER
DIM SHARED lmb AS INTEGER
DIM SHARED ncp AS INTEGER
DIM SHARED bmp AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
ncp = 5
bmp = 2
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * ncp) + bmp
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 1
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                IF ok = 1 THEN
                                    dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                    IF dist < away1 THEN
                                        IF away1 < away2 THEN
                                            away2 = away1
                                            jay2 = jay1
                                        END IF
                                        away1 = dist
                                        jay1 = j
                                    ELSE
                                        IF dist < away2 THEN
                                            away2 = dist
                                            jay2 = j
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(i).t / 1.5
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(i).t / 1.5
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 1.5 + star(i).p * 50 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    speed = 0
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    FOR i = 143 TO 874 STEP 81
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 7
    IF cm = 1 THEN c = 168
    l2 = 0
    l1 = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l1, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    n$ = "Demo Mode"
    c = 7
    IF dm = 1 THEN c = 168
    l2 = l1
    l1 = _PRINTWIDTH(n$)
    LINE (76 + l2, 235)-(96 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (86 + l2, 250), n$
    n$ = "Rectangle"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    c = 7
    IF rm = 1 THEN c = 168
    LINE (112 + l2, 235)-(132 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (122 + l2, 250), n$
    n$ = "New Game"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (148 + l2, 235)-(168 + l1 + l2, 295), 7, BF
    COLOR 0, 7
    _PRINTSTRING (158 + l2, 250), n$
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 AND gact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
            lclk = 0
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            _FONT ttf36
            l2 = 0
            l1 = _PRINTWIDTH("Custom Mode")
            IF fltcnt = 0 THEN
                x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                END IF
            END IF
            l2 = l1
            l1 = _PRINTWIDTH("Demo Mode")
            x1 = 76 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                dm = 1 - dm
                IF dm = 0 THEN
                    ncp = 5
                    bmp = 2
                ELSE
                    ncp = 6
                    bmp = 1
                END IF
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("Rectangle")
            x1 = 112 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                rm = 1 - rm
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("New Game")
            x1 = 148 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                gact = 0
                NewGame
            END IF
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
        dm = 0
        cm = 0
        ncp = 5
        bmp = 2
        it = 0
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            ok = 0
            DO
                x = RND * (sw - sww) + swn
                y = RND * (sh - shw) + shn
                ok = -1
                IF rm = 1 AND x > sw / 4 AND x < sw - sw / 4 AND y > sh / 4 AND y < sh - sh / 4 THEN ok = 0
            LOOP UNTIL ok
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    FOR i = 1 TO 6
        ok = 0
        WHILE (ok < 1)
            ok = 1
            j = RND * 100
            FOR k = 1 TO i - 1
                dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                IF dist < 500 * ratio THEN
                    ok = 0
                    EXIT FOR
                END IF
            NEXT
            IF ok = 1 THEN
                ok = -1
                FOR k = 0 TO 99
                    dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                    IF dist <= 200 THEN ok = ok + 1
                    IF ok = 2 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
        star(j).s = 4
    NEXT
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    ncp = 5
    bmp = 2
    dm = 0
    speed = 0
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 

Aurel · « **Reply #9 on:** January 20, 2020, 07:30:38 am »

Program is interesting,but i don't get it how to play...stupid me
Anyway i don't know why qb64 need 1 minute to compile 53kB program on my dual-core pentium computer
win7 ultimatePro 32 bit ?

I use my own editor but i am forced to use qb ide to compile and run program.
must be something with unknown command line ???

romichess · « **Reply #10 on:** January 20, 2020, 01:01:51 pm »

Quote from: Aurel on January 20, 2020, 07:30:38 am

Program is interesting,but i don't get it how to play...stupid me
Anyway i don't know why qb64 need 1 minute to compile 53kB program on my dual-core pentium computer
win7 ultimatePro 32 bit ?

I use my own editor but i am forced to use qb ide to compile and run program.
must be something with unknown command line ???

"i don't get it how to play"
That is more my deficiency for not explaining that well enough. The human is the color blue. The human player's home star is Sol. Sol starts off with 100 ships as do the computer players on their home worlds. The player can send ships from one of their stars to another star by clicking on one of their stars and then left clicking on any star within range. The goal is to capture other stars until the player has conquered all 100 stars. I hope that you will give it another try. :)

Beyond.txt

Aurel · « **Reply #11 on:** January 20, 2020, 03:06:33 pm »

well OK ,,i will try again

romichess · « **Reply #12 on:** January 21, 2020, 05:52:01 am »

Added Play a Duel to the game menu. One human, one computer in opposite corners go after each other. I thought it was worth an update.

Beyond.txt

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED dm AS INTEGER
DIM SHARED rm AS INTEGER
DIM SHARED duel AS INTEGER
DIM SHARED lmb AS INTEGER
DIM SHARED ncp AS INTEGER
DIM SHARED bmp AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
ncp = 5
bmp = 2
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        IF duel = 1 THEN id = 2 ELSE id = INT(RND * ncp) + bmp
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 0
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                IF ok = 1 THEN
                                    dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                    IF dist < away1 THEN
                                        IF away1 < away2 THEN
                                            away2 = away1
                                            jay2 = jay1
                                        END IF
                                        away1 = dist
                                        jay1 = j
                                    ELSE
                                        IF dist < away2 THEN
                                            away2 = dist
                                            jay2 = j
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(i).t / 1.5
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(i).t / 1.5
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * .25 * star(i).p THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    speed = 0
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    FOR i = 143 TO 874 STEP 81
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 7
    IF cm = 1 THEN c = 168
    l2 = 0
    l1 = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l1, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    n$ = "Demo Mode"
    c = 7
    IF dm = 1 THEN c = 168
    l2 = l1
    l1 = _PRINTWIDTH(n$)
    LINE (76 + l2, 235)-(96 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (86 + l2, 250), n$
    n$ = "Rectangle"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    c = 7
    IF rm = 1 THEN c = 168
    LINE (112 + l2, 235)-(132 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (122 + l2, 250), n$
    n$ = "New Game"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (148 + l2, 235)-(168 + l1 + l2, 295), 7, BF
    COLOR 0, 7
    _PRINTSTRING (158 + l2, 250), n$
    n$ = "Play a Duel"
    l1 = _PRINTWIDTH(n$)
    LINE (40, 310)-(60 + l1, 370), 7, BF
    _PRINTSTRING (50, 325), n$
    COLOR 7, 8
    n$ = "Right Click To Cancel"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 AND gact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
            lclk = 0
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            _FONT ttf36
            l2 = 0
            l1 = _PRINTWIDTH("Custom Mode")
            IF fltcnt = 0 THEN
                x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                END IF
            END IF
            l2 = l1
            l1 = _PRINTWIDTH("Demo Mode")
            x1 = 76 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                dm = 1 - dm
                IF dm = 0 THEN
                    ncp = 5
                    bmp = 2
                ELSE
                    ncp = 6
                    bmp = 1
                END IF
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("Rectangle")
            x1 = 112 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                rm = 1 - rm
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("New Game")
            x1 = 148 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                gact = 0
                NewGame
            END IF
            l1 = _PRINTWIDTH("Play a Duel")
            x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 310 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                gact = 0
                duel = 1
                NewGame
            END IF
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
        dm = 0
        cm = 0
        ncp = 5
        bmp = 2
        it = 0
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    DIM low AS LONG
    DIM high AS LONG
    DIM tot AS LONG
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            ok = 0
            DO
                x = RND * (sw - sww) + swn
                y = RND * (sh - shw) + shn
                ok = -1
                IF rm = 1 AND x > sw / 4 AND x < sw - sw / 4 AND y > sh / 4 AND y < sh - sh / 4 THEN ok = 0
            LOOP UNTIL ok
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    low = 10000000
    high = 0
    IF duel = 1 THEN
        FOR j = 0 TO 99
            x = star(j).x
            y = star(j).y
            tot = x * y
            IF tot < low THEN
                low = tot
                a = j
            END IF
            IF tot > high THEN
                high = tot
                b = j
            END IF
        NEXT
        home(1) = a
        star(a).o = 1
        star(a).p = 10
        star(a).t = 100
        star(a).s = 4
        star(a).n = "Sol"
        star(a).c = 14
 
        home(2) = b
        star(b).o = 2
        star(b).p = 10
        star(b).t = 100
        star(b).s = 4
    ELSE
        FOR i = 1 TO 6
            ok = 0
            WHILE (ok < 1)
                ok = 1
                j = RND * 100
                FOR k = 1 TO i - 1
                    dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                    IF dist < 500 * ratio THEN
                        ok = 0
                        EXIT FOR
                    END IF
                NEXT
                IF ok = 1 THEN
                    ok = -1
                    FOR k = 0 TO 99
                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                        IF dist <= 200 THEN ok = ok + 1
                        IF ok = 2 THEN EXIT FOR
                    NEXT
                END IF
            WEND
            home(i) = j
            star(j).o = i
            star(j).p = 10
            star(j).t = 100
            star(j).s = 4
        NEXT
    END IF
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    ncp = 5
    bmp = 2
    dm = 0
    speed = 0
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 

romichess · « **Reply #13 on:** January 25, 2020, 03:44:52 am »

Added a few cool updates. An exit game button in the upper right hand corner of the game Panel. I have to add a save game on exit. Game stats are now displayed at the bottom of the game panel. And the colored stat boxes double as a color picker. Now you can click on another color at any time if you prefer to play with a different color. And beware the computer players expand in the beginning much faster now making the start of the game even more challenging. Also it seems the computer plays even better now! Also one of the star names has been changed to QB64! :)

Code: QB64: [Select]

TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED dm AS INTEGER
DIM SHARED rm AS INTEGER
DIM SHARED duel AS INTEGER
DIM SHARED lmb AS INTEGER
DIM SHARED ncp AS INTEGER
DIM SHARED bmp AS INTEGER
DIM SHARED colors(7) AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
ncp = 5
bmp = 2
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
NewGame
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        IF duel = 1 THEN id = 2 ELSE id = INT(RND * ncp) + bmp
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 0
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                IF ok = 1 THEN
                                    dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                    IF dist < away1 THEN
                                        IF away1 < away2 THEN
                                            away2 = away1
                                            jay2 = jay1
                                        END IF
                                        away1 = dist
                                        jay1 = j
                                    ELSE
                                        IF dist < away2 THEN
                                            away2 = dist
                                            jay2 = j
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(jay1).t * 2 + 10
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(jay2).t * 2 + 10
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 2 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    speed = 0
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    LINE (910, 10)-(950, 50), 7, BF
    _PRINTSTRING (921, 11), "x"
    FOR i = 146 TO 886 STEP 82
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 7
    IF cm = 1 THEN c = 168
    l2 = 0
    l1 = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l1, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    n$ = "Demo Mode"
    c = 7
    IF dm = 1 THEN c = 168
    l2 = l1
    l1 = _PRINTWIDTH(n$)
    LINE (76 + l2, 235)-(96 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (86 + l2, 250), n$
    n$ = "Rectangle"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    c = 7
    IF rm = 1 THEN c = 168
    LINE (112 + l2, 235)-(132 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (122 + l2, 250), n$
    n$ = "New Game"
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (148 + l2, 235)-(168 + l1 + l2, 295), 7, BF
    COLOR 0, 7
    _PRINTSTRING (158 + l2, 250), n$
    n$ = "Play a Duel"
    l1 = _PRINTWIDTH(n$)
    LINE (40, 310)-(60 + l1, 370), 7, BF
    _PRINTSTRING (50, 325), n$
    _FONT ttf24
    FOR i = 134 TO 874 STEP 134
        j = j + 1
        prod = 0
        ship = 0
        FOR k = 0 TO 99
            IF star(k).o = j THEN
                prod = prod + star(k).p
                ship = ship + star(k).t
            END IF
        NEXT
        LINE (i, 386)-(i + 120, 490), colors(j), BF
        COLOR 0, colors(j)
        _PRINTSTRING (i, 408), STR$(prod)
        _PRINTSTRING (i, 448), STR$(ship)
    NEXT
    _FONT ttf36
    COLOR 7, 8
    _PRINTSTRING (40, 400), "Prod:"
    _PRINTSTRING (40, 444), "Ship:"
    n$ = "           Left Click Color Picker      Right Click To Close"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 AND gact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
            lclk = 0
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, colors(fleet(i).o)
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), colors(o), c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            x1 = sw / 4 + 910: x2 = x1 + 40: y1 = sh / 4 + 10: y2 = y1 + 40
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                ch = CHR$(27)
            END IF
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            _FONT ttf36
            l2 = 0
            l1 = _PRINTWIDTH("Custom Mode")
            IF fltcnt = 0 THEN
                x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                END IF
            END IF
            l2 = l1
            l1 = _PRINTWIDTH("Demo Mode")
            x1 = 76 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                dm = 1 - dm
                IF dm = 0 THEN
                    ncp = 5
                    bmp = 2
                ELSE
                    ncp = 6
                    bmp = 1
                END IF
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("Rectangle")
            x1 = 112 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                rm = 1 - rm
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("New Game")
            x1 = 148 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                gact = 0
                NewGame
            END IF
            l1 = _PRINTWIDTH("Play a Duel")
            x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 310 + sh / 4: y2 = y1 + 60
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                gact = 0
                duel = 1
                NewGame
            END IF
            FOR i = 134 TO 874 STEP 134
                j = j + 1
                x1 = sw / 4 + i: x2 = x1 + 124: y1 = sh / 4 + 386: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    tmp = colors(1)
                    colors(1) = colors(j)
                    colors(j) = tmp
                END IF
            NEXT
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
        dm = 0
        cm = 0
        ncp = 5
        bmp = 2
        it = 0
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                END IF
                IF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                END IF
                IF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    DIM low AS LONG
    DIM high AS LONG
    DIM tot AS LONG
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            ok = 0
            DO
                x = RND * (sw - sww) + swn
                y = RND * (sh - shw) + shn
                ok = -1
                IF rm = 1 AND x > sw / 4 AND x < sw - sw / 4 AND y > sh / 4 AND y < sh - sh / 4 THEN ok = 0
            LOOP UNTIL ok
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    low = 10000000
    high = 0
    IF duel = 1 THEN
        FOR j = 0 TO 99
            x = star(j).x
            y = star(j).y
            tot = x * y
            IF tot < low THEN
                low = tot
                a = j
            END IF
            IF tot > high THEN
                high = tot
                b = j
            END IF
        NEXT
        home(1) = a
        star(a).o = 1
        star(a).p = 10
        star(a).t = 100
        star(a).s = 4
        star(a).n = "Sol"
        star(a).c = 14
 
        home(2) = b
        star(b).o = 2
        star(b).p = 10
        star(b).t = 100
        star(b).s = 4
    ELSE
        FOR i = 1 TO 6
            ok = 0
            WHILE (ok < 1)
                ok = 1
                j = RND * 100
                FOR k = 1 TO i - 1
                    dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                    IF dist < 500 * ratio THEN
                        ok = 0
                        EXIT FOR
                    END IF
                NEXT
                IF ok = 1 THEN
                    ok = -1
                    FOR k = 0 TO 99
                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                        IF dist <= 200 THEN ok = ok + 1
                        IF ok = 2 THEN EXIT FOR
                    NEXT
                END IF
            WEND
            home(i) = j
            star(j).o = i
            star(j).p = 10
            star(j).t = 100
            star(j).s = 4
            colors(i) = i + 8
        NEXT
    END IF
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    ncp = 5
    bmp = 2
    dm = 0
    speed = 0
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 
 
 

romichess · « **Reply #14 on:** January 27, 2020, 02:08:07 am »

Added some more options to the game panel.
WARNING: Previous saved games will crash the program - delete them.

Beyond.txt

Code: QB64: [Select]

$CHECKING:OFF
TYPE stars
    n AS STRING * 10 '                 Name of star
    x AS INTEGER '                     x-position
    y AS INTEGER '                     y-position
    o AS INTEGER '                     Owner
    c AS INTEGER '                     Color
    s AS INTEGER '                     Size
    t AS LONG '                        Ships
    p AS INTEGER '
    d AS INTEGER '                   (Population) For now ships production
END TYPE
 
TYPE FLEETS
    t AS LONG
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
TYPE ORDERS
    src AS LONG
    ovr AS LONG
    shp AS LONG
    dst AS LONG
END TYPE
 
' Global variables shared because they are needed in more than one routine
DIM SHARED sw AS INTEGER '             Screen Width
DIM SHARED sh AS INTEGER '             Screen Height
DIM SHARED sww AS INTEGER '            Screen Width Wide margin
DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
DIM SHARED shw AS INTEGER '            Screen Height Wide margine
DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
DIM SHARED nw AS INTEGER '             games Natural screen Width
DIM SHARED nh AS INTEGER '             games Natural screen Height
DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
DIM SHARED star(100) AS stars '        100 stars - may change
DIM SHARED qstar(100) AS stars
DIM SHARED names(200) AS STRING * 10 ' 200 star names
DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
DIM SHARED home(7) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
DIM SHARED qhome(7) AS INTEGER
DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
DIM SHARED x AS INTEGER
DIM SHARED y AS INTEGER
DIM SHARED lcx AS INTEGER
DIM SHARED rcx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED sp AS LONG
DIM SHARED op AS LONG
DIM SHARED wp AS LONG
DIM SHARED gp AS LONG
DIM SHARED lclk AS LONG
DIM SHARED rclk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf16 AS LONG
DIM SHARED ttf24 AS LONG
DIM SHARED ttf36 AS LONG
DIM SHARED ttf72 AS LONG
DIM SHARED fleet(2000) AS FLEETS
DIM SHARED qfleet(2000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED qfltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED qLL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact AS INTEGER
DIM SHARED gact AS INTEGER
DIM SHARED wact AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED panx, pany AS INTEGER
DIM SHARED oanx, oany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 14
DIM SHARED value AS LONG
DIM SHARED id AS INTEGER
DIM SHARED paused AS INTEGER
DIM SHARED src AS INTEGER
DIM SHARED dst AS INTEGER
DIM SHARED strng0 AS STRING * 10
DIM SHARED strng1 AS STRING * 10
DIM SHARED order(100) AS ORDERS
DIM SHARED qorder(100) AS ORDERS
DIM SHARED box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED cm AS INTEGER
DIM SHARED dm AS INTEGER
DIM SHARED rm AS INTEGER
DIM SHARED sm AS INTEGER
DIM SHARED gm AS INTEGER
DIM SHARED duel AS INTEGER
DIM SHARED lmb AS INTEGER
DIM SHARED ncp AS INTEGER
DIM SHARED bmp AS INTEGER
DIM SHARED colors(7) AS INTEGER
 
sw = _DESKTOPWIDTH '                   native video with of syatem
sww = sw / 24 '                        margin based on native video width to keep stars away from edge
swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
nw = 1920
 
ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
 
sh = _DESKTOPHEIGHT
shw = sh / 20
shn = sh / 40
nh = 1080
 
tt = 0
lcx = sw
rcx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
strng0 = ""
strng1 = ""
src = 100
dst = 100
ord.src = 100
ncp = 5
bmp = 2
gact = 1
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
wp = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
gp = _NEWIMAGE(960 * ratio, 540 * ratio, 256)
 
StarNames
 
ttf16 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf24 = _LOADFONT("cyberbit.ttf", 24 * ratio, "BOLD")
ttf36 = _LOADFONT("cyberbit.ttf", 36 * ratio, "BOLD")
ttf72 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
NewGame
 
IF _FILEEXISTS("savegame.sav") THEN
    LoadGame "savegame"
    gact = 0
END IF
 
repeat = 1
 
WHILE repeat
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        Update
 
        GetInput
 
        Player
 
    NEXT
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    IF paused = 0 THEN
        id = INT(RND * ncp) + bmp
        i = home(id)
        IF star(i).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: i = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                IF star(i).t > LL THEN
                    away = 10000
                    FOR j = 0 TO 99
                        IF star(j).o <> id THEN
                            dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                            IF dist < away THEN
                                away = dist
                                o = star(j).o
                            END IF
                        END IF
                    NEXT
                    away1 = 10000
                    away2 = 10000
                    jay1 = 100
                    jay2 = 100
                    FOR j = 0 TO 99
                        IF star(j).o = o THEN
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                ok = 0
                                FOR k = 0 TO 99
                                    IF star(k).o = id THEN
                                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                                        IF dist <= 250 THEN
                                            ok = 1
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                                IF ok = 1 THEN
                                    dist = SQR(ABS(star(j).x - star(i).x) ^ 2 + ABS(star(j).y - star(i).y) ^ 2)
                                    IF dist < away1 THEN
                                        IF away1 < away2 THEN
                                            away2 = away1
                                            jay2 = jay1
                                        END IF
                                        away1 = dist
                                        jay1 = j
                                    ELSE
                                        IF dist < away2 THEN
                                            away2 = dist
                                            jay2 = j
                                        END IF
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay1 < 100 AND star(i).t > star(jay1).t * 3 THEN
                        SendFleet i, jay1, star(jay1).t * 2 + 10
                        star(jay1).d = 400
                    ELSE
                        IF jay2 < 100 AND star(i).t > star(jay2).t * 3 THEN
                            SendFleet i, jay2, star(jay2).t * 2 + 10
                            star(jay2).d = 400
                        END IF
                    END IF
                END IF
            END IF
 
            IF p = 1 THEN
                sf2 = 100
                FOR i = 0 TO 99
                    IF star(i).o = id AND i <> home(id) AND star(i).t > LL * 1.6 THEN
                        sf3 = star(i).t / 2.5
                        FOR j = 0 TO 99
                            IF star(j).d > 0 THEN
                                star(j).d = star(j).d - 1
                            ELSE
                                IF star(j).o <> id AND star(i).t > star(j).t * 4 THEN
                                    FOR k = 0 TO 99
                                        IF star(k).o = id THEN
                                            dist = SQR(ABS(star(k).x - star(j).x) ^ 2 + ABS(star(k).y - star(j).y) ^ 2)
                                            IF dist <= 250 * ratio THEN
                                                sf1 = i
                                                sf2 = j
                                                EXIT FOR
                                            END IF
                                        END IF
                                    NEXT
                                END IF
                            END IF
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    star(sf2).d = 400
                    EXIT FOR
                END IF
            END IF
 
            IF p = 2 THEN
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > 49 THEN
                            ok = 1
                            FOR j = 0 TO 99
                                IF star(j).o <> id AND star(j).o <> 0 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 400 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t
                                EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN EXIT FOR
            END IF
 
            IF p = 3 THEN
                ok = 0
                FOR i = 0 TO 99
                    IF i <> home(id) AND star(i).o = id THEN
                        IF star(i).t > LL * 2 THEN
                            ok = 1
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    SendFleet i, home(id), star(i).t / 4
                    EXIT FOR
                END IF
            END IF
 
        NEXT
 
    END IF
END SUB
 
SUB GamePanel
    x1 = sw / 4
    y1 = sh / 4
    speed = 0
    _DEST gp
    COLOR 0, 8
    CLS
    _FONT ttf72
    n$ = "Beyond The Stars"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 12), n$
    LINE (40, 100)-(920, 100), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (42, 120), "Save"
    _PRINTSTRING (42, 180), "Load"
    COLOR 0, 7
    LINE (910, 9)-(950, 49), 7, BF
    _PRINTSTRING (921, 10), "x"
    FOR i = 146 TO 886 STEP 82
        LINE (i, 115)-(i + 39, 158), 7, BF
        LINE (i, 175)-(i + 39, 218), 7, BF
        _PRINTSTRING (i + 10, 120), CHR$((i - 144) / 81 + 48)
        _PRINTSTRING (i + 10, 180), CHR$((i - 144) / 81 + 48)
    NEXT
    n$ = "Custom Mode"
    c = 159
    IF dm = 0 AND LL = 0 THEN
        c = 7
        IF cm = 1 THEN c = 168
    END IF
    l2 = 0
    l1 = _PRINTWIDTH(n$)
    LINE (40, 235)-(60 + l1, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 250), n$
    n$ = "Demo Mode"
    bmp = 2
    c = 159
    IF cm = 0 THEN
        c = 7
        IF dm = 1 THEN
            c = 168
            bmp = 1
        END IF
    END IF
    l2 = l1
    l1 = _PRINTWIDTH(n$)
    LINE (76 + l2, 235)-(96 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (86 + l2, 250), n$
    n$ = "Rectangle"
    c = 159
    IF cm = 0 AND dm = 0 THEN
        c = 7
        IF rm = 1 THEN c = 168
    END IF
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (112 + l2, 235)-(132 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (122 + l2, 250), n$
    n$ = "New Game"
    c = 7
    IF dm = 1 OR cm = 1 THEN c = 159
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (148 + l2, 235)-(168 + l1 + l2, 295), c, BF
    COLOR 0, c
    _PRINTSTRING (158 + l2, 250), n$
    n$ = "Play a Duel"
    c = 159
    IF cm = 0 AND dm = 0 THEN
        c = 7
        IF duel = 1 THEN c = 168
    END IF
    l1 = _PRINTWIDTH(n$)
    LINE (40, 310)-(60 + l1, 370), c, BF
    COLOR 0, c
    _PRINTSTRING (50, 325), n$
    n$ = "Scrambled"
    c = 159
    IF cm = 0 AND dm = 0 THEN
        c = 7
        IF sm = 1 THEN c = 168
    END IF
    l2 = l1
    l1 = _PRINTWIDTH(n$)
    LINE (76 + l2, 310)-(96 + l1 + l2, 370), c, BF
    COLOR 0, c
    _PRINTSTRING (86 + l2, 325), n$
    n$ = "Grouped"
    c = 159
    IF cm = 0 AND dm = 0 THEN
        c = 7
        IF gm = 1 THEN c = 168
    END IF
    l2 = l2 + l1
    l1 = _PRINTWIDTH(n$)
    LINE (112 + l2, 310)-(132 + l1 + l2, 370), c, BF
    COLOR 0, c
    _PRINTSTRING (122 + l2, 325), n$
    _FONT ttf24
    FOR i = 134 TO 874 STEP 134
        j = j + 1
        prod = 0
        ship = 0
        FOR k = 0 TO 99
            IF star(k).o = j THEN
                prod = prod + star(k).p
                ship = ship + star(k).t
            END IF
        NEXT
        LINE (i, 386)-(i + 120, 490), colors(j), BF
        COLOR 0, colors(j)
        _PRINTSTRING (i, 408), STR$(prod)
        _PRINTSTRING (i, 448), STR$(ship)
    NEXT
    _FONT ttf36
    COLOR 7, 8
    _PRINTSTRING (40, 400), "Prod:"
    _PRINTSTRING (40, 444), "Ship:"
    n$ = "           Left Click Color Picker      Right Click To Close"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((960 - l) / 2, 500), n$, gp
    _PUTIMAGE (x1, y1), gp, 0, (0, 0)-(960 * ratio, 540 * ratio)
    _DEST 0
END SUB
 
SUB GetInput
 
    IF ch = CHR$(27) THEN
        repeat = 0
        SaveGame "savegame"
    END IF
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN paused = 1 - paused
    IF ch = "+" THEN
        IF speed < 10 THEN speed = speed + 1
    END IF
    IF ch = "-" THEN
        IF speed > 0 THEN speed = speed - 1
    END IF
    IF ch = "q" THEN QuickSave
    IF ch = "l" THEN QuickRestore
    IF ch = "g" THEN
        gact = 1
        paused = 1
    END IF
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        x = _MOUSEX
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
 
    WEND
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    IF rclk = 1 AND (cm = 0 OR gact = 1) THEN
        IF pact = 1 OR oact = 1 OR gact = 1 THEN
            rclk = 0
            oact = 0
            pact = 0
            gact = 0
        ELSE
            i = Identify
            IF i = 100 THEN
                IF src = 100 THEN
                    paused = 1 - paused
                    ch = ""
                ELSE
                    src = 100
                END IF
                rclk = 0
            END IF
        END IF
    END IF
 
    IF lclk = 1 AND paused = 1 AND pact = 0 AND oact = 0 AND gact = 0 THEN
        i = Identify
        IF i = 100 THEN
            gact = 1
            lclk = 0
        END IF
    END IF
 
END SUB
 
FUNCTION Identify
    ii = 100
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF ABS(dx) <= star(i).s + 10 + cm * 40 AND ABS(dy) <= star(i).s + 10 + cm * 40 THEN
            ii = i
            EXIT FOR
        END IF
    NEXT
    Identify = ii
END FUNCTION
 
SUB OrderPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST op
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, op
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    _PRINTSTRING (20 * ratio, 80 * ratio), "0123456789", op
    COLOR 7, 8
    _FONT ttf36
    IF box = 0 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "If Over", op
        xo = 142 * ratio: xd = 250 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 268 * ratio: xd = 314 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 332 * ratio: xd = 366 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng0)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (148 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (273 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (341 * ratio, 172 * ratio), "X", op
    END IF
    IF box = 1 THEN
        _PRINTSTRING (20 * ratio, 166 * ratio), "Then Send", op
        xo = 198 * ratio: xd = 278 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 294 * ratio: xd = 340 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        xo = 356 * ratio: xd = 390 * ratio: yo = 166 * ratio: yd = 200 * ratio
        LINE (xo, yo)-(xd, yd), 7, BF
        n$ = RTRIM$(strng1)
        COLOR 0, 7
        _FONT ttf24
        _PRINTSTRING (200 * ratio, 172 * ratio), n$, op
        _PRINTSTRING (299 * ratio, 172 * ratio), "OK", op
        _PRINTSTRING (365 * ratio, 172 * ratio), "X", op
    END IF
    _PUTIMAGE (x1, y1), op, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
    oanx = x1: oany = y1
END SUB
 
SUB PaintBackground
    RANDOMIZE TIMER
    x = RND * sw
    y = RND * sh
    c = RND * 14 + 1
    PSET (x, y), c
    RANDOMIZE USING seed
    FOR i = 1 TO 600 * ratio
        x = RND * sw
        y = RND * sh
        c = RND * 14 + 1
        PSET (x, y), c
    NEXT
END SUB
 
SUB PaintFleet
    count = fltcnt
    i = 0
    WHILE count
        IF fleet(i).o <> 0 THEN
            CIRCLE (fleet(i).x1, fleet(i).y1), 3, colors(fleet(i).o)
            count = count - 1
        END IF
        i = i + 1
    WEND
END SUB
 
SUB PaintStars
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 OR star(order(i).dst).o <> 1 THEN
                order(i).src = 100
            ELSE
                LINE (star(i).x, star(i).y)-(star(order(i).dst).x, star(order(i).dst).y), 18
                IF star(i).t >= order(i).ovr THEN
                    SendFleet order(i).src, order(i).dst, order(i).shp
                END IF
            END IF
        END IF
    NEXT
 
    FOR i = 0 TO 99
        c = star(i).c
        x = star(i).x
        y = star(i).y
        o = star(i).o
        CIRCLE (x, y), (star(i).s + 8) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), colors(o), c
        END IF
        _FONT ttf16
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            l = _PRINTWIDTH(n$)
            _PRINTSTRING (x + 10, y), STR$(star(i).p), 0
        ELSE
            n$ = STR$(star(i).t)
            l = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - l / 2, y + 14), n$, 0
    NEXT
 
END SUB
 
SUB Player
 
    ' Custom Map Mode
    IF cm = 1 THEN
        IF lmb THEN
            i = Identify
            IF i < 100 THEN
                WHILE _MOUSEINPUT: WEND
                nx = _MOUSEX
                ny = _MOUSEY
                ok = 1
                FOR j = 0 TO 99
                    IF j <> i THEN
                        dist = SQR(ABS(nx - star(j).x) ^ 2 + ABS(ny - star(j).y) ^ 2)
                        IF dist <= 60 THEN
                            ok = 0
                            EXIT FOR
                        END IF
                    END IF
                NEXT
                IF ok = 1 THEN
                    star(i).x = nx
                    star(i).y = ny
                ELSE
                    _MOUSEMOVE star(i).x, star(i).y
                END IF
            END IF
        END IF
    END IF
 
    'Add new order to standing orders
    IF ord.src <> 100 THEN
        i = ord.src
        IF ord.shp = 0 THEN
            order(i).src = 100
        ELSE
            order(i) = ord
        END IF
        src = 100
        ord.src = 100
    END IF
 
    IF pact = 0 AND oact = 0 AND gact = 0 AND wact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 AND cm = 0 THEN
            i = Identify
            IF i < 100 THEN WorldPanel i
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = i
            END IF
        END IF
 
        ' If there is a source star then draw a range line that snaps to center of destination, if one
        IF src <> 100 THEN
            c = 12
            FOR i = 0 TO 99
                IF star(i).o = 1 THEN
                    dist = SQR(ABS(star(i).x - x) ^ 2 + ABS(star(i).y - y) ^ 2)
                    IF dist <= 251 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            LINE (star(src).x, star(src).y)-(x, y), c
            n$ = STR$(INT(rang))
            _FONT ttf16
            _PRINTSTRING (x + 20, y), n$, 0
        END IF
 
        'If we have a source star see if we clicked on a destination star
        IF src <> 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                i = Identify
                IF i = src THEN
                    lclk = 0
                    src = 100
                    IF rclk = 1 THEN
                        rclk = 0
                        order(i).src = 100
                    END IF
                ELSE
                    IF i < 100 AND i <> src THEN
                        IF lclk = 1 THEN
                            lclk = 0
                            FOR j = 0 TO 99
                                IF star(j).o = 1 THEN
                                    dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist <= 250 THEN
                                        dst = i
                                        pact = 1
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        ELSE
                            rclk = 0
                            dst = i
                            IF star(i).o = 1 THEN
                                oact = 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    'If the game panel is active
    IF gact = 1 THEN
        GamePanel
        IF lclk = 1 THEN
            x1 = sw / 4 + 910: x2 = x1 + 40: y1 = sh / 4 + 9: y2 = y1 + 39
            IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                ch = CHR$(27)
            END IF
            FOR i = 143 TO 874 STEP 81
                x1 = sw / 4 + i: x2 = x1 + 39: y1 = sh / 4 + 115: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    SaveGame n$
                END IF
                y1 = y1 + 60: y2 = y2 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    n$ = "savegame" + CHR$((i - 143) / 81 + 48)
                    LoadGame n$
                END IF
            NEXT
            _FONT ttf36
            l2 = 0
            l1 = _PRINTWIDTH("Custom Mode")
            IF LL = 0 AND dm = 0 THEN
                x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    cm = 1 - cm
                    IF cm = 1 THEN gact = 0
                END IF
            END IF
            l2 = l1
            l1 = _PRINTWIDTH("Demo Mode")
            IF cm = 0 THEN
                x1 = 76 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    dm = 1 - dm
                    IF dm = 0 THEN
                        ncp = 5
                        bmp = 2
                    ELSE
                        ncp = 6
                        bmp = 1
                        gact = 0
                    END IF
                END IF
            END IF
            l2 = l2 + l1
            l1 = _PRINTWIDTH("Rectangle")
            IF cm = 0 AND dm = 0 THEN
                x1 = 112 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    rm = 1 - rm
                END IF
                l2 = l2 + l1
                l1 = _PRINTWIDTH("New Game")
                x1 = 148 + sw / 4 + l2: x2 = x1 + 20 + l1: y1 = 235 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    gact = 0
                    NewGame
                END IF
                l1 = _PRINTWIDTH("Play a Duel")
                x1 = 40 + sw / 4: x2 = x1 + 20 + l1: y1 = 310 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    duel = 1 - duel
                END IF
                l2 = _PRINTWIDTH("Scrambled")
                x1 = 76 + sw / 4 + l1: x2 = x1 + l2 + 20: y1 = 310 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    sm = 1 - sm
                    gm = 0
                END IF
                l1 = l1 + l2
                l2 = _PRINTWIDTH("Grouped")
                x1 = 112 + sw / 4 + l1: x2 = x1 + l2 + 20: y1 = 310 + sh / 4: y2 = y1 + 60
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    gm = 1 - gm
                    sm = 0
                END IF
            END IF
            FOR i = 134 TO 874 STEP 134
                j = j + 1
                x1 = sw / 4 + i: x2 = x1 + 124: y1 = sh / 4 + 386: y2 = y1 + 104
                IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN
                    tmp = colors(1)
                    colors(1) = colors(j)
                    colors(j) = tmp
                END IF
            NEXT
        END IF
    END IF
 
    'If the star standing orders panel is active
    IF oact = 1 THEN
 
        IF star(src).o = 1 THEN
            OrderPanel dst
        END IF
 
        IF rclk = 1 THEN oact = 0
 
        IF box = 0 THEN
            tmp$ = RTRIM$(strng0)
        ELSE
            tmp$ = RTRIM$(strng1)
        END IF
 
        IF lclk = 1 THEN
 
            x1 = oanx: x2 = oanx + 400 * ratio
            y1 = oany: y2 = oany + 540 * ratio
 
            IF y > y1 + 80 * ratio AND y < y1 + 152 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    IF box = 0 THEN
                        n$ = RTRIM$(strng0)
                        l = LEN(n$)
                        IF l < 8 THEN strng0 = tmp$ + STR$(dig)
                    ELSE
                        n$ = RTRIM$(strng1)
                        l = LEN(n$)
                        IF l < 8 THEN strng1 = tmp$ + STR$(dig)
                    END IF
                END IF
            END IF
 
            IF y > y1 + 166 * ratio AND y < y1 + 200 * ratio THEN
 
                IF box = 0 THEN
 
                    IF x > x1 + 268 * ratio AND x < x1 + 314 * ratio THEN
                        ord.ovr = INT(VAL(strng0))
                        box = 1
                    END IF
 
                    IF x > x1 + 332 * ratio AND x < x1 + 366 * ratio THEN
                        strng0 = ""
                    END IF
 
                ELSE
 
                    IF x > x1 + 294 * ratio AND x < x1 + 340 * ratio THEN
                        IF INT(VAL(strng1)) > ord.ovr THEN
                            strng1 = ""
                        ELSE
                            box = 0
                            oact = 0
                            ord.src = src
                            ord.dst = dst
                            ord.shp = VAL(strng1)
                            strng0 = ""
                            strng1 = ""
                        END IF
                    END IF
 
                    IF x > x1 + 356 * ratio AND x < x1 + 390 * ratio THEN
                        strng0 = ""
                        strng1 = ""
                        box = 0
                    END IF
 
                END IF
 
            END IF
        END IF
        x1 = 10000: y1 = 10000
 
    END IF
 
 
    'If the fleet send panel is active
    IF pact = 1 THEN
        IF rclk = 1 THEN pact = 0
        IF star(src).o = 1 THEN
            ShowPanel dst
        END IF
        IF lclk = 1 THEN
            tmp$ = RTRIM$(strng)
 
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
 
            IF y > y1 + 256 * ratio AND y < y1 + 328 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                END IF
            END IF
 
            IF y > y1 + 334 * ratio AND y < y1 + 374 * ratio THEN
                IF x > x1 + 20 * ratio AND x < x1 + 84 * ratio THEN
                    pact = 0
                    value = star(src).t
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 102 * ratio AND x < x1 + 184 * ratio THEN
                    pact = 0
                    value = star(src).t / 2
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 202 * ratio AND x < x1 + 282 * ratio THEN
                    pact = 0
                    value = star(src).t / 3
                    SendFleet src, dst, value
                    src = 100
                END IF
                IF x > x1 + 300 * ratio AND x < x1 + 380 * ratio THEN
                    strng = ""
                END IF
            END IF
 
            IF y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    IF value <= star(src).t AND star(src).t <> o THEN
                        SendFleet src, dst, value
                    END IF
                    src = 100
                END IF
                IF x > x1 + 212 * ratio AND x < x1 + 362 * ratio THEN
                    pact = 0
                    src = 100
                    strng = ""
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB QuickSave
    FOR i = 0 TO 99: qstar(i) = star(i): qorder(i) = order(i): NEXT
    FOR i = 0 TO 1999: qfleet(i) = fleet(i): NEXT
    FOR i = 0 TO 6: qhome(i) = home(i): NEXT
    qfltcnt = fltcnt
    qLL = LL
END SUB
 
SUB QuickRestore
    FOR i = 0 TO 99: star(i) = qstar(i): order(i) = qorder(i): NEXT
    FOR i = 0 TO 1999: fleet(i) = qfleet(i): NEXT
    FOR i = 0 TO 6: home(i) = qhome(i): NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB LoadGame (n$)
    n$ = n$ + ".sav"
    IF _FILEEXISTS(n$) THEN
        OPEN n$ FOR BINARY AS #2
        GET #2, , star()
        GET #2, , order()
        GET #2, , fleet()
        GET #2, , home()
        GET #2, , colors()
        GET #2, , fltcnt
        GET #2, , LL
        CLOSE #2
        PRINT "Game Loaded"
        dm = 0
        cm = 0
        rm = 0
        duel = 0
        ncp = 5
        bmp = 2
        it = 0
    END IF
END SUB
 
SUB SaveGame (n$)
    n$ = n$ + ".sav"
    OPEN n$ FOR BINARY AS #1
    CLOSE #1
    KILL n$
    OPEN n$ FOR BINARY AS #1
    PUT #1, , star()
    PUT #1, , order()
    PUT #1, , fleet()
    PUT #1, , home()
    PUT #1, , colors()
    PUT #1, , fltcnt
    PUT #1, , LL
    CLOSE #1
    PRINT "Game Saved"
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        FOR i = 0 TO 1999
            IF fleet(i).o = 0 THEN
                fleet(i).o = star(src).o
                fleet(i).d = dst
                fleet(i).x1 = star(src).x
                fleet(i).y1 = star(src).y
                fleet(i).x2 = star(dst).x
                fleet(i).y2 = star(dst).y
                fleet(i).t = ships
                star(src).t = star(src).t - ships
                fltcnt = fltcnt + 1
                EXIT FOR
            END IF
        NEXT
        IF LL < 20000 AND fleet(i).o <> 1 THEN LL = LL + 1
    END IF
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST sp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(src).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 12 * ratio), n$, sp
    n$ = "to"
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 80 * ratio), n$, sp
    n$ = RTRIM$(star(dst).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 152 * ratio), n$, sp
    LINE (20 * ratio, 239 * ratio)-(380 * ratio, 239 * ratio), 0
    _PRINTSTRING (20 * ratio, 256 * ratio), "0123456789", sp
    n$ = RTRIM$(strng)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 383 * ratio), n$, sp
    xo = 20 * ratio: xd = 84 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 102 * ratio: xd = 184 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 202 * ratio: xd = 282 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 300 * ratio: xd = 380 * ratio: yo = 334 * ratio: yd = 374 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 212 * ratio: xd = 362 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf24
    COLOR 7, 8
    n$ = RTRIM$(STR$(star(src).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (120 * ratio - l, 112 * ratio), n$, sp
    n$ = RTRIM$(STR$(star(dst).t))
    l = _PRINTWIDTH(n$)
    _PRINTSTRING (300 * ratio - l, 112 * ratio), n$, sp
    _FONT ttf16
    COLOR 0, 7
    _PRINTSTRING (38 * ratio, 347 * ratio), "ALL", sp
    _PRINTSTRING (122 * ratio, 347 * ratio), "HALF", sp
    _PRINTSTRING (214 * ratio, 347 * ratio), "THIRD", sp
    _PRINTSTRING (312 * ratio, 347 * ratio), "CLEAR", sp
    _FONT ttf72
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", sp
    _PRINTSTRING (216 * ratio, 458 * ratio), "Quit", sp
    _PUTIMAGE (x1, y1), sp, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB Update
    IF paused = 0 THEN
        RANDOMIZE TIMER
        FOR i = 0 TO 99
            r = INT(RND * 60)
            IF r < star(i).p THEN
                IF star(i).o > 0 THEN
                    star(i).t = star(i).t + 1
                ELSE
                    IF INT(RND * 10) < 3 THEN
                        star(i).t = star(i).t + 1
                    END IF
                END IF
            END IF
        NEXT
 
        count = fltcnt
        i = 0
        WHILE count
            IF fleet(i).o <> 0 THEN
                count = count - 1
                IF fleet(i).x2 > fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 + 1
                ELSEIF fleet(i).x2 < fleet(i).x1 THEN
                    fleet(i).x1 = fleet(i).x1 - 1
                END IF
                IF fleet(i).y2 > fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 + 1
                ELSEIF fleet(i).y2 < fleet(i).y1 THEN
                    fleet(i).y1 = fleet(i).y1 - 1
                END IF
                IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
                    dest = fleet(i).d
                    IF star(dest).o = fleet(i).o THEN
                        star(dest).t = star(dest).t + fleet(i).t
                        fleet(i).o = 0
                        fltcnt = fltcnt - 1
                    ELSE
                        o = star(dest).o
                        IF o > 0 AND star(dest).t < fleet(i).t * 0.6 THEN
                            k = 100
                            shortest = 10000
                            FOR j = 0 TO 99
                                IF star(j).o = o THEN
                                    dist = SQR(ABS(star(j).x - star(dest).x) ^ 2 + ABS(star(j).y - star(dest).y) ^ 2)
                                    IF dist < shortest THEN
                                        shortest = dist
                                        k = j
                                    END IF
                                END IF
                            NEXT
                            SendFleet dest, k, star(dest).t * 0.90
                            star(dest).t = 0
                            star(dest).o = fleet(i).o
                            star(dest).t = fleet(i).t
                            star(dest).o = fleet(i).o
                            fleet(i).o = 0
                            fltcnt = fltcnt - 1
                        ELSE
                            IF fleet(i).t * 1.1 > star(dest).t THEN
                                alive = 1
                                WHILE alive
                                    alive = 0
                                    damorg = fleet(i).t / 10 + 1
                                    damdst = star(dest).t / 8 + 1
                                    fleet(i).t = fleet(i).t - damdst
                                    star(dest).t = star(dest).t - damorg
                                    IF fleet(i).t > 0 AND star(dest).t > 0 THEN
                                        alive = 1
                                    END IF
                                WEND
                                IF star(dest).t < 1 THEN
                                    star(dest).t = fleet(i).t
                                    star(dest).o = fleet(i).o
                                END IF
                                fleet(i).o = 0
                                fltcnt = fltcnt - 1
                            ELSE
                                k = 100
                                shortest = 10000
                                FOR j = 0 TO 99
                                    IF star(j).o = fleet(i).o THEN
                                        dist = SQR(ABS(star(j).x - fleet(i).x1) ^ 2 + ABS(star(j).y - fleet(i).y1) ^ 2)
                                        IF dist < shortest THEN
                                            shortest = dist
                                            k = j
                                        END IF
                                    END IF
                                NEXT
                                IF k < 100 THEN
                                    fleet(i).x2 = star(k).x
                                    fleet(i).y2 = star(k).y
                                    fleet(i).d = k
                                ELSE
                                    fleet(i).o = 0
                                    fltcnt = fltcnt - 1
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
END SUB
 
SUB WorldPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20 * ratio
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 225 * ratio THEN y1 = sh - 225 * ratio
    y2 = y1 + 225 * ratio
    _DEST wp
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf72
    n$ = RTRIM$(star(i).n)
    l = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - l) / 2, 4 * ratio), n$, wp
    LINE (20 * ratio, 76 * ratio)-(380 * ratio, 76 * ratio), 0
    COLOR 7, 8
    _FONT ttf36
    _PRINTSTRING (20 * ratio, 90 * ratio), "Ships:", wp
    _PRINTSTRING (20 * ratio, 130 * ratio), "Production:", wp
    _PRINTSTRING (20 * ratio, 170 * ratio), "In Range:", wp
    _PRINTSTRING (240 * ratio, 90 * ratio), STR$(star(i).t), wp
    _PRINTSTRING (240 * ratio, 130 * ratio), STR$(star(i).p), wp
    n$ = "NO"
    FOR j = 0 TO 99
        IF star(i).o <> star(j).o THEN
            IF (star(i).o = 1 AND star(j).o > 1) OR star(j).o = 1 THEN
                dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                IF dist <= 250 THEN
                    n$ = "YES"
                    EXIT FOR
                END IF
            END IF
        END IF
    NEXT
    _PRINTSTRING (240 * ratio, 170 * ratio), n$, wp
    _PUTIMAGE (x1, y1), wp, 0, (0, 0)-(400 * ratio, 225 * ratio)
    _DEST 0
END SUB
 
SUB NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    DIM low AS LONG
    DIM high AS LONG
    DIM tot AS LONG
    paused = 1
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    gact = 0
    ncp = 5
    bmp = 2
    IF duel = 1 THEN
        ncp = 1
        bmp = 2
    END IF
    RANDOMIZE TIMER
    seed = RND * 1000
    FOR i = 0 TO 99
        k = 1
        WHILE k
            k = 0
            ok = 0
            DO
                x = RND * (sw - sww) + swn
                y = RND * (sh - shw) + shn
                ok = -1
                IF rm = 1 AND x > sw / 4 AND x < sw - sw / 4 AND y > sh / 4 AND y < sh - sh / 4 THEN ok = 0
            LOOP UNTIL ok
            r = INT(RND * 200)
            n = names(r)
            FOR j = 0 TO i - 1
                dx = x - star(j).x
                dy = y - star(j).y
                IF ABS(dx) < sww AND ABS(dy) < shw THEN
                    k = 1
                END IF
                IF n = star(j).n THEN
                    k = 1
                END IF
            NEXT
        WEND
        star(i).n = n
        star(i).x = x
        star(i).y = y
        star(i).c = RND * 6 + 9
        star(i).s = RND * 5
        star(i).o = 0
        star(i).p = star(i).s + (RND * 5) + 3
        star(i).t = 0
        order(i).src = 100
    NEXT
    low = 10000000
    high = 0
    IF duel = 1 THEN
        duel = 0
        FOR j = 0 TO 99
            x = star(j).x
            y = star(j).y
            tot = x * y
            IF tot < low THEN
                low = tot
                a = j
            END IF
            IF tot > high THEN
                high = tot
                b = j
            END IF
        NEXT
        home(1) = a
        star(a).o = 1
        star(a).p = 10
        star(a).t = 100
        star(a).s = 4
        star(a).n = "Sol"
        star(a).c = 14
 
        home(2) = b
        star(b).o = 2
        star(b).p = 10
        star(b).t = 100
        star(b).s = 4
    ELSE
        FOR i = 1 TO 6
            ok = 0
            WHILE (ok < 1)
                ok = 1
                j = RND * 100
                FOR k = 1 TO i - 1
                    dist = SQR(ABS(star(j).x - star(home(k)).x) ^ 2 + ABS(star(j).y - star(home(k)).y) ^ 2)
                    IF dist < 500 * ratio THEN
                        ok = 0
                        EXIT FOR
                    END IF
                NEXT
                IF ok = 1 THEN
                    ok = -1
                    FOR k = 0 TO 99
                        dist = SQR(ABS(star(j).x - star(k).x) ^ 2 + ABS(star(j).y - star(k).y) ^ 2)
                        IF dist <= 200 THEN ok = ok + 1
                        IF ok = 2 THEN EXIT FOR
                    NEXT
                END IF
            WEND
            home(i) = j
            star(j).o = i
            star(j).p = 10
            star(j).t = 100
            star(j).s = 4
            colors(i) = i + 8
        NEXT
    END IF
    star(home(1)).n = "Sol"
    star(home(1)).c = 14
    speed = 0
    rm = 0
    IF sm = 1 THEN
        sm = 0
        FOR i = 0 TO 99
            IF star(i).o = 0 THEN
                star(i).o = i MOD (ncp + 1) + 1
                star(i).t = RND * 50 + 25
            END IF
        NEXT
    END IF
    IF gm = 1 THEN
        gm = 0
        FOR i = 0 TO 99 - ncp
            o = i MOD (ncp + 1) + 1
            jay = 100
            away = 10000
            FOR j = 0 TO 99
                IF star(j).o = 0 THEN
                    dist = SQR(ABS(star(j).x - star(home(o)).x) ^ 2 + ABS(star(j).y - star(home(o)).y) ^ 2)
                    IF dist < away THEN
                        away = dist
                        jay = j
                    END IF
                END IF
            NEXT
            star(jay).o = o
            star(jay).t = RND * 50 + 25
        NEXT
    END IF
    QuickSave
END SUB
 
' A lot of star names I made up
 
SUB StarNames
    names(0) = "Acamar"
    names(1) = "Arcab"
    names(2) = "Acrux"
    names(3) = "Adhara"
    names(4) = "Arneb"
    names(5) = "Antares"
    names(6) = "Arcturus"
    names(7) = "Atria"
    names(8) = "Beid"
    names(9) = "Betelgeuse"
    names(10) = "Botein"
    names(11) = "Beemim"
    names(12) = "Bellatrix"
    names(13) = "Bharani"
    names(14) = "Biham"
    names(15) = "Brachium"
    names(16) = "Canopus"
    names(17) = "Capella"
    names(18) = "Castor"
    names(19) = "Chara"
    names(20) = "Cursa"
    names(21) = "Copernicus"
    names(22) = "Chalawan"
    names(23) = "Chertan"
    names(24) = "Dabih"
    names(25) = "Dalim"
    names(26) = "Deneb"
    names(27) = "Denebola"
    names(28) = "Diadem"
    names(29) = "Diphda"
    names(30) = "Dschubba"
    names(31) = "Dziban"
    names(32) = "Edasich"
    names(33) = "Electra"
    names(34) = "Elgafar"
    names(35) = "Elkurud"
    names(36) = "Elnath"
    names(37) = "Eltanin"
    names(38) = "Enif"
    names(39) = "Errai"
    names(40) = "Fafnir"
    names(41) = "Fang"
    names(42) = "Fawaris"
    names(43) = "Felis"
    names(44) = "Fomalhaut"
    names(45) = "Fulu"
    names(46) = "Fumal"
    names(47) = "Furud"
    names(48) = "Garnet"
    names(49) = "Giausar"
    names(50) = "Gienah"
    names(51) = "Ginan"
    names(52) = "Gomeisa"
    names(53) = "Graffias"
    names(54) = "Grumium"
    names(55) = "Gudja"
    names(56) = "Hadar"
    names(57) = "Haedus"
    names(58) = "Hamal"
    names(59) = "Hassaleh"
    names(60) = "Hatysa"
    names(61) = "Helvetios"
    names(62) = "Heze"
    names(63) = "Homan"
    names(64) = "Iklil"
    names(65) = "Imai"
    names(66) = "Intercrus"
    names(67) = "Izar"
    names(68) = "Iccar"
    names(69) = "Inar"
    names(70) = "Iaeth"
    names(71) = "Imaous"
    names(72) = "Jabbah"
    names(73) = "Jishui"
    names(74) = "Jax"
    names(75) = "Jalae"
    names(76) = "Jewel"
    names(77) = "Jumbo"
    names(78) = "Jerue"
    names(79) = "Jabear"
    names(80) = "Kakkab"
    names(81) = "Kang"
    names(82) = "Kekouan"
    names(83) = "Keid"
    names(84) = "Kitalpha"
    names(85) = "Kochab"
    names(86) = "Kolob"
    names(87) = "Kobol"
    names(88) = "Larawag"
    names(89) = "Lesath"
    names(90) = "Libertas"
    names(91) = "Lich"
    names(92) = "Lilly"
    names(93) = "Laddel"
    names(94) = "Luminous"
    names(95) = "Lasacious"
    names(96) = "Mizar"
    names(97) = "Markab"
    names(98) = "Matar"
    names(99) = "Mintaka"
    names(100) = "Meleph"
    names(101) = "Menkar"
    names(102) = "Merga"
    names(103) = "Merope"
    names(104) = "Nahn"
    names(105) = "Naos"
    names(106) = "Nashira"
    names(107) = "Navi"
    names(108) = "Nekkar"
    names(109) = "Nembus"
    names(110) = "Nihal"
    names(111) = "Nunki"
    names(112) = "Ogma"
    names(113) = "Okab"
    names(114) = "Ohmy"
    names(115) = "Oragami"
    names(116) = "Origen"
    names(117) = "Omanii"
    names(118) = "Obytewa"
    names(119) = "Oglok"
    names(120) = "Phact"
    names(121) = "Pherkad"
    names(122) = "Pleione"
    names(122) = "Polaris"
    names(123) = "Pollux"
    names(124) = "Procyon"
    names(125) = "Proxima"
    names(126) = "Polis"
    names(127) = "Quaint"
    names(128) = "QB64"
    names(129) = "Quetzal"
    names(130) = "Qussol"
    names(131) = "Quella"
    names(132) = "Quyaeo"
    names(133) = "Ququdas"
    names(134) = "Quekak"
    names(135) = "Rasalas"
    names(136) = "Regor"
    names(137) = "Regulus"
    names(138) = "Rigel"
    names(139) = "Revati"
    names(140) = "Rotenev"
    names(141) = "Rukbat"
    names(142) = "Rastaban"
    names(143) = "Sabik"
    names(144) = "Sadr"
    names(145) = "Saiph"
    names(146) = "Sargas"
    names(147) = "Sarin"
    names(148) = "Syrma"
    names(149) = "Spica"
    names(150) = "Sirius"
    names(151) = "Tarazed"
    names(152) = "Taygeta"
    names(153) = "Tejat"
    names(154) = "Thabit"
    names(155) = "Thuban"
    names(156) = "Tiaki"
    names(157) = "Toliman"
    names(158) = "Torcular"
    names(157) = "Umala"
    names(158) = "Ulatte"
    names(159) = "Ubbessa"
    names(160) = "Unoless"
    names(161) = "Umaddem"
    names(162) = "Ummbra"
    names(162) = "Uniqu"
    names(163) = "Uzzaal"
    names(164) = "Vega"
    names(165) = "Veritate"
    names(166) = "Vindetrix"
    names(167) = "Vedas"
    names(168) = "Vergg"
    names(169) = "Vacant"
    names(170) = "Vucae"
    names(171) = "Vicar"
    names(172) = "Wasat"
    names(173) = "Wazn"
    names(174) = "Wezen"
    names(175) = "Waiten"
    names(176) = "Wachar"
    names(177) = "Wheelz"
    names(178) = "Whatsp"
    names(179) = "Wassand"
    names(180) = "Xenno"
    names(181) = "Xyphod"
    names(182) = "Xu"
    names(183) = "Xaal"
    names(184) = "Xyross"
    names(185) = "Xiggot"
    names(186) = "Xirrks"
    names(187) = "Yed"
    names(188) = "Yildun"
    names(189) = "Yundun"
    names(190) = "Yavyo"
    names(191) = "Yotrac"
    names(192) = "Yxzoqu"
    names(193) = "Ynnot"
    names(194) = "Zaniah"
    names(195) = "Zaurak"
    names(196) = "Zhang"
    names(197) = "Zibal"
    names(198) = "Zosma"
    names(199) = "Zuben"
END SUB
 

News:

Author Topic: Beyond The Stars (alpha) (Read 6970 times)

romichess

Beyond The Stars (alpha)

Pete

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

Kazman

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

Aurel

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

Aurel

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)

romichess

Re: Beyond The Stars (alpha)