Print Page - Beyond Sol

Title: Beyond Sol
Post by: romichess on December 08, 2019, 07:04:46 am

The game lives! Save humanity from the alien threat!!

To play just click on one of your stars. Then click (don't drag) on any other star and then send ships. That is all there is to it. The esc key exits the game. The "t' key toggles the star names. Look for the blue star. That is Sol the human's home star. I will probably change the color as it is one of the harder colors to see.

Missing features I'll add in the next few days. A pause key and a save/load game.

When playing it is better to be slow and careful rather than fast and reckless, :).

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 INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
END TYPE
 
TYPE FLEETS
    n AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx 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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 60 '                        Set to 60 frames per second
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Identify x, y '                    Identify star mouse is over if any
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    IF ships = 0 THEN
 
    END IF
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).n = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            IF rng < 4000 THEN rng = rng + 4
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    RANDOMIZE TIMER
    FOR i = 0 TO 99
        r = INT(RND * 120)
        IF r < star(i).p THEN
            IF star(i).o > 0 THEN
                star(i).t = star(i).t + 1
            ELSE
                IF INT(RND * 10) < 2 THEN
                    star(i).t = star(i).t + 1
                END IF
            END IF
        END IF
    NEXT
    num = 0
    FOR i = 2 TO 6
        FOR j = 0 TO 99
            IF star(j).o = i THEN
                IF star(j).t > num THEN
                    num = star(j).t
                    idx = j
                END IF
            END IF
        NEXT
        org = idx
        num = 10000
        FOR j = 0 TO 99
            IF star(j).o <> i THEN
                sway = ABS(star(org).x - star(j).x) + ABS(star(org).y - star(j).y)
                IF sway < rng AND star(j).t + SQR(sway) < num THEN
                    num = star(j).t
                    idx = j
                END IF
            END IF
        NEXT
        dst = idx
        IF star(org).t > LL THEN
            IF star(org).t > 100 AND star(org).t > star(dst).t * 2 THEN
                SendFleet org, dst, star(org).t / 2
            ELSE
                dst = home(star(org).o)
                SendFleet org, dst, star(org).t / 2
            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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).n
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    alive = 1
                    WHILE alive
                        alive = 0
                        damorg = fleet(i).n / 11 + 1
                        damdst = star(dst).t / 10 + 1
                        fleet(i).n = fleet(i).n - damdst
                        star(dst).t = star(dst).t - damorg
                        IF fleet(i).n > 0 AND star(dst).t > 0 THEN
                            alive = 1
                        END IF
                    WEND
                    IF star(dst).t < 1 THEN
                        star(dst).t = fleet(i).n
                        star(dst).o = fleet(i).o
                    END IF
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    ch = ""
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        LINE (px, py)-(x, y), 10
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            END IF
            IF x > x1 + 20 AND x < x1 + 380 AND y > y1 + 260 AND y < y1 + 320 THEN
                dig = (x - x1 - 32) / 38
                strng = tmp$ + STR$(dig)
            END IF
            IF x > x1 + 266 AND x < x1 + 366 AND y > y1 + 366 AND y < y1 + 406 THEN
                strng = ""
            END IF
            IF x > x1 + 32 AND x < x1 + 182 AND y > y1 + 460 AND y < y1 + 530 THEN
                value = VAL(strng)
                strng = ""
                pact = 0
                SendFleet srcidx, dstidx, value
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF pact = 0 AND ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
            ii = i
            IF star(i).o = 1 AND slct = 0 THEN
                IF clk THEN
                    slct = 1
                END IF
                px = x
                py = y
                srcstr = star(i).n
                srcidx = i
            ELSE
                IF slct = 1 OR pact = 1 THEN
                    IF clk THEN
                        slct = 0
                        pact = 1
                        dststr = star(i).n
                        dstidx = i
                    END IF
                END IF
            END IF
        END IF
    NEXT
END SUB
 
SUB ShowPanel (i)
    x1 = star(i).x - 420 * ratio
    IF star(i).x < sw / 2 THEN x1 = star(i).x + 20
    x2 = x1 + 400 * ratio
    y1 = star(i).y
    IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
    y2 = y1 + 540 * ratio
    _DEST ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 - L) / 2, 8), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 - L) / 2, 80), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 - L) / 2, 152), n$, ps
    LINE (20, 240)-(380, 240), 0
    _PRINTSTRING (20, 260), "0123456789", ps
    _PRINTSTRING (20, 346), strng, ps
    xo = 286: xd = 366: yo = 366: yd = 406
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32: xd = 182: yo = 460: yd = 530
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 216: xd = 366: yo = 460: yd = 530
    LINE (xo, yo)-(xd, yd), 7, BF
    COLOR 8, 7
    _FONT ttf1
    _PRINTSTRING (300, 380), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60, 460), "Ok", ps
    _PRINTSTRING (220, 460), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 + 6) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf1
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            L = _PRINTWIDTH(n$)
        ELSE
            n$ = STR$(star(i).t)
            L = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - L / 2, y + 12), n$, 0
    NEXT
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
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    fltcnt = 0
    LL = 50
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 20
    star(0).t = 100
    home(0) = 0
    FOR i = 1 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 * 8) + 1
        star(i).t = 0
    NEXT
    FOR i = 2 TO 6
        k = 1
        WHILE k
            k = 0
            r = RND * 100
            FOR j = 1 TO i - 1
                IF r = home(j) THEN k = 1
                x = star(0).x
                y = star(0).y
                dx = ABS(star(r).x - x)
                dy = ABS(star(r).y - y)
                IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
            NEXT
        WEND
        home(i) = r
        star(r).o = i
        star(r).p = 20
        star(r).t = 100
    NEXT
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
 
 
 
 
 
 
 
 
 
 

Title: Re: Beyond Sol
Post by: OldMoses on December 08, 2019, 09:09:19 am

It seems to get stuck with the dropdown display and nothing happens. Am I doing something wrong?

A suggestion would be to work on getting your font size down so it all fits in the drop down.

Title: Re: Beyond Sol
Post by: Petr on December 08, 2019, 01:05:36 pm

Hi OldMoses,
The program works, but the reactions are very slow. It is caused by some rendering loops, I couldn't find it because of the number of shared variables.
Click the mouse on planet Sol, then on another. Make a line between the planets. A dialog is displayed (I don't know about what is asking), where you click the numbers - it is probably size of the crew, and when the rocket reaches the target planet and has more crew than the number of inhabitants on the planet, is this planet of humans.

Very interest idea.

Title: Re: Beyond Sol
Post by: romichess on December 08, 2019, 02:13:07 pm

It will only work in 1920 x 1080p until I fix the scaling. I'll be working on that next. Also some for loops can be optimized with EXIT FOR. The AI was too weak anyway so I made it a lot better. I'd like it to be a good game but for now just consider it a demo.

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 03:03:47 am

The scaling has been fixed. It was tested in 1176 x 664, 800 x 600, 1600 x 900 and of course 1920 x 1080. The popup gui panel displayed correctly and the mouse clicks were accurate. Resolution 800 x 600 was unplayable because the number of ships under a planet could not be read. I'll look into artificially increasing the font size to any resolution smaller than the 1176 that was tested.

The AI is now a bit of a challenge!

Feedback wanted!

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 INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
END TYPE
 
TYPE FLEETS
    n AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx 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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 14 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 60 '                        Set to 60 frames per second
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Identify x, y '                    Identify star mouse is over if any
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    IF ships = 0 THEN
 
    END IF
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).n = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            IF rng < 4000 THEN rng = rng + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    RANDOMIZE TIMER
    FOR i = 0 TO 99
        r = INT(RND * 120)
        IF r < star(i).p THEN
            IF star(i).o > 0 THEN
                star(i).t = star(i).t + 1
            ELSE
                IF INT(RND * 10) < 2 THEN
                    star(i).t = star(i).t + 1
                END IF
            END IF
        END IF
    NEXT
    num = 0
    FOR i = 2 TO 6
        FOR j = 0 TO 99
            IF star(j).o = i AND j <> home(i) AND star(j).t > LL THEN
                SendFleet j, home(i), star(j).t / 4
            END IF
        NEXT
        org = home(i)
        dst = 100
        num = 10000
        FOR j = 0 TO 99
            IF star(j).o <> i THEN
                sway = SQR(ABS(star(org).x - star(j).x) ^ 2 + ABS(star(org).y - star(j).y) ^ 2)
                IF sway < rng AND star(j).t + sway + RND * 210 - 100 < num THEN
                    num = star(j).t
                    dst = j
                END IF
            END IF
        NEXT
        IF dst < 100 AND star(org).t > LL THEN
            IF star(org).t > star(dst).t * 4 THEN
                SendFleet org, dst, star(org).t / 2
            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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).n
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    alive = 1
                    WHILE alive
                        alive = 0
                        damorg = fleet(i).n / 11 + 1
                        damdst = star(dst).t / 10 + 1
                        fleet(i).n = fleet(i).n - damdst
                        star(dst).t = star(dst).t - damorg
                        IF fleet(i).n > 0 AND star(dst).t > 0 THEN
                            alive = 1
                        END IF
                    WEND
                    IF star(dst).t < 1 THEN
                        star(dst).t = fleet(i).n
                        star(dst).o = fleet(i).o
                    END IF
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    ch = ""
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        LINE (px, py)-(x, y), 10
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            END IF
            IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                dig = (x - x1 - 32 * ratio) / (38 * ratio)
                strng = tmp$ + STR$(dig)
            END IF
            IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                strng = ""
            END IF
            IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                IF value <= star(srcidx).t THEN
                    value = VAL(strng)
                    strng = ""
                    pact = 0
                    SendFleet srcidx, dstidx, value
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF pact = 0 AND ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
            ii = i
            IF star(i).o = 1 AND slct = 0 THEN
                IF clk THEN
                    slct = 1
                END IF
                px = x
                py = y
                srcstr = star(i).n
                srcidx = i
            ELSE
                IF slct = 1 OR pact = 1 THEN
                    IF clk THEN
                        slct = 0
                        pact = 1
                        dststr = star(i).n
                        dstidx = i
                    END IF
                END IF
            END IF
            EXIT FOR
        END IF
    NEXT
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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 216 * ratio: xd = 366 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    COLOR 8, 7
    _FONT ttf1
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 460 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 460 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 + 6) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf1
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            L = _PRINTWIDTH(n$)
        ELSE
            n$ = STR$(star(i).t)
            L = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - L / 2, y + 12), n$, 0
    NEXT
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
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    fltcnt = 0
    LL = 50
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 20
    star(0).t = 100
    home(0) = 0
    FOR i = 1 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 * 8) + 1
        star(i).t = 0
    NEXT
    FOR i = 2 TO 6
        k = 1
        WHILE k
            k = 0
            r = RND * 100
            FOR j = 1 TO i - 1
                IF r = home(j) THEN k = 1
                x = star(0).x
                y = star(0).y
                dx = ABS(star(r).x - x)
                dy = ABS(star(r).y - y)
                IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
            NEXT
        WEND
        home(i) = r
        star(r).o = i
        star(r).p = 20
        star(r).t = 100
    NEXT
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
 
 
 
 
 
 
 
 
 
 

Title: Re: Beyond Sol
Post by: OldMoses on December 09, 2019, 03:26:13 am

I was starting to build a nice little local empire, pretty cool. I did find that the dropdown would freeze on me occasionally.

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 04:18:46 am

Hi Andy, I noticed the mouse freezing only once. But it unfroze itself after 20 seconds. Thanks for trying out my game! I need to not neglect my sleep. Just a moment ago my head hit the pillow and I realized that the computer players don't need to think every frame. They could be scheduled one player per frame. So up out of bed I lept. It was a five minute fix. The mouse is much more responsive now. Here is the source and I am off to bed, again. This time for real, lol.

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 INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
END TYPE
 
TYPE FLEETS
    n AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx AS INTEGER
DIM SHARED FrameCounter AS INTEGER
DIM SHARED id AS LONG
 
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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 14 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 60 '                        Set to 60 frames per second
 
    CLS
 
    FrameCounter = FrameCounter + 1
 
    id = FrameCounter MOD 5 + 2
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Identify x, y '                    Identify star mouse is over if any
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    IF ships = 0 THEN
 
    END IF
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).n = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            IF rng < 4000 THEN rng = rng + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    RANDOMIZE TIMER
    FOR i = 0 TO 99
        r = INT(RND * 120)
        IF r < star(i).p THEN
            IF star(i).o > 0 THEN
                star(i).t = star(i).t + 1
            ELSE
                IF INT(RND * 10) < 2 THEN
                    star(i).t = star(i).t + 1
                END IF
            END IF
        END IF
    NEXT
    num = 0
    FOR j = 0 TO 99
        IF star(j).o = id AND j <> home(id) AND star(j).t > LL THEN
            SendFleet j, home(id), star(j).t / 4
        END IF
    NEXT
    org = home(id)
    dst = 100
    num = 10000
    FOR j = 0 TO 99
        IF star(j).o <> id THEN
            sway = SQR(ABS(star(org).x - star(j).x) ^ 2 + ABS(star(org).y - star(j).y) ^ 2)
            IF sway < rng AND star(j).t + sway + RND * 210 - 100 < num THEN
                num = star(j).t
                dst = j
            END IF
        END IF
    NEXT
    IF dst < 100 AND star(org).t > LL THEN
        IF star(org).t > star(dst).t * 4 THEN
            SendFleet org, dst, star(org).t / 2
        END IF
    END IF
    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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).n
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    alive = 1
                    WHILE alive
                        alive = 0
                        damorg = fleet(i).n / 11 + 1
                        damdst = star(dst).t / 10 + 1
                        fleet(i).n = fleet(i).n - damdst
                        star(dst).t = star(dst).t - damorg
                        IF fleet(i).n > 0 AND star(dst).t > 0 THEN
                            alive = 1
                        END IF
                    WEND
                    IF star(dst).t < 1 THEN
                        star(dst).t = fleet(i).n
                        star(dst).o = fleet(i).o
                    END IF
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    ch = ""
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        LINE (px, py)-(x, y), 10
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            END IF
            IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                dig = (x - x1 - 32 * ratio) / (38 * ratio)
                strng = tmp$ + STR$(dig)
            END IF
            IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                strng = ""
            END IF
            IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                value = VAL(strng)
                strng = ""
                pact = 0
                IF value <= star(srcidx).t THEN
                    SendFleet srcidx, dstidx, value
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF pact = 0 AND ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
            ii = i
            IF star(i).o = 1 AND slct = 0 THEN
                IF clk THEN
                    slct = 1
                END IF
                px = x
                py = y
                srcstr = star(i).n
                srcidx = i
            ELSE
                IF slct = 1 OR pact = 1 THEN
                    IF clk THEN
                        slct = 0
                        pact = 1
                        dststr = star(i).n
                        dstidx = i
                    END IF
                END IF
            END IF
            EXIT FOR
        END IF
    NEXT
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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 216 * ratio: xd = 366 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    COLOR 8, 7
    _FONT ttf1
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 460 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 460 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 + 6) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf1
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            L = _PRINTWIDTH(n$)
        ELSE
            n$ = STR$(star(i).t)
            L = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - L / 2, y + 12), n$, 0
    NEXT
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
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    fltcnt = 0
    LL = 50
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 20
    star(0).t = 100
    home(0) = 0
    FOR i = 1 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 * 8) + 1
        star(i).t = 0
    NEXT
    FOR i = 2 TO 6
        k = 1
        WHILE k
            k = 0
            r = RND * 100
            FOR j = 1 TO i - 1
                IF r = home(j) THEN k = 1
                x = star(0).x
                y = star(0).y
                dx = ABS(star(r).x - x)
                dy = ABS(star(r).y - y)
                IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
            NEXT
        WEND
        home(i) = r
        star(r).o = i
        star(r).p = 20
        star(r).t = 100
    NEXT
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
 

Title: Re: Beyond Sol
Post by: Cobalt on December 09, 2019, 10:04:41 am

Heading for a Master of Orion clone here! Interesting. Just how much of a clone are you going for?

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 10:34:51 am

Not really a clone at all. Just something about on MOO's level with less micromanagement. And not even this code as this was just a learning exercise. This game is actually a real time version of an old Atari 800 turn based game. The planetary mechanics are identical. But, derivative would still be a better fitting word even for that comparison.

Title: Re: Beyond Sol
Post by: Cobalt on December 09, 2019, 11:09:25 am

oh okay. For myself, I was full blown cloning it,

Code: QB64: [Select]

REM'$include: 'Zlib.bi'
 DECLARE DYNAMIC LIBRARY ".\zlib1"
  FUNCTION zlibVersion$ ()
  FUNCTION zlibCompileFlags~& ()
  FUNCTION compressBound& (BYVAL LEN AS LONG)
  FUNCTION compress& (BYVAL dest AS _OFFSET, destLen AS LONG, BYVAL source AS _OFFSET, BYVAL sourceLen AS LONG)
  FUNCTION compress2& (BYVAL dest AS _OFFSET, destLen AS LONG, BYVAL source AS _OFFSET, BYVAL sourceLen AS LONG, BYVAL level AS LONG)
  FUNCTION uncompress& (BYVAL dest AS _OFFSET, destLen AS LONG, BYVAL source AS _OFFSET, BYVAL sourceLen AS LONG)
  FUNCTION crc32~& (BYVAL PNGCRC AS LONG, BYVAL buf AS _OFFSET, BYVAL LEN AS LONG)
  FUNCTION adler32~& (BYVAL adler AS LONG, BYVAL buf AS _OFFSET, BYVAL LEN AS LONG)
  FUNCTION zError$ (BYVAL codenum AS INTEGER)
 END DECLARE
 
TYPE Planet_Data
 Name AS STRING * 20 'Name of Planet
 XLoc AS INTEGER '    Galactic X location
 YLoc AS INTEGER '    Galactic Y location
 Colr AS _BYTE '      Star Color
 Size AS _BYTE '      Star Size
 Imag AS _BYTE '      Planetoid image
 Environ AS _BYTE '   Planets enviromental type
 Wealth AS _BYTE '    Mineral wealth
 BasePop AS INTEGER ' Population in millions planet can support normally
 ModPop AS INTEGER '  Population modifier due to Terraforming.
 MaxPop AS INTEGER '  Total maximum population planet can support
 CurPop AS INTEGER '  Current Population on planet
 LastPop AS INTEGER ' Last years population
 Factory AS INTEGER ' Factory count on planet
 TotalProd AS INTEGER 'Systems total production
 ActualProd AS INTEGER 'Systems adjusted production
 Bases AS INTEGER '   Missle defence bases on planet
 ShipProduction AS _BYTE 'Ship currently in production
 ShipCredits AS INTEGER ' amount of credits currently put toward ship production
 EcoCredits AS INTEGER '  amount of credits currently put toward ecology upgrade
 Relocate AS _BYTE '      System ships are to relocate to
 Sheild AS _BYTE '        Shield level protecting planet
 SheildCredits AS INTEGER 'amount of credits currently put toward shield production
 Waste AS _UNSIGNED _BYTE 'industrial waste on planet(each factory produces .5BC waste a year)
 Reserve AS LONG '    Credits in planetary reserve
 Owner AS _BYTE '     which race controls planet
 Race1Visit AS _BYTE 'has race 1 visited planet
 Race2Visit AS _BYTE 'has race 2 visited planet
 Race3Visit AS _BYTE 'has race 3 visited planet
 Race4Visit AS _BYTE 'has race 4 visited planet
 Race5Visit AS _BYTE 'has race 5 visited planet
 Race6Visit AS _BYTE 'has race 6 visited planet
 Ship AS _BYTE '      percent of planetary production in Ships
 Defn AS _BYTE '      percent of planetary production in Defence
 Indu AS _BYTE '      percent of planetary production in Industry
 Eco AS _BYTE '       percent of planetary production in Ecology
 Tech AS _BYTE '      percent of planetary production in Technology
 Shiplock AS _BYTE '  is ship production locked
 DefnLock AS _BYTE '  is defence production locked
 InduLock AS _BYTE '  is factory production locked
 EcoLock AS _BYTE '   is ecology production locked
 TechLock AS _BYTE '  is technology production locked
 Disaster AS _BYTE '  what threat is facing the planet
 Years AS _BYTE '     how long does the planet have
 Solution AS INTEGER 'how much is needed until disaster is averted
 TransCount AS _UNSIGNED _BYTE '# of population being transported
 TransLoc AS _BYTE '  system destination of transports
END TYPE
 
TYPE Game_Data
 Galaxy_Size AS _BYTE
 Difficulty AS _BYTE
 Races AS _BYTE
 Player_Race AS _BYTE
 Player_Colr AS _BYTE
 Player_Name AS STRING * 20
 HomeWorld_Name AS STRING * 20
 Start_Game AS _BYTE
 Frame AS _BYTE 'vortex animation frame
 Selected_Planet AS _BYTE
 Sound_Setting AS _BYTE
 Quit_Game AS _BYTE
END TYPE
 
TYPE Player_Stats
 FactoryCost AS _BYTE
 Factorywaste AS _BYTE
 EcoRestore AS _BYTE
 Computers AS _BYTE
 Construction AS _BYTE
 ForceFeilds AS _BYTE
 Planetology AS _BYTE
 Propulsion AS _BYTE
 WeaponTech AS _BYTE
END TYPE
 
TYPE Font
 Xloc AS _UNSIGNED _BYTE
 Xsiz AS _BYTE
 Xoff AS INTEGER
END TYPE
 
TYPE Ship_Data
 Nam AS STRING * 11
 Siz AS _BYTE
 Img AS _UNSIGNED _BYTE
 Tons AS INTEGER
 Hits AS INTEGER
 Defn AS INTEGER
 Cost AS INTEGER
 Armor AS _BYTE
 Engine AS _BYTE
 Manuver AS _BYTE
 Computer AS _BYTE
 Shield AS _BYTE
 Emc AS _BYTE
 Weapon1 AS _BYTE
 Weapon2 AS _BYTE
 Weapon3 AS _BYTE
 Weapon4 AS _BYTE
 Count1 AS _BYTE
 Count2 AS _BYTE
 Count3 AS _BYTE
 Count4 AS _BYTE
 Special1 AS _BYTE
 Special2 AS _BYTE
 Special3 AS _BYTE
END TYPE
 
SCREEN _NEWIMAGE(640, 400, 32)
CONST TRUE = -1, FALSE = NOT TRUE
CONST CENTER = 2, LEFT = 1
CONST Black = 1, White = 2, Blue = 3, Green = 4, Yellow = 5, Red = 6, Grey = 7, YellowG = 8, WhiteG = 9, GreyG = 10, DkGreen = 11, BrGreen = 12, MdGreen = 13, LtGreen = 14, YellowGA = 15
CONST NORMAL = 0, SMALL = 1, XSMALL = 2, PLANETOID = 3, OUTLINE = 4
CONST ACT = 1, TOT = 2
CONST UPoor = 1, Poor = 2, Norm = 3, Artifact = 6, Rich = 4, URich = 5, Orion = 7
 
DIM SHARED G AS Game_Data, F(2, 66) AS Font, Player(6) AS Player_Stats
DIM SHARED Mix&, Temp&, MFlags AS _BYTE, Saves(6) AS STRING
DIM SHARED Layer(64) AS LONG, T(16) AS LONG, PT(13) AS STRING * 1, PW(7) AS STRING * 10
DIM SHARED Races(10) AS STRING, Rdescript(10) AS STRING, Colrs(6) AS STRING, Leaders(10, 6) AS STRING, Planets(120) AS STRING
DIM SHARED PlanetCount(4), Planet(108) AS Planet_Data, Ship(5, 5) AS Ship_Data
DIM SHARED m AS _MEM
Temp& = _NEWIMAGE(640, 400, 32)
m = _MEMIMAGE(Temp&)
 
DATA Human,Mrrshan,Silicoid,Sakkra,Psilon,Alkari,Klackon,Bulrathi,Meklar,Darlok
DATA "Durash IV","Alexander","Strader","Johann III","Lasitus","Bladrov II","Prrsha","Miamar","Mirana","Shandra","Jasana","Yalara","Igneous","Crystous","Geode","Carnax","Sedimin","Granid","Hissa","Kryssta","Sauron","Tyranid","Guanar","Saurak","Tachaon","Quark","Meson","Kelvan","Dynalon","Zygot  ","Farseer","Skylord","Ariel","Redwing","Highsoar","Sharpclaw","Ixitixl","K'kalak","Kikitik","Xantak","Kaxal","Klaquan","Grunk","Bullux","Krungo","Monch","Durpp","Smurch","M5-35","TX-1138","CB-715","QX-537","INT-986","TVC-15","Ssithra","Nazgur","Darquan","Morfane","Shador","Narzina"
DATA "Sol","Fierias","Cryslon","Sssla","Mentar","Altair","Kholdan","Ursa","Meklon","Nazin","Paranar","Denubius","Antares","Draconis","Zoctan","Rigel","Talas","Moro","Quayal","Neptunus","Jinga","Argus","Escalon","Berel","Collassa","Whynil","Nordia","Tau Cygni","Phyco","Firma","Keeta","Arietis","Rhilus","Willow","Mu Delphi","Stalaz","Gorra","Beta Ceti","Spica","Omicron","Rha","Kailis","Vulcan","Centauri","Herculis","Endoria","Kulthos","Hyboria","Zhardan","Yarrow","Incedius","Paladia","Romulas","Galos","Uxmai","Thrax","Laan","Imra","Selia","Seidon","Tao","Rana","Vox","Maalor","Xudax","Helos","Crypto","Gion","Phantos","Reticuli","Maretta","Toranor","Exis","Tyr","Ajax","Obaca","Dolz","Drakka","Ryoun","Vega","Anraq","Gienah","Rotan","Proxima","Mobas","Iranha","Celtsi","Dunatis","Morrig","Primodius","Nyarl","Ukko","Crius","Hyades","Kronos","Guradas","Rayden","Kakata","Misha","Xendalla","Artemis","Aurora","Proteus","Esper","Darrian","Trax","Xengara","Nitzer","Simius","Bootis","Pollus","Cygni","Aquilae","Volantis","Tauri","Regulus","Klystron","Lyae","Capella","Alcor"
'Font offsets and sizes NORMAL
'     0   1   2   3   4   5   6   7   8   9
DATA 0,6,1,3,0,6,0,7,0,6,0,6,0,6,0,6,0,6,0,6
'     a   b   c   d   e   f   g   h   i   j   k   l   m   n   o   p   q   r   s   t   u   v   w   x   y   z   -   .
DATA 0,7,0,6,0,6,0,6,0,6,0,6,0,6,0,6,2,3,1,5,0,6,0,6,0,7,0,6,0,6,0,6,0,7,0,6,0,6,0,6,0,6,0,7,0,7,0,6,0,6,0,7
DATA 1,4,0,5,0,5,0,5,0,5,0,5,0,5,0,5,2,2,1,4,0,5,2,3,0,7,0,5,0,5,0,5,0,5,0,5,0,5,0,6,0,5,0,6,0,7,0,5,0,5,0,5,0,5,3,4
'----------------------PLANETOID
'     0   1   2   3   4   5   6   7   8   9
DATA 0,7,0,4,0,7,0,7,0,7,0,7,0,7,0,7,0,7,0,7
'     a    b    c    d    e    f    g    h    i   j   k    l    m    n    o    p    q    r    s    t   u    v    w    x    y    z    -   /       .   :
DATA 0,10,0,10,0,10,0,10,0,10,0,10,0,10,0,10,0,5,0,7,0,10,0,10,0,13,0,10,0,10,0,10,0,11,0,10,0,10,0,9,0,10,0,10,0,13,0,10,0,10,0,10
DATA 0,07,0,07,0,07,0,07,0,07,0,06,0,07,0,07,0,4,0,5,0,07,0,04,0,10,0,07,0,07,0,07,0,07,0,07,0,07,0,6,0,07,0,07,0,10,0,07,0,07,0,07,0,7,0,8,0,9,0,4,0,4
 
DATA "expert traders,and magnificent,diplomats"
DATA "superior gunners"
DATA "immune to,hostile plant,evniroments"
DATA "increased,population,growth"
DATA "superior,research,techniques"
DATA "superior pilots"
DATA "increased,worker,production"
DATA "terrific ground,fighters"
DATA "enhanced,factory,controls"
DATA "supreme spies"
DATA Blue,Green,Purple,Red,White,Yellow
DATA 24,48,70,108
'starting ship data
Starting_Ships:
DATA "Scout",0,1,40,3,2,6,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0
DATA "Fighter",0,2,40,3,2,6,1,1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
DATA "Destroyer",1,7,200,18,1,36,1,1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0
DATA "Bomber",1,8,200,18,1,36,1,1,1,0,0,0,3,0,0,0,1,0,0,0,0,0,0
DATA "Colony Ship",2,13,1000,100,0,200,1,1,1,0,0,0,0,0,0,0,0,0,0,0,2,0,0
Planet_Types:
DATA t,j,o,a,s,d,m,b,u,e,i,p,r,,n
Planet_Wealth:
DATA "ultra poor","poor","normal","rich","ultra rich","artifact","orion"
 
Mix& = _NEWIMAGE(640, 400, 32) 'screen premix layer
Layer(2) = _NEWIMAGE(640, 400, 32) 'Main menu animation layer
'Layer(3) = _LOADIMAGE("SpaceLord.bmp", 32)
'Layer(4) = _LOADIMAGE("menuchoice.bmp", 32)
'Layer(5) = _LOADIMAGE("HandPointer.bmp", 32)
'Layer(6) = _LOADIMAGE("NewGame0.bmp", 32)
'Layer(7) = _LOADIMAGE("GameOptions.bmp", 32)
'Layer(8) = _LOADIMAGE("custom0.bmp", 32)
Layer(9) = _NEWIMAGE(640, 400, 32) 'font transferlayer for _clearcolor'_LOADIMAGE("orionFont.bmp", 32)
'Layer(10) = _LOADIMAGE("RaceFaces.bmp", 32)
'Layer(11) = _LOADIMAGE("Flags.bmp", 32)
'Layer(12) = _LOADIMAGE("MainView0.bmp", 32)
'Layer(13) = _LOADIMAGE("Game_Options.bmp", 32)
'Layer(14) = _LOADIMAGE("Design_Screen.bmp", 32)
'Layer(15) = _LOADIMAGE("shipsheet.bmp", 32)
'Layer(16) = _LOADIMAGE("fleetbrb0.bmp", 32)
'Layer(17) = _LOADIMAGE("viewship0.bmp", 32)
'Layer(18) = _LOADIMAGE("shipspec.bmp", 32)
'Layer(19) = _LOADIMAGE("mapview0.bmp", 32)
'Layer(20) = _LOADIMAGE("sky.bmp", 32)
 
'Layer(28) = _LOADIMAGE("FontAdvanced.bmp", 32)
Layer(29) = _NEWIMAGE(1080, 64, 256) 'fontlayer
Layer(30) = _NEWIMAGE(640, 400, 32) 'click layer
 
MFI_Loader "SpaceLordV1.MFI"
 
_CLEARCOLOR _RGB32(0, 0, 0), Layer(3)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(4)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(5)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(9)
'_CLEARCOLOR _RGB32(2, 2, 2), Layer(9)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(11)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(12)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(13)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(15)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(17)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(18)
_CLEARCOLOR _RGB32(3, 3, 3), Layer(19)
 
_CLEARCOLOR 0, Layer(29)
'randomize timer
InitFont 0
_DELAY .33 'time for window to load
_TITLE "Master Of Orion 64"
 
_SOURCE Layer(30) 'set to Click layer for mouse checking. only layer that needs to be checked.
 
MFlags = 12 'menu option flags; 1-autosave file found, 2-saved games found,4-new game option, 8-quit game option
Check_Saves
 
'----------------Load data-----------------
FOR i%% = 1 TO 10 'load race names
 READ Races(i%%)
NEXT i%%
FOR i%% = 1 TO 10 'load leader default names
 FOR j%% = 1 TO 6
  READ Leaders(i%%, j%%)
 NEXT j%%
NEXT i%%
FOR i%% = 1 TO 120 'load planet default names
 READ Planets(i%%)
NEXT i%%
FOR i%% = 0 TO 63 'load font offset/sizes NORMAL
 READ F(0, i%%).Xloc, F(0, i%%).Xsiz
NEXT i%%
'------load font offset/sizes PLANETIOD-----
READ F(1, 0).Xloc, F(1, 0).Xsiz
F(1, 0).Xoff = 0
FOR i%% = 1 TO 66
 READ F(1, i%%).Xloc, F(1, i%%).Xsiz
 F(1, i%%).Xoff = F(1, i%% - 1).Xoff + F(1, i%% - 1).Xsiz
NEXT i%%
 
FOR i%% = 1 TO 10
 READ Rdescript(i%%)
NEXT i%%
FOR i%% = 1 TO 6
 READ Colrs(i%%)
NEXT i%%
FOR i%% = 1 TO 4
 READ PlanetCount(i%%)
NEXT i%%
RESTORE Starting_Ships
FOR i%% = 0 TO 4
 READ Ship(0, i%%).Nam
 READ Ship(0, i%%).Siz
 READ Ship(0, i%%).Img
 READ Ship(0, i%%).Tons
 READ Ship(0, i%%).Hits
 READ Ship(0, i%%).Defn
 READ Ship(0, i%%).Cost
 READ Ship(0, i%%).Armor
 READ Ship(0, i%%).Engine
 READ Ship(0, i%%).Manuver
 READ Ship(0, i%%).Computer
 READ Ship(0, i%%).Shield
 READ Ship(0, i%%).Emc
 READ Ship(0, i%%).Weapon1
 READ Ship(0, i%%).Weapon2
 READ Ship(0, i%%).Weapon3
 READ Ship(0, i%%).Weapon4
 READ Ship(0, i%%).Count1
 READ Ship(0, i%%).Count2
 READ Ship(0, i%%).Count3
 READ Ship(0, i%%).Count4
 READ Ship(0, i%%).Special1
 READ Ship(0, i%%).Special2
 READ Ship(0, i%%).Special3
NEXT i%%
RESTORE Planet_Types
FOR i%% = 0 TO 12
 READ PT(i%%)
NEXT i%%
 
RESTORE Planet_Wealth
FOR i%% = 1 TO 7
 READ PW(i%%)
NEXT i%%
 
'-----------------------------------------------
 
T(1) = _FREETIMER 'menu animation timer
T(2) = _FREETIMER 'Banner wave animation timer
ON TIMER(T(1), .1) MenuAnimation
ON TIMER(T(2), .095) WaveAnimation
 
G.Player_Race = 1
G.Player_Colr = 1
G.Galaxy_Size = 0
G.Difficulty = 0
G.Races = 0
 
G.Races = 1
G.Player_Race = 1
G.Player_Colr = 1
G.Galaxy_Size = 1
Player(1).FactoryCost = 10
Player(1).Factorywaste = 100
Player(1).EcoRestore = 2
'Play_Game
'Ship_Design
'Fleet
'SLEEP
'SYSTEM
'END
'------------Main Loop-------------------
Play_Intro
ClearLayer Layer(2)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(2)
 
DO
 Nul%% = MainMenu
 SELECT CASE Nul%%
  CASE 1 'Continue game(AutoSaved)
  CASE 2 'load game
  CASE 3 'new game
   TIMER(T(1)) OFF
   IF NewGame <> 4 THEN
    IF Choose_Race <> -1 THEN
     IF Choose_Banner <> -1 THEN
      G.Start_Game = TRUE
      Choose_Leader_Name
      Choose_System_Name
      TIMER(T(2)) OFF
     ELSE 'user escaped from new game setup
      TIMER(T(2)) OFF
      TIMER(T(1)) ON
     END IF
    ELSE 'user escaped from new game setup
     TIMER(T(1)) ON
    END IF
   ELSE 'user escaped from new game setup
    TIMER(T(1)) ON
   END IF
  CASE 4
   ExitFlag%% = TRUE
 END SELECT
 
 IF G.Start_Game THEN Play_Game
 
LOOP UNTIL ExitFlag%%
'----------------------------------------
 
CLS
SCREEN 12: COLOR 7
PRINT "Thanks for playing Master Of Orion!"
IF _FILEEXISTS("DatatempI.dat") THEN KILL "DatatempI.dat"
IF _FILEEXISTS("DatatempA.dat") THEN KILL "DatatempA.dat"
SLEEP
SYSTEM
 
SUB Play_Game
 BuildClickLayer Layer(30), 5
 'create the Universe!
 Make_Planets
 'bring up main screen
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Button_Down_Lock
 
   SELECT CASE Opt%%
    CASE 1 'ship bar
     Amt%% = MX% - 504
     Planet(G.Selected_Planet).Ship = Amt%% * 2
     AdjustProductionValues 1
    CASE 2 'defn bar
     Amt%% = MX% - 504
     Planet(G.Selected_Planet).Defn = Amt%% * 2
     AdjustProductionValues 2
    CASE 3 'indu bar
     Amt%% = MX% - 504
     Planet(G.Selected_Planet).Indu = Amt%% * 2
     AdjustProductionValues 3
    CASE 4 'eco bar
     Amt%% = MX% - 504
     Planet(G.Selected_Planet).Eco = Amt%% * 2
     AdjustProductionValues 4
    CASE 5 'tech bar
     Amt%% = MX% - 504
     Planet(G.Selected_Planet).Tech = Amt%% * 2
     AdjustProductionValues 5
    CASE 6
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 2
     IF Planet(G.Selected_Planet).Ship <= -2 THEN Planet(G.Selected_Planet).Ship = 0
     AdjustProductionValues 1
    CASE 7
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 2
     IF Planet(G.Selected_Planet).Defn <= -2 THEN Planet(G.Selected_Planet).Defn = 0
     AdjustProductionValues 2
    CASE 8
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 2
     IF Planet(G.Selected_Planet).Indu <= -2 THEN Planet(G.Selected_Planet).Indu = 0
     AdjustProductionValues 3
    CASE 9
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 2
     IF Planet(G.Selected_Planet).Eco <= -2 THEN Planet(G.Selected_Planet).Eco = 0
     AdjustProductionValues 4
    CASE 10
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 2
     IF Planet(G.Selected_Planet).Tech <= -2 THEN Planet(G.Selected_Planet).Tech = 0
     AdjustProductionValues 5
    CASE 11
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + 2
     IF Planet(G.Selected_Planet).Ship >= 102 THEN Planet(G.Selected_Planet).Ship = 100
     AdjustProductionValues 1
    CASE 12
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + 2
     IF Planet(G.Selected_Planet).Defn >= 102 THEN Planet(G.Selected_Planet).Defn = 100
     AdjustProductionValues 2
    CASE 13
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + 2
     IF Planet(G.Selected_Planet).Indu >= 102 THEN Planet(G.Selected_Planet).Indu = 100
     AdjustProductionValues 3
    CASE 14
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + 2
     IF Planet(G.Selected_Planet).Eco >= 102 THEN Planet(G.Selected_Planet).Eco = 100
     AdjustProductionValues 4
    CASE 15
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + 2
     IF Planet(G.Selected_Planet).Tech >= 102 THEN Planet(G.Selected_Planet).Tech = 100
     AdjustProductionValues 5
    CASE 16
     IF Planet(G.Selected_Planet).Shiplock THEN Planet(G.Selected_Planet).Shiplock = FALSE ELSE Planet(G.Selected_Planet).Shiplock = TRUE
    CASE 17
     IF Planet(G.Selected_Planet).DefnLock THEN Planet(G.Selected_Planet).DefnLock = FALSE ELSE Planet(G.Selected_Planet).DefnLock = TRUE
    CASE 18
     IF Planet(G.Selected_Planet).InduLock THEN Planet(G.Selected_Planet).InduLock = FALSE ELSE Planet(G.Selected_Planet).InduLock = TRUE
    CASE 19
     IF Planet(G.Selected_Planet).EcoLock THEN Planet(G.Selected_Planet).EcoLock = FALSE ELSE Planet(G.Selected_Planet).EcoLock = TRUE
    CASE 20
     IF Planet(G.Selected_Planet).TechLock THEN Planet(G.Selected_Planet).TechLock = FALSE ELSE Planet(G.Selected_Planet).TechLock = TRUE
    CASE 21
    CASE 22
    CASE 23
    CASE 24
     Game_Options
     IF G.Quit_Game THEN Exitflag%% = TRUE
    CASE 25
     Ship_Design
    CASE 26
     Fleet
    CASE 27
     View_Map
    CASE 28
    CASE 29
    CASE 30
    CASE 31
   END SELECT
  END IF
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(12), Mix&, (0, 0)-STEP(319, 199)
  IF Planet(G.Selected_Planet).Race1Visit THEN
   _PUTIMAGE (448, 10)-STEP(182, 348), Layer(12), Mix&, (320, 0)-STEP(90, 173)
  END IF
 
  BuildMainGameDisplay Opt%%
  Resource_Display
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .04
  IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
 LOOP UNTIL Exitflag%%
END SUB
 
SUB View_Map
 BuildClickLayer Layer(30), 10
 Selection%% = 1
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   IF Opt%% <> 0 THEN Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 4 'OK
     Exitflag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
  _PUTIMAGE (0, 0)-STEP(487, 399), Layer(20), Mix&, (0, 0)-STEP(243, 199)
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(19), Mix&, (0, 0)-STEP(319, 199)
 
  IF Selection%% = 1 THEN _PUTIMAGE (490, 52)-STEP(121, 23), Layer(4), Mix&, (61, 110)-STEP(60, 11) ELSE _PUTIMAGE (490, 52)-STEP(121, 23), Layer(4), Mix&, (0, 110)-STEP(60, 11)
  IF Selection%% = 2 THEN _PUTIMAGE (490, 92)-STEP(121, 23), Layer(4), Mix&, (61, 122)-STEP(60, 11) ELSE _PUTIMAGE (490, 92)-STEP(121, 23), Layer(4), Mix&, (0, 122)-STEP(60, 11)
  IF Selection%% = 3 THEN _PUTIMAGE (490, 132)-STEP(121, 23), Layer(4), Mix&, (61, 134)-STEP(60, 11) ELSE _PUTIMAGE (490, 132)-STEP(121, 23), Layer(4), Mix&, (0, 134)-STEP(60, 11)
  IF Selection%% = 4 THEN _PUTIMAGE (490, 360)-STEP(121, 23), Layer(4), Mix&, (61, 146)-STEP(60, 11) ELSE _PUTIMAGE (490, 360)-STEP(121, 23), Layer(4), Mix&, (0, 146)-STEP(60, 11)
 
  IF Selection%% <> 1 THEN
   FOR i%% = 0 TO PlanetCount(G.Galaxy_Size) - 1
    IF Planet(i%%).Race1Visit THEN
     _PUTIMAGE (INT(Planet(i%%).XLoc * 2.25), Planet(i%%).YLoc * 2)-STEP(13, 13), Layer(4), Mix&, (109 + (Planet(i%%).Colr * 8), 65)-STEP(6, 6)
     IF Selection%% = 2 THEN Oprint INT(Planet(i%%).XLoc * 2.25) + 16, Planet(i%%).YLoc * 2, PT(Planet(i%%).Environ), Green, XSMALL
     IF Selection%% = 3 THEN
      ox%% = INT(LEN(RTRIM$(PW(Planet(i%%).Wealth))) \ 2) * 4
      IF Planet(i%%).Wealth = 1 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Red, XSMALL
      IF Planet(i%%).Wealth = 2 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Red, XSMALL
      IF Planet(i%%).Wealth = 4 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Blue, XSMALL
      IF Planet(i%%).Wealth = 5 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Blue, XSMALL
      IF Planet(i%%).Wealth = 6 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Green, XSMALL
      IF Planet(i%%).Wealth = 7 THEN Oprint INT(Planet(i%%).XLoc * 2.25) - ox%%, Planet(i%%).YLoc * 2 + 12, PW(Planet(i%%).Wealth), Green, XSMALL
     END IF
    ELSE
     _PUTIMAGE (INT(Planet(i%%).XLoc * 2.25) + 1, Planet(i%%).YLoc * 2 + 1)-STEP(9, 9), Layer(4), Mix&, (62, 64)-STEP(4, 4)
    END IF
   NEXT i%%
  ELSE
   FOR i%% = 0 TO PlanetCount(G.Galaxy_Size) - 1
    _PUTIMAGE (INT(Planet(i%%).XLoc * 2.25), Planet(i%%).YLoc * 2)-STEP(13, 13), Layer(4), Mix&, (109 + (Planet(i%%).Colr * 8), 65)-STEP(6, 6)
   NEXT i%%
  END IF
 
  Oprint 482, 14, "Galaxy Map", YellowGA, PLANETOID
  Oprint 496, 172, "Map Key", YellowGA, PLANETOID
  SELECT CASE Selection%%
   CASE 1
    FOR i%% = 1 TO G.Races
    NEXT i%%
   CASE 2
    Oprint 482, 208, "t", Green, XSMALL
    Oprint 482, 222, "j", Green, XSMALL
    Oprint 482, 236, "o", Green, XSMALL
    Oprint 482, 250, "a", Green, XSMALL
    Oprint 482, 264, "s", Green, XSMALL
    Oprint 482, 278, "d", Green, XSMALL
    Oprint 482, 292, "m", Green, XSMALL
    Oprint 552, 208, "b", Red, XSMALL
    Oprint 552, 222, "u", Red, XSMALL
    Oprint 552, 236, "e", Red, XSMALL
    Oprint 552, 250, "i", Red, XSMALL
    Oprint 552, 264, "p", Red, XSMALL
    Oprint 552, 278, "r", Red, XSMALL
    Oprint 552, 292, "n", Red, XSMALL
    Oprint 494, 208, "terran", Black, XSMALL
    Oprint 494, 222, "jungle", Black, XSMALL
    Oprint 494, 236, "ocean", Black, XSMALL
    Oprint 494, 250, "arid", Black, XSMALL
    Oprint 494, 264, "steppe", Black, XSMALL
    Oprint 494, 278, "desert", Black, XSMALL
    Oprint 494, 292, "minimal", Black, XSMALL
    Oprint 564, 208, "barren", Black, XSMALL
    Oprint 564, 222, "tundra", Black, XSMALL
    Oprint 564, 236, "dead", Black, XSMALL
    Oprint 564, 250, "inferno", Black, XSMALL
    Oprint 564, 264, "toxic", Black, XSMALL
    Oprint 564, 278, "radiated", Black, XSMALL
    Oprint 564, 292, "none", Black, XSMALL
    _PUTIMAGE (482, 320)-STEP(7, 7), Layer(4), Mix&, (63, 69)-STEP(3, 3)
    Oprint 494, 318, "unable to land on", Black, XSMALL
   CASE 3
    _PUTIMAGE (476, 200)-STEP(149, 139), Layer(4), Mix&, (1, 159)-STEP(74, 69)
 
  END SELECT
 
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
 
 LOOP UNTIL Exitflag%%
 ClearLayer Mix&
 BuildClickLayer Layer(30), 5
 
END SUB
 
SUB Game_Options
 BuildClickLayer Layer(30), 6
 Temp& = _COPYIMAGE(_DISPLAY)
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 1 'save game
     Save_Game
    CASE 2 ' load game
     Load_Game
    CASE 3 'quit game
     G.Quit_Game = TRUE
     Exitflag%% = TRUE
    CASE 4 'no sound
     G.Sound_Setting = FALSE
    CASE 5 'SFX only
     G.Sound_Setting = 1
    CASE 6 'full sound&music
     G.Sound_Setting = 2
    CASE 7 'OK
     Exitflag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(13), Mix&, (0, 0)-STEP(319, 199)
  SELECT CASE G.Sound_Setting
   CASE 0
    _PUTIMAGE (422, 114)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
   CASE 1
    _PUTIMAGE (422, 164)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
   CASE 2
    _PUTIMAGE (422, 214)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
  END SELECT
 
  SELECT CASE Selection%%
   CASE 1
    _PUTIMAGE (232, 114)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
   CASE 2
    _PUTIMAGE (232, 164)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
   CASE 3
    _PUTIMAGE (232, 214)-STEP(143, 27), Layer(13), Mix&, (320, 66)-STEP(70, 13)
  END SELECT
 
  _PUTIMAGE (268, 114)-STEP(72, 27), Layer(13), Mix&, (320, 1)-STEP(35, 13)
  _PUTIMAGE (270, 164)-STEP(72, 27), Layer(13), Mix&, (320, 26)-STEP(35, 13)
  _PUTIMAGE (266, 214)-STEP(72, 27), Layer(13), Mix&, (320, 51)-STEP(35, 13)
 
  _PUTIMAGE (458, 114)-STEP(76, 27), Layer(13), Mix&, (362, 1)-STEP(37, 13)
  _PUTIMAGE (442, 164)-STEP(106, 27), Layer(13), Mix&, (356, 26)-STEP(52, 13)
  _PUTIMAGE (458, 214)-STEP(80, 27), Layer(13), Mix&, (364, 51)-STEP(39, 13)
 
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
 
 LOOP UNTIL Exitflag%%
 BuildClickLayer Layer(30), 5
 ClearLayer Mix&
 _PUTIMAGE , Temp&, Mix&
 _FREEIMAGE Temp&
END SUB
 
SUB Fleet
 ClearLayer Mix&
 BuildClickLayer Layer(30), 9
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 1
     Ship_Specs
     Selection%% = 0
    CASE 2
    CASE 3
     ExitFlag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(16), Mix&, (0, 0)-STEP(319, 199)
  FOR y%% = 0 TO 4
   _PUTIMAGE (14, 34 + (y%% * 66))-STEP(67, 51), Layer(4), Mix&, (128, 84)-STEP(33, 25)
   FOR x%% = 1 TO 6
    _PUTIMAGE (8 + (x%% * 88), 34 + (y%% * 66))-STEP(73, 51), Layer(4), Mix&, (128, 84)-STEP(33, 25)
    _PUTIMAGE (4 + (x%% * 88), 10)-STEP(81, 13), Layer(4), Mix&, (128, 84)-STEP(33, 25)
    Cntr%% = LEN(RTRIM$(Ship(0, x%% - 1).Nam)) * 6 / 2
    Oprint 40 + (x%% * 88) - Cntr%%, 12, RTRIM$(Ship(0, x%% - 1).Nam), Yellow, XSMALL
   NEXT
  NEXT
  _PUTIMAGE (12, 10)-STEP(69, 13), Layer(4), Mix&, (128, 77)-STEP(34, 6)
  IF Selection%% = 1 THEN _PUTIMAGE (362, 364)-STEP(69, 21), Layer(4), Mix&, (202, 74)-STEP(34, 10) ELSE _PUTIMAGE (362, 364)-STEP(69, 21), Layer(4), Mix&, (166, 74)-STEP(34, 10)
  IF Selection%% = 2 THEN _PUTIMAGE (450, 364)-STEP(69, 21), Layer(4), Mix&, (202, 86)-STEP(34, 10) ELSE _PUTIMAGE (450, 364)-STEP(69, 21), Layer(4), Mix&, (166, 86)-STEP(34, 10)
  IF Selection%% = 3 THEN _PUTIMAGE (538, 364)-STEP(69, 21), Layer(4), Mix&, (202, 98)-STEP(34, 10) ELSE _PUTIMAGE (538, 364)-STEP(69, 21), Layer(4), Mix&, (166, 98)-STEP(34, 10)
 
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 
 LOOP UNTIL ExitFlag%%
 ClearLayer Mix&
 BuildClickLayer Layer(30), 5
END SUB
 
SUB Ship_Specs
 ClearLayer Mix&
 BuildClickLayer Layer(30), 10
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 1
    CASE 2
    CASE 3
     ExitFlag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(4), Mix&, (128, 84)-STEP(33, 25)
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(17), Mix&, (0, 0)-STEP(319, 199)
  _PUTIMAGE (94, 8)-STEP(239, 59), Layer(18), Mix&, (0, 0)-STEP(119, 29)
 
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 
 LOOP UNTIL ExitFlag%%
 BuildClickLayer Layer(30), 9
 
END SUB
 
SUB Save_Game
 ClearLayer Mix&
 BuildClickLayer Layer(30), 7
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 7
     ExitFlag%% = TRUE
    CASE 8
     ExitFlag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(13), Mix&, (0, 200)-STEP(319, 199)
  FOR i%% = 0 TO 5
   _PUTIMAGE (268, 66 + (i%% * 36))-STEP(18, 18), Layer(13), Mix&, (329, 80)-STEP(8, 8)
  NEXT i%%
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 
 LOOP UNTIL ExitFlag%%
 BuildClickLayer Layer(30), 6
END SUB
 
SUB Load_Game
 ClearLayer Mix&
 BuildClickLayer Layer(30), 7
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 7
     ExitFlag%% = TRUE
    CASE 8
     ExitFlag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(13), Mix&, (320, 200)-STEP(319, 199)
  FOR i%% = 0 TO 5
   _PUTIMAGE (268, 66 + (i%% * 36))-STEP(18, 18), Layer(13), Mix&, (329, 80)-STEP(8, 8)
  NEXT i%%
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 
 LOOP UNTIL ExitFlag%%
 BuildClickLayer Layer(30), 6
END SUB
 
SUB Ship_Design
 ClearLayer Mix&
 BuildClickLayer Layer(30), 8
 DO
  nul% = _MOUSEINPUT
  MX% = _MOUSEX
  MY% = _MOUSEY
  Opt%% = Check_Pos(MX%, MY%)
  IF _MOUSEBUTTON(1) THEN
   Clickset%% = TRUE
   Selection%% = Opt%%
  END IF
 
  IF Clickset%% AND (NOT _MOUSEBUTTON(1)) THEN
   SELECT CASE Selection%%
    CASE 1
     ExitFlag%% = TRUE
    CASE 8
     ExitFlag%% = TRUE
   END SELECT
   Clickset%% = FALSE
  END IF
 
 
  _PUTIMAGE (0, 0)-STEP(639, 399), Layer(14), Mix&, (0, 0)-STEP(319, 199)
  IF Ship(0, 0).Siz = 0 THEN Oprint 52, 326, "SMALL", White, SMALL ELSE Oprint 52, 326, "SMALL", Grey, SMALL
  IF Ship(0, 0).Siz = 1 THEN Oprint 48, 340, "MEDIUM", White, SMALL ELSE Oprint 48, 340, "MEDIUM", Grey, SMALL
  IF Ship(0, 0).Siz = 2 THEN Oprint 52, 354, "LARGE", White, SMALL ELSE Oprint 52, 354, "LARGE", Grey, SMALL
  IF Ship(0, 0).Siz = 3 THEN Oprint 58, 368, "HUGE", White, SMALL ELSE Oprint 58, 368, "HUGE", Grey, SMALL
  Oprint 34, 232, "Special 1", DkGreen, SMALL
  Oprint 34, 252, "Special 2", DkGreen, SMALL
  Oprint 34, 272, "Special 3", DkGreen, SMALL
  Oprint 34, 142, "Weapon 1", DkGreen, SMALL
  Oprint 34, 162, "Weapon 2", DkGreen, SMALL
  Oprint 34, 182, "Weapon 3", DkGreen, SMALL
  Oprint 34, 202, "Weapon 4", DkGreen, SMALL
  Oprint 118, 122, "Count  Ship Weapons       Damage  Rng  Notes", DkGreen, SMALL
  Oprint 34, 44, "Computer", DkGreen, SMALL
  Oprint 34, 68, "Sheild", DkGreen, SMALL
  Oprint 34, 92, "Ecm", DkGreen, SMALL
  Oprint 202, 44, "Attack Level", MdGreen, XSMALL
  Oprint 202, 68, "", MdGreen, XSMALL
  Oprint 202, 92, "Missile Def", MdGreen, XSMALL
  Oprint 334, 44, "Armor", DkGreen, SMALL
  Oprint 334, 68, "Engine", DkGreen, SMALL
  Oprint 334, 92, "Maneuver", DkGreen, SMALL
  Oprint 500, 44, "hit points", MdGreen, XSMALL
  Oprint 500, 68, "warp    def", MdGreen, XSMALL
  Oprint 500, 92, "combat speed", MdGreen, XSMALL
  _PUTIMAGE (118, 138)-STEP(9, 7), Layer(4), Mix&, (47, 101)-STEP(4, 3)
  _PUTIMAGE (118, 148)-STEP(9, 7), Layer(4), Mix&, (47, 106)-STEP(4, 3)
  _PUTIMAGE (118, 158)-STEP(9, 7), Layer(4), Mix&, (47, 101)-STEP(4, 3)
  _PUTIMAGE (118, 168)-STEP(9, 7), Layer(4), Mix&, (47, 106)-STEP(4, 3)
  _PUTIMAGE (118, 178)-STEP(9, 7), Layer(4), Mix&, (47, 101)-STEP(4, 3)
  _PUTIMAGE (118, 188)-STEP(9, 7), Layer(4), Mix&, (47, 106)-STEP(4, 3)
  _PUTIMAGE (118, 198)-STEP(9, 7), Layer(4), Mix&, (47, 101)-STEP(4, 3)
  _PUTIMAGE (118, 208)-STEP(9, 7), Layer(4), Mix&, (47, 106)-STEP(4, 3)
 
  _PUTIMAGE (286, 324)-STEP(11, 41), Layer(4), Mix&, (52, 79)-STEP(5, 20) 'button up
  _PUTIMAGE (286, 358)-STEP(11, 41), Layer(4), Mix&, (52, 96)-STEP(5, 20)
  '  _PUTIMAGE (286, 324)-STEP(11, 41), Layer(4), Mix&, (59, 79)-STEP(5, 20) 'button down
  '  _PUTIMAGE (286, 358)-STEP(11, 41), Layer(4), Mix&, (59, 96)-STEP(5, 20)
 
  _PUTIMAGE (564, 300)-STEP(57, 21), Layer(4), Mix&, (68, 74)-STEP(28, 10) 'cancel
  _PUTIMAGE (564, 332)-STEP(57, 21), Layer(4), Mix&, (68, 86)-STEP(28, 10) 'clear
  _PUTIMAGE (564, 364)-STEP(57, 21), Layer(4), Mix&, (68, 98)-STEP(28, 10) 'Build
  Oprint 540 - (LEN(RTRIM$(Ship(0, 0).Nam)) * 9), 302, UCASE$(RTRIM$(Ship(0, 0).Nam)), White, SMALL
  Oprint 540 - (LEN(RTRIM$(LTRIM$(STR$(Ship(0, 0).Tons)))) * 8), 350, LTRIM$(STR$(Ship(0, 0).Tons)), White, SMALL
 
  Display_Ship 184, 328, 1, Ship(0, 0).Img, 0
  _PUTIMAGE , Mix&, _DISPLAY
  DO: LOOP WHILE _MOUSEINPUT
  _DELAY .05
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 
 LOOP UNTIL ExitFlag%%
 ClearLayer Mix&
 BuildClickLayer Layer(30), 5
 
END SUB
 
SUB Display_Ship (X%, Y%, C%, T%, F%)
 'X%,Y%- Location to display ship
 'C%-Which color ship to display(0-5)
 'T%-which type\model of ship(0-35)
 'F%-Frame of animation of ship to display(0-4)
 C% = C% - 1: T% = T% - 1
 _PUTIMAGE (X%, Y%)-STEP(63, 47), Layer(15), Mix&, (0 + (C% * 165 + F% * 33), 0 + (T% * 25))-STEP(31, 23)
END SUB
 
FUNCTION TotalResourceDistrubution~%% (P%%)
 Total~%% = Planet(P%%).Ship + Planet(P%%).Defn + Planet(P%%).Indu
 Total~%% = Total~%% + Planet(P%%).Eco + Planet(P%%).Tech
 TotalResourceDistrubution~%% = Total~%%
END SUB
 
SUB AdjustProductionValues (Opt%%)
 'auto adjust so maximum production is 100, this is where the actual game cheats from time
 ' to time by allowing other races to have more than 100% production. Have seen values as
 ' high at 2600% before.
 'try to pull from bottom up save for TECH which pulls from the top down
 temp~%% = TotalResourceDistrubution(G.Selected_Planet) 'how much over 100 is planet
 
 IF temp~%% > 100 THEN
  temp~%% = temp~%% - 100 'how much needs pulled
  SELECT CASE Opt%%
   CASE 1 'ship change
    DO
     IF Planet(G.Selected_Planet).Tech > 0 AND (NOT Planet(G.Selected_Planet).TechLock) THEN
      Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Eco > 0 AND (NOT Planet(G.Selected_Planet).EcoLock) THEN
      Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Indu > 0 AND (NOT Planet(G.Selected_Planet).InduLock) THEN
      Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Defn > 0 AND (NOT Planet(G.Selected_Planet).DefnLock) THEN
      Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 1
      temp~%% = temp~%% - 1
     ELSE 'no other source of free production avaliable
      Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 1
      temp~%% = temp~%% - 1
     END IF
    LOOP UNTIL temp~%% = 0
   CASE 2 'defence change
    DO
     IF Planet(G.Selected_Planet).Tech > 0 AND (NOT Planet(G.Selected_Planet).TechLock) THEN
      Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Eco > 0 AND (NOT Planet(G.Selected_Planet).EcoLock) THEN
      Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Indu > 0 AND (NOT Planet(G.Selected_Planet).InduLock) THEN
      Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Ship > 0 AND (NOT Planet(G.Selected_Planet).Shiplock) THEN
      Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 1
      temp~%% = temp~%% - 1
     ELSE 'no other source of free production avaliable
      Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 1
      temp~%% = temp~%% - 1
     END IF
    LOOP UNTIL temp~%% = 0
   CASE 3 'Industry change
    DO
     IF Planet(G.Selected_Planet).Tech > 0 AND (NOT Planet(G.Selected_Planet).TechLock) THEN
      Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Eco > 0 AND (NOT Planet(G.Selected_Planet).EcoLock) THEN
      Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Ship > 0 AND (NOT Planet(G.Selected_Planet).Shiplock) THEN
      Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Defn > 0 AND (NOT Planet(G.Selected_Planet).DefnLock) THEN
      Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 1
      temp~%% = temp~%% - 1
     ELSE 'no other source of free production avaliable
      Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 1
      temp~%% = temp~%% - 1
     END IF
    LOOP UNTIL temp~%% = 0
   CASE 4 'Ecological change
    DO
     IF Planet(G.Selected_Planet).Tech > 0 AND (NOT Planet(G.Selected_Planet).TechLock) THEN
      Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Ship > 0 AND (NOT Planet(G.Selected_Planet).Shiplock) THEN
      Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Indu > 0 AND (NOT Planet(G.Selected_Planet).InduLock) THEN
      Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Defn > 0 AND (NOT Planet(G.Selected_Planet).DefnLock) THEN
      Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 1
      temp~%% = temp~%% - 1
     ELSE 'no other source of free production avaliable
      Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 1
      temp~%% = temp~%% - 1
     END IF
    LOOP UNTIL temp~%% = 0
   CASE 5 'technology change
    DO
     IF Planet(G.Selected_Planet).Ship > 0 AND (NOT Planet(G.Selected_Planet).Shiplock) THEN
      Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Defn > 0 AND (NOT Planet(G.Selected_Planet).DefnLock) THEN
      Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Indu > 0 AND (NOT Planet(G.Selected_Planet).InduLock) THEN
      Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu - 1
      temp~%% = temp~%% - 1
     ELSEIF Planet(G.Selected_Planet).Eco > 0 AND (NOT Planet(G.Selected_Planet).EcoLock) THEN
      Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco - 1
      temp~%% = temp~%% - 1
     ELSE 'no other source of free production avaliable
      Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech - 1
      temp~%% = temp~%% - 1
     END IF
    LOOP UNTIL temp~%% = 0
  END SELECT
 ELSE 'a production has been reduced so add to another production bar
  temp~%% = 100 - temp~%% 'how much to add back in to make 100 again
  SELECT CASE Opt%%
   CASE 1 'ship shifts to tech(if not locked)
    IF NOT Planet(G.Selected_Planet).TechLock THEN
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).EcoLock THEN
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).InduLock THEN
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).DefnLock THEN
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + temp~%%
    ELSE
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + temp~%%
    END IF
   CASE 2 'defn shifts to tech(if not locked)
    IF NOT Planet(G.Selected_Planet).TechLock THEN
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).EcoLock THEN
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).InduLock THEN
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).Shiplock THEN
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + temp~%%
    ELSE 'everything else is locked so put produciton back in defence
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + temp~%%
    END IF
   CASE 3 'indu shifts to tech(if not locked)
    IF NOT Planet(G.Selected_Planet).TechLock THEN
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).Shiplock THEN
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).DefnLock THEN
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).EcoLock THEN
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + temp~%%
    ELSE 'everything else is locked so put produciton back in industry
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + temp~%%
    END IF
   CASE 4 'eco shifts to tech(if not locked)
    IF NOT Planet(G.Selected_Planet).TechLock THEN
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).Shiplock THEN
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).InduLock THEN
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).DefnLock THEN
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + temp~%%
    ELSE 'everything else is locked so put produciton back in ecology
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + temp~%%
    END IF
   CASE 5 'tech shifts to ship (if not locked)
    IF NOT Planet(G.Selected_Planet).Shiplock THEN
     Planet(G.Selected_Planet).Ship = Planet(G.Selected_Planet).Ship + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).DefnLock THEN
     Planet(G.Selected_Planet).Defn = Planet(G.Selected_Planet).Defn + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).InduLock THEN
     Planet(G.Selected_Planet).Indu = Planet(G.Selected_Planet).Indu + temp~%%
    ELSEIF NOT Planet(G.Selected_Planet).EcoLock THEN
     Planet(G.Selected_Planet).Eco = Planet(G.Selected_Planet).Eco + temp~%%
    ELSE 'everything else is locked so put produciton back in techology
     Planet(G.Selected_Planet).Tech = Planet(G.Selected_Planet).Tech + temp~%%
    END IF
  END SELECT
 END IF
END SUB
 
 
 
SUB BuildMainGameDisplay (MO%)
 Oprint 545 - (LEN(RTRIM$(Planet(G.Selected_Planet).Name)) / 2) * 20, 18, Planet(G.Selected_Planet).Name, YellowG, PLANETOID
 Oprint 18, 366, "Game", OUTLINE, OUTLINE
 Oprint 86, 366, "Design", OUTLINE, OUTLINE
 Oprint 164, 366, "Fleet", OUTLINE, OUTLINE
 Oprint 236, 366, "Map", OUTLINE, OUTLINE
 Oprint 292, 366, "Races", OUTLINE, OUTLINE
 Oprint 366, 366, "Planets", OUTLINE, OUTLINE
 Oprint 458, 366, "Tech", OUTLINE, OUTLINE
 Oprint 524, 366, "Next Turn", OUTLINE, OUTLINE
 
 IF MO% = 24 THEN Oprint 18, 368, "Game", White, NORMAL ELSE Oprint 18, 368, "Game", Grey, NORMAL
 IF MO% = 25 THEN Oprint 86, 368, "Design", White, NORMAL ELSE Oprint 86, 368, "Design", Grey, NORMAL
 IF MO% = 26 THEN Oprint 164, 368, "Fleet", White, NORMAL ELSE Oprint 164, 368, "Fleet", Grey, NORMAL
 IF MO% = 27 THEN Oprint 236, 368, "Map", White, NORMAL ELSE Oprint 236, 368, "Map", Grey, NORMAL
 IF MO% = 28 THEN Oprint 292, 368, "Races", White, NORMAL ELSE Oprint 292, 368, "Races", Grey, NORMAL
 IF MO% = 29 THEN Oprint 366, 368, "Planets", White, NORMAL ELSE Oprint 366, 368, "Planets", Grey, NORMAL
 IF MO% = 30 THEN Oprint 458, 368, "Tech", White, NORMAL ELSE Oprint 458, 368, "Tech", Grey, NORMAL
 IF MO% = 31 THEN Oprint 524, 368, "Next Turn", White, NORMAL ELSE Oprint 524, 368, "Next Turn", Grey, NORMAL
 
 Oprint 526 - LEN(LTRIM$(RTRIM$(STR$(Planet(G.Selected_Planet).CurPop)))) * 4, 122, LTRIM$(RTRIM$(STR$(Planet(G.Selected_Planet).CurPop))), Yellow, XSMALL
 Oprint 622 - LEN(LTRIM$(RTRIM$(STR$(Planet(G.Selected_Planet).Bases)))) * 4, 122, LTRIM$(RTRIM$(STR$(Planet(G.Selected_Planet).Bases))), Yellow, XSMALL
 TotOff%% = (LEN(LTRIM$(RTRIM$(STR$(PlanetProduction(TOT))))) + 2) * 4
 Oprint 614 - TotOff%%, 144, "(" + LTRIM$(RTRIM$(STR$(PlanetProduction(TOT)))) + ")", Green, XSMALL
 Oprint 614 - (LEN(LTRIM$(RTRIM$(STR$(PlanetProduction(ACT))))) + 2) * 4 - (TotOff%% + 4), 144, LTRIM$(RTRIM$(STR$(PlanetProduction(ACT)))), Yellow, XSMALL
 
 _PUTIMAGE (565, 281)-STEP(59, 21), Layer(12), Mix&, (597, 1)-STEP(29, 10)
 _PUTIMAGE (565, 305)-STEP(59, 21), Layer(12), Mix&, (597, 12)-STEP(29, 10)
 _PUTIMAGE (565, 329)-STEP(59, 21), Layer(12), Mix&, (597, 23)-STEP(29, 10)
END SUB
 
SUB Make_Planets
 FOR I%% = 0 TO PlanetCount(G.Galaxy_Size) - 1
  Planet(I%%).Name = Planets(10 + I%%)
  DO
   SELECT CASE G.Galaxy_Size
    CASE 1 'small
     Planet(I%%).XLoc = INT(RND * 185) + 10
     Planet(I%%).YLoc = INT(RND * 150) + 10
    CASE 2
     Planet(I%%).XLoc = INT(RND * 250) + 10
     Planet(I%%).YLoc = INT(RND * 190) + 10
    CASE 3
     Planet(I%%).XLoc = INT(RND * 290) + 10
     Planet(I%%).YLoc = INT(RND * 240) + 10
    CASE 4
     Planet(I%%).XLoc = INT(RND * 365) + 10
     Planet(I%%).YLoc = INT(RND * 320) + 10
   END SELECT
 
   Good%% = TRUE
 
   FOR j%% = 0 TO I%% - 1
    IF Planet(I%%).XLoc > Planet(j%%).XLoc - 20 AND Planet(I%%).XLoc < Planet(j%%).XLoc + 20 THEN Good%% = FALSE ELSE Good%% = TRUE
    IF Planet(I%%).YLoc > Planet(j%%).YLoc - 20 AND Planet(I%%).YLoc < Planet(j%%).YLoc + 20 THEN Good%% = FALSE ELSE Good%% = TRUE
    IF INKEY$ = CHR$(27) THEN END
 
   NEXT j%%
  LOOP UNTIL Good%%
 
  IF INT(RND * 100) > 49 THEN Planet(I%%).Size = 2 ELSE Planet(I%%).Size = 1
  Planet(I%%).Colr = INT(RND * 6)
  temp~%% = INT(RND * 100)
  SELECT CASE Planet(I%%).Colr
   CASE 1 'yellow
    IF temp~%% > 10 THEN
     Planet(I%%).Environ = INT(RND * 6) + 7
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
   CASE 2 'Green
    IF temp~%% > 25 THEN
     Planet(I%%).Environ = INT(RND * 6) + 7
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
   CASE 3 'red
    IF temp~%% > 49 THEN
     Planet(I%%).Environ = INT(RND * 6) + 7
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
   CASE 4 'blue
    IF temp~%% > 74 THEN
     Planet(I%%).Environ = INT(RND * 6) + 7
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
   CASE 5 'white
    IF temp~%% > 90 THEN
     Planet(I%%).Environ = INT(RND * 6) + 6
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
   CASE 6 'purple
    IF temp~%% > 65 THEN
     Planet(I%%).Environ = INT(RND * 6) + 5
    ELSE
     Planet(I%%).Environ = INT(RND * 14)
    END IF
  END SELECT
  SELECT CASE Planet(I%%).Environ
   CASE 0 'no planets
    population~%% = 10
   CASE 1 TO 4 'max population <=50
    population~%% = (INT(RND * 8) + 2) * 5
   CASE 5 TO 7 'max population <=70
    population~%% = (INT(RND * 12) + 2) * 5
   CASE 9 TO 11 'max population <=95
    population~%% = (INT(RND * 17) + 2) * 5
   CASE 12, 13 'max population <=120
    population~%% = (INT(RND * 22) + 2) * 5
  END SELECT
  Planet(I%%).BasePop = population~%%
  Planet(I%%).ModPop = population~%%
  Planet(I%%).MaxPop = population~%%
  Planet(I%%).Race1Visit = TRUE
 
 NEXT I%%
 '------------make players system--------------
 G.Selected_Planet = INT(RND * PlanetCount(G.Galaxy_Size))
 Planet(G.Selected_Planet).Name = Planets(G.Player_Race)
 Planet(G.Selected_Planet).Owner = 1
 Planet(G.Selected_Planet).Race1Visit = TRUE
 Planet(G.Selected_Planet).CurPop = 50
 Planet(G.Selected_Planet).LastPop = 50
 Planet(G.Selected_Planet).Factory = 30
 Planet(G.Selected_Planet).Ship = 0
 Planet(G.Selected_Planet).Defn = 0
 Planet(G.Selected_Planet).Indu = 60
 Planet(G.Selected_Planet).Eco = 40
 Planet(G.Selected_Planet).Tech = 0
 '----------------------------------------------
 Planet(G.Selected_Planet).Wealth = Norm
 Planet(G.Selected_Planet).ActualProd = PlanetProduction(ACT)
 Planet(G.Selected_Planet).TotalProd = PlanetProduction(TOT)
 
END SUB
 
SUB Resource_Display
 'draws the planetary resource distrubution display
 DIM bar(5) AS _BYTE, Lok(5) AS _BYTE
 
 bar(0) = 52 * (Planet(G.Selected_Planet).Ship / 100) - 1
 bar(1) = 52 * (Planet(G.Selected_Planet).Defn / 100) - 1
 bar(2) = 52 * (Planet(G.Selected_Planet).Indu / 100) - 1
 bar(3) = 52 * (Planet(G.Selected_Planet).Eco / 100) - 1
 bar(4) = 52 * (Planet(G.Selected_Planet).Tech / 100) - 1
 IF Planet(G.Selected_Planet).Shiplock THEN Lok(1) = 26 ELSE Lok(1) = 0
 IF Planet(G.Selected_Planet).DefnLock THEN Lok(2) = 26 ELSE Lok(2) = 0
 IF Planet(G.Selected_Planet).InduLock THEN Lok(3) = 26 ELSE Lok(3) = 0
 IF Planet(G.Selected_Planet).EcoLock THEN Lok(4) = 26 ELSE Lok(4) = 0
 IF Planet(G.Selected_Planet).TechLock THEN Lok(5) = 26 ELSE Lok(5) = 0
 
 IF Lok(1) THEN _PUTIMAGE (454, 164)-STEP(33, 15), Layer(12), Mix&, (597, 36)-STEP(16, 7)
 IF Lok(2) THEN _PUTIMAGE (454, 187)-STEP(33, 15), Layer(12), Mix&, (597, 47)-STEP(16, 7)
 IF Lok(3) THEN _PUTIMAGE (454, 209)-STEP(33, 15), Layer(12), Mix&, (597, 58)-STEP(16, 7)
 IF Lok(4) THEN _PUTIMAGE (454, 231)-STEP(33, 15), Layer(12), Mix&, (597, 69)-STEP(16, 7)
 IF Lok(5) THEN _PUTIMAGE (454, 253)-STEP(33, 15), Layer(12), Mix&, (597, 80)-STEP(16, 7)
 
 IF bar(0) > 0 THEN 'shipyard alotment
  _PUTIMAGE (506, 168)-STEP(bar(0), 7), Layer(12), Mix&, (320 + Lok(1), 194)-STEP(bar(0) \ 2, 3)
 ELSE
  Oprint 596, 166, "NONE", Black, XSMALL
 END IF
 
 IF bar(1) > 0 THEN 'defence alotment
  _PUTIMAGE (506, 191)-STEP(bar(1), 7), Layer(12), Mix&, (320 + Lok(2), 194)-STEP((bar(1) \ 2), 3)
 ELSE
  Oprint 596, 189, "NONE", Black, XSMALL
 END IF
 
 IF bar(2) > 0 THEN 'industry alotment
  _PUTIMAGE (506, 213)-STEP(bar(2), 7), Layer(12), Mix&, (320 + Lok(3), 194)-STEP((bar(2) \ 2), 3)
  bar(2) = Planet(G.Selected_Planet).ActualProd * (Planet(G.Selected_Planet).Indu / 100)
  IF bar(2) / Player(Planet(G.Selected_Planet).Owner).FactoryCost < 10 THEN
   Fact$ = LEFT$(LTRIM$(RTRIM$(STR$(bar(2) / Player(Planet(G.Selected_Planet).Owner).FactoryCost))), 3) + "/Y"
  ELSE
   Fact$ = LEFT$(LTRIM$(RTRIM$(STR$(bar(2) / Player(Planet(G.Selected_Planet).Owner).FactoryCost))), 2) + "/Y"
  END IF
  Oprint 610 - LEN(Fact$) * 4, 211, Fact$, Black, XSMALL
 ELSE
  Oprint 596, 211, "NONE", Black, XSMALL
 END IF
 
 '---------------------planetary alotment--------------------
 'determine factory waste by # of factories * factorywaste%(100,80,60,40,20,0)
 IF bar(3) > 0 THEN _PUTIMAGE (506, 235)-STEP(bar(3), 7), Layer(12), Mix&, (320 + Lok(4), 194)-STEP((bar(3) \ 2), 3)
 bar(3) = Planet(G.Selected_Planet).Eco
 waste% = INT((Planet(G.Selected_Planet).Factory)) * (Player(Planet(G.Selected_Planet).Owner).Factorywaste / 100)
 test% = (PlanetProduction(ACT) * (bar(3) / 100)) * Player(Planet(G.Selected_Planet).Owner).EcoRestore
 IF test% >= waste% THEN
  Oprint 584, 233, "CLEAN", Black, XSMALL
 ELSE
  Oprint 584, 233, "WASTE", Black, XSMALL
 END IF
 
 IF bar(4) > 0 THEN 'technology alotment
  _PUTIMAGE (506, 257)-STEP(bar(4), 7), Layer(12), Mix&, (320 + Lok(5), 194)-STEP((bar(4) \ 2), 3)
  bar(4) = Planet(G.Selected_Planet).ActualProd * (Planet(G.Selected_Planet).Tech / 100)
  IF Planet(G.Selected_Planet).Wealth = 3 THEN Oprint 602 - LEN(LTRIM$(RTRIM$(STR$(bar(4))))) * 4, 255, LTRIM$(RTRIM$(STR$(bar(4)))), Black, XSMALL
  IF Planet(G.Selected_Planet).Wealth = 4 THEN Oprint 602 - LEN(LTRIM$(RTRIM$(STR$(bar(4) * 2)))) * 4, 255, LTRIM$(RTRIM$(STR$(bar(4) * 2))), Black, XSMALL
  IF Planet(G.Selected_Planet).Wealth = 7 THEN Oprint 602 - LEN(LTRIM$(RTRIM$(STR$(bar(4) * 4)))) * 4, 255, LTRIM$(RTRIM$(STR$(bar(4) * 4))), Black, XSMALL
 ELSE
  Oprint 602, 255, "0", Black, XSMALL
 END IF
END SUB
 
FUNCTION MainMenu
 OPEN "DatatempA.dat" FOR BINARY AS #2
 GET #2, , Elements%
 DIM Offs(Elements%) AS LONG, Sizs(Elements%) AS LONG
 GET #2, , Offs()
 GET #2, , Sizs()
 
 Result%% = FALSE
 BuildClickLayer Layer(30), 1
 _MOUSEHIDE
 TIMER(T(1)) ON
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   opt%% = Check_Pos(X%, Y%)
   Result%% = opt%%
   IF opt%% THEN exitflag%% = TRUE
  END IF
 
  GetFrame Sizs(G.Frame), Offs(G.Frame), 2
 
  _PUTIMAGE , Temp&, Mix&
  ShowMenuOptions Check_Pos(X%, Y%)
  _PUTIMAGE (43, 22), Layer(3), Mix&
  _PUTIMAGE (X%, Y%), Layer(5), Mix&, (0, 0)-STEP(28, 24)
  _PUTIMAGE , Mix&, _DISPLAY
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE: Result%% = 4
 
 LOOP UNTIL exitflag%%
 TIMER(T(1)) OFF
 _MOUSESHOW
 MainMenu = Result%%
 CLOSE #2
END SUB
 
SUB MenuAnimation ()
 G.Frame = G.Frame + 1
 IF G.Frame >= 48 THEN G.Frame = 0
END SUB
 
SUB WaveAnimation ()
 G.Frame = G.Frame + 1
 IF G.Frame >= 10 THEN G.Frame = 0
END SUB
 
SUB BuildClickLayer (LID&, M_ID%%)
 _DEST LID&
 CLS
 SELECT CASE M_ID%%
  CASE 1
   LINE (230, 274)-STEP(190, 32), _RGB32(1, 1, 1), BF
   LINE (230, 306)-STEP(190, 32), _RGB32(2, 1, 1), BF
   LINE (230, 338)-STEP(190, 32), _RGB32(3, 1, 1), BF
   LINE (230, 370)-STEP(190, 32), _RGB32(4, 1, 1), BF
  CASE 2
   LINE (354, 62)-STEP(110, 26), _RGB32(1, 1, 1), BF
   LINE (354, 140)-STEP(110, 26), _RGB32(2, 1, 1), BF
   LINE (354, 218)-STEP(110, 26), _RGB32(3, 1, 1), BF
   LINE (185, 298)-STEP(126, 36), _RGB32(4, 1, 1), BF
   LINE (326, 298)-STEP(126, 36), _RGB32(5, 1, 1), BF
  CASE 3
   FOR i%% = 1 TO 10
    LINE (20, 42 + (i%% * 24))-STEP(110, 21), _RGB32(i%%, 1, 1), BF
   NEXT i%%
  CASE 4
   FOR i%% = 1 TO 6
    LINE (20, 42 + (i%% * 24))-STEP(110, 21), _RGB32(i%%, 1, 1), BF
   NEXT i%%
  CASE 5 'main screen
   'resource distribution area
   '----bars---
   LINE (504, 168)-STEP(51, 8), _RGB32(1, 1, 1), BF 'ship production
   LINE (504, 190)-STEP(51, 8), _RGB32(2, 1, 1), BF 'defence production
   LINE (504, 212)-STEP(51, 8), _RGB32(3, 1, 1), BF 'industry production
   LINE (504, 234)-STEP(51, 8), _RGB32(4, 1, 1), BF 'ecological production
   LINE (504, 256)-STEP(51, 8), _RGB32(5, 1, 1), BF 'technological production
   '---arrows---
   '-------reduce-------
   LINE (494, 164)-STEP(10, 10), _RGB32(6, 1, 1), BF
   LINE (494, 186)-STEP(10, 10), _RGB32(7, 1, 1), BF
   LINE (494, 208)-STEP(10, 10), _RGB32(8, 1, 1), BF
   LINE (494, 230)-STEP(10, 10), _RGB32(9, 1, 1), BF
   LINE (494, 252)-STEP(10, 10), _RGB32(10, 1, 1), BF
   '------increase------
   LINE (560, 164)-STEP(10, 10), _RGB32(11, 1, 1), BF
   LINE (560, 186)-STEP(10, 10), _RGB32(12, 1, 1), BF
   LINE (560, 208)-STEP(10, 10), _RGB32(13, 1, 1), BF
   LINE (560, 230)-STEP(10, 10), _RGB32(14, 1, 1), BF
   LINE (560, 252)-STEP(10, 10), _RGB32(15, 1, 1), BF
   '-----Lock resource-----
   LINE (454, 164)-STEP(33, 14), _RGB32(16, 1, 1), BF
   LINE (454, 186)-STEP(33, 14), _RGB32(17, 1, 1), BF
   LINE (454, 208)-STEP(33, 14), _RGB32(18, 1, 1), BF
   LINE (454, 230)-STEP(33, 14), _RGB32(19, 1, 1), BF
   LINE (454, 252)-STEP(33, 14), _RGB32(20, 1, 1), BF
   '---ShipYard Area---
   LINE (456, 280)-STEP(94, 70), _RGB32(21, 1, 1), BF 'change ship in production(area)
   LINE (564, 280)-STEP(56, 20), _RGB32(21, 1, 1), BF 'change ship in production(button)
   LINE (564, 304)-STEP(56, 20), _RGB32(22, 1, 1), BF 'relocate ship button
   LINE (564, 328)-STEP(56, 20), _RGB32(23, 1, 1), BF 'transport colonist button
   '----Bottom Area----
   LINE (10, 362)-STEP(62, 26), _RGB32(24, 1, 1), BF 'game menu
   LINE (80, 362)-STEP(70, 26), _RGB32(25, 1, 1), BF 'ship design
   LINE (158, 362)-STEP(64, 26), _RGB32(26, 1, 1), BF 'fleet information
   LINE (230, 362)-STEP(48, 26), _RGB32(27, 1, 1), BF 'galactic map
   LINE (286, 362)-STEP(66, 26), _RGB32(28, 1, 1), BF 'Race relations
   LINE (360, 362)-STEP(82, 26), _RGB32(29, 1, 1), BF 'colonized planet information
   LINE (450, 362)-STEP(58, 26), _RGB32(30, 1, 1), BF 'technology reserch
   LINE (516, 362)-STEP(112, 26), _RGB32(31, 1, 1), BF 'next turn
  CASE 6 'game option screen
   LINE (232, 114)-STEP(143, 27), _RGB32(1, 1, 1), BF 'save game
   LINE (232, 164)-STEP(143, 27), _RGB32(2, 1, 1), BF 'load game
   LINE (232, 214)-STEP(143, 27), _RGB32(3, 1, 1), BF 'quit game
   LINE (422, 114)-STEP(143, 27), _RGB32(4, 1, 1), BF 'no sound
   LINE (422, 164)-STEP(143, 27), _RGB32(5, 1, 1), BF 'SFX only
   LINE (422, 214)-STEP(143, 27), _RGB32(6, 1, 1), BF 'Full sound& music
   LINE (346, 270)-STEP(104, 30), _RGB32(7, 1, 1), BF 'OK
  CASE 7 'Load\Save Game screen
   LINE (290, 66)-STEP(224, 16), _RGB32(1, 1, 1), BF 'game  1
   LINE (290, 102)-STEP(224, 16), _RGB32(2, 1, 1), BF ' game 2
   LINE (290, 138)-STEP(224, 16), _RGB32(3, 1, 1), BF ' game 3
   LINE (290, 174)-STEP(224, 16), _RGB32(4, 1, 1), BF ' game 4
   LINE (290, 210)-STEP(224, 16), _RGB32(5, 1, 1), BF ' game 5
   LINE (290, 246)-STEP(224, 16), _RGB32(6, 1, 1), BF ' game 6
   LINE (276, 290)-STEP(104, 32), _RGB32(7, 1, 1), BF 'Cancel
   LINE (404, 290)-STEP(104, 32), _RGB32(8, 1, 1), BF 'OK
  CASE 8 'Ship Design screen
   LINE (562, 298)-STEP(64, 26), _RGB32(1, 1, 1), BF 'Cancel
   LINE (562, 330)-STEP(64, 26), _RGB32(2, 1, 1), BF 'Clear
   LINE (562, 362)-STEP(64, 26), _RGB32(3, 1, 1), BF 'Build
  CASE 9 'Fleet specs screen
   LINE (364, 362)-STEP(64, 26), _RGB32(1, 1, 1), BF 'Specs
   LINE (450, 362)-STEP(64, 26), _RGB32(2, 1, 1), BF 'Scrap
   LINE (538, 362)-STEP(64, 26), _RGB32(3, 1, 1), BF 'OK
  CASE 10 'Map screen
   LINE (490, 52)-STEP(121, 22), _RGB32(1, 1, 1), BF 'Colonies
   LINE (490, 92)-STEP(121, 22), _RGB32(2, 1, 1), BF ' Enviroments
   LINE (490, 132)-STEP(121, 22), _RGB32(3, 1, 1), BF ' minerals
   LINE (490, 360)-STEP(121, 22), _RGB32(4, 1, 1), BF ' OK
 
 END SELECT
 _DEST _DISPLAY
END SUB
 
SUB ShowMenuOptions (opt%%)
 IF MFlags AND 1 THEN _PUTIMAGE (239, 274)-STEP(162, 32), Layer(4), Mix&, (0, 0)-STEP(81, 15) ELSE _PUTIMAGE (239, 274)-STEP(162, 32), Layer(4), Mix&, (82, 0)-STEP(81, 15)
 IF MFlags AND 2 THEN _PUTIMAGE (239, 306)-STEP(162, 32), Layer(4), Mix&, (0, 16)-STEP(81, 15) ELSE _PUTIMAGE (239, 306)-STEP(162, 32), Layer(4), Mix&, (82, 16)-STEP(81, 15)
 IF MFlags AND 4 THEN _PUTIMAGE (239, 338)-STEP(162, 32), Layer(4), Mix&, (0, 32)-STEP(81, 15) ELSE _PUTIMAGE (239, 338)-STEP(162, 32), Layer(4), Mix&, (82, 32)-STEP(81, 15)
 IF MFlags AND 8 THEN _PUTIMAGE (239, 370)-STEP(162, 32), Layer(4), Mix&, (0, 48)-STEP(81, 15) ELSE _PUTIMAGE (239, 370)-STEP(162, 32), Layer(4), Mix&, (82, 48)-STEP(81, 15)
 
 IF opt%% THEN
  SELECT CASE opt%%
   CASE 1
    IF MFlags AND 1 THEN _PUTIMAGE (239, 274)-STEP(162, 32), Layer(4), Mix&, (164, 0)-STEP(81, 15)
   CASE 2
    IF MFlags AND 2 THEN _PUTIMAGE (239, 306)-STEP(162, 32), Layer(4), Mix&, (164, 16)-STEP(81, 15)
   CASE 3
    IF MFlags AND 4 THEN _PUTIMAGE (239, 338)-STEP(162, 32), Layer(4), Mix&, (164, 32)-STEP(81, 15)
   CASE 4
    IF MFlags AND 8 THEN _PUTIMAGE (239, 370)-STEP(162, 32), Layer(4), Mix&, (164, 48)-STEP(81, 15)
  END SELECT
 END IF
END SUB
 
SUB Check_Saves
 IF _FILEEXISTS("SAVE7.GAM") THEN MFlags = MFlags + 1 'does auto save game exist?
 FOR i%% = 1 TO 6 'check for manual save games
  FE$ = "SAVE" + LTRIM$(STR$(i%%)) + ".GAM"
  IF _FILEEXISTS(FE$) THEN MFlags = MFlags + 2: i%% = 7 ' if any save game exists then exit loop
 NEXT i%%
END SUB
 
SUB load_game_names
 OPEN "StarLord.cfg" FOR BINARY AS #1
 GET #1, , Saves()
 CLOSE #1
END SUB
 
FUNCTION Check_Pos (x%, y%)
 Result%% = 0
 TP~& = POINT(x%, y%)
 Result%% = _RED(TP~&)
 Check_Pos = Result%%
END FUNCTION
 
SUB Oprint (X%, Y%, TXT$, C%%, TYP%%)
 InitFont C%%
 SELECT CASE TYP%%
  CASE XSMALL
   FOR I%% = 1 TO LEN(TXT$)
    T%% = ASC(MID$(UCASE$(TXT$), I%%, 1))
    IF T%% = 32 THEN
     xs% = xs% + 6
    ELSE
     Lxo% = 4 * (T%% - 40)
     IF T%% = 49 OR T%% = 73 THEN xs% = xs% - 2
     _PUTIMAGE (X% + xs%, Y%)-STEP(7, 11), Layer(29), Mix&, (Lxo%, 0)-STEP(3, 5)
     IF T%% = 49 OR T%% = 73 THEN xs% = xs% + 6 ELSE xs% = xs% + 8
    END IF
   NEXT I%%
  CASE SMALL
   FOR I%% = 1 TO LEN(TXT$)
    T%% = ASC(MID$(TXT$, I%%, 1))
    SELECT CASE T%%
     CASE 32
      xs% = xs% + 8
     CASE 44
      Ys% = Ys% + 14
      xs% = 0
     CASE 45 TO 90
      T%% = T%% - 45
      IF T%% = 4 OR T%% = 28 THEN xs% = xs% - 2
      _PUTIMAGE (X% + xs% - XC%%, Y% + Ys%)-STEP(9, 9), Layer(29), Mix&, (0 + 5 * T%%, 6)-STEP(4, 4)
      xs% = xs% + 10
      IF T%% = 32 OR T%% = 42 OR T%% = 43 OR T%% = 41 OR T%% = 39 THEN xs% = xs% + 2
      LastLetter%% = TRUE 'if the last letter was upper case
     CASE 97 TO 122
      T%% = T%% - 97
      IF T%% = 8 OR T%% = 11 THEN xs% = xs% - 2 'remove excess space infront of `i` and  `l`
      IF T%% = 12 OR T%% = 22 THEN xs% = xs% + 2 'add space before `m` and `w`
      IF LastLetter%% THEN xs% = xs% - 2 'remove extra space after upper case letter
      _PUTIMAGE (X% + xs% - XC%%, Y% + Ys%)-STEP(9, 11), Layer(29), Mix&, (235 + 5 * T%%, 6)-STEP(4, 5)
      xs% = xs% + 8
      IF T%% = 8 OR T%% = 11 THEN xs% = xs% - 2 'remove excess space after of `i` and  `l`
      IF T%% = 12 OR T%% = 22 THEN xs% = xs% + 2 'add space after `m` and `w`
      LastLetter%% = FALSE 'if the last letter was not upper case
 
     CASE 97 TO 122
 
    END SELECT
   NEXT I%%
  CASE NORMAL
   FOR I%% = 1 TO LEN(TXT$)
    T%% = ASC(MID$(TXT$, I%%, 1))
    SELECT CASE T%%
     CASE 32
      xs% = xs% + 10
     CASE 45
      Lxo% = 7 * 62 + F(0, 62).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 62).Xsiz * 2, 18), Layer(29), Mix&, (Lxo%, 12)-STEP(F(0, 62).Xsiz, 9)
      xs% = xs% + (F(0, 62).Xsiz * 2)
     CASE 46
      Lxo% = 7 * 63 + F(0, 63).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 63).Xsiz * 2, 18), Layer(29), Mix&, (Lxo%, 12)-STEP(F(0, 63).Xsiz, 9)
      xs% = xs% + (F(0, 63).Xsiz * 2)
 
     CASE 48 TO 57
      Lxo% = 7 * (T%% - 48) + F(0, T%% - 48).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, T%% - 48).Xsiz * 2 + 1, 13), Layer(29), Mix&, (Lxo%, 12)-STEP(F(0, T%% - 48).Xsiz, 6)
      xs% = xs% + (F(0, T%% - 48).Xsiz * 2)
 
     CASE 65 TO 90
      Lxo% = 7 * (T%% - 65) + F(0, 10 + T%% - 65).Xloc + 70
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 10 + T%% - 65).Xsiz * 2 + 1, 13), Layer(29), Mix&, (Lxo%, 12)-STEP(F(0, 10 + T%% - 65).Xsiz, 6)
      xs% = xs% + (F(0, 10 + T%% - 65).Xsiz * 2)
 
     CASE 97 TO 122
      Lxo% = 7 * (T%% - 97) + F(0, 36 + T%% - 97).Xloc + 252
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 36 + T%% - 97).Xsiz * 2 + 1, 17), Layer(29), Mix&, (Lxo%, 12)-STEP(F(0, 36 + T%% - 97).Xsiz, 8)
      xs% = xs% + (F(0, 36 + T%% - 97).Xsiz * 2)
    END SELECT
   NEXT I%%
  CASE PLANETOID
   FOR I%% = 1 TO LEN(TXT$)
    T%% = ASC(MID$(TXT$, I%%, 1))
    SELECT CASE T%%
     CASE 32
      xs% = xs% + 10
     CASE 45
      Lxo% = F(1, 62).Xoff
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(1, 62).Xsiz * 2, 21), Layer(29), Mix&, (Lxo%, 33)-STEP(F(1, 62).Xsiz - 1, 10)
      xs% = xs% + (F(1, 62).Xsiz * 2 - 2)
     CASE 46
      Lxo% = F(1, 63).Xoff
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(1, 63).Xsiz * 2 - 1, 21), Layer(29), Mix&, (Lxo%, 33)-STEP(F(1, 63).Xsiz - 1, 10)
      xs% = xs% + (F(1, 63).Xsiz * 2 - 2)
 
     CASE 48 TO 57
      Lxo% = F(1, T%% - 48).Xoff
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(1, T%% - 48).Xsiz * 2 - 1, 21), Layer(29), Mix&, (Lxo%, 33)-STEP(F(1, T%% - 48).Xsiz - 1, 10)
      xs% = xs% + (F(1, T%% - 48).Xsiz * 2 - 2)
 
     CASE 65 TO 90
      Lxo% = F(1, 10 + T%% - 65).Xoff
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(1, 10 + T%% - 65).Xsiz * 2 - 1, 21), Layer(29), Mix&, (Lxo%, 33)-STEP(F(1, 10 + T%% - 65).Xsiz - 1, 10)
      xs% = xs% + (F(1, 10 + T%% - 65).Xsiz * 2 - 2)
 
     CASE 97 TO 122
      Lxo% = F(1, 36 + T%% - 97).Xoff
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(1, 36 + T%% - 97).Xsiz * 2 - 1, 21), Layer(29), Mix&, (Lxo%, 33)-STEP(F(1, 36 + T%% - 97).Xsiz - 1, 10)
      xs% = xs% + (F(1, 36 + T%% - 97).Xsiz * 2 - 2)
    END SELECT
   NEXT I%%
  CASE OUTLINE
   C%% = C%% + 1
   FOR I%% = 1 TO LEN(TXT$)
    T%% = ASC(MID$(TXT$, I%%, 1))
    SELECT CASE T%%
     CASE 32
      xs% = xs% + 10
     CASE 45
      Lxo% = 7 * 62 + F(0, 62).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 62).Xsiz * 2, 21), Layer(29), Mix&, (Lxo%, 21)-STEP(F(0, 62).Xsiz, 11)
      xs% = xs% + (F(0, 62).Xsiz * 2)
     CASE 46
      Lxo% = 7 * 63 + F(0, 63).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 63).Xsiz * 2, 21), Layer(29), Mix&, (Lxo%, 21)-STEP(F(0, 63).Xsiz, 11)
      xs% = xs% + (F(0, 63).Xsiz * 2)
 
     CASE 48 TO 57
      Lxo% = 7 * (T%% - 48) + F(0, T%% - 48).Xloc
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, T%% - 48).Xsiz * 2 + 1, 17), Layer(29), Mix&, (Lxo%, 21)-STEP(F(0, T%% - 48).Xsiz, 8)
      xs% = xs% + (F(0, T%% - 48).Xsiz * 2)
 
     CASE 65 TO 90
      Lxo% = 7 * (T%% - 65) + F(0, 10 + T%% - 65).Xloc + 70
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 10 + T%% - 65).Xsiz * 2 + 1, 17), Layer(29), Mix&, (Lxo%, 21)-STEP(F(0, 10 + T%% - 65).Xsiz, 8)
      xs% = xs% + (F(0, 10 + T%% - 65).Xsiz * 2)
 
     CASE 97 TO 122
      Lxo% = 7 * (T%% - 97) + F(0, 36 + T%% - 97).Xloc + 252
      _PUTIMAGE (X% + xs%, Y%)-STEP(F(0, 36 + T%% - 97).Xsiz * 2 + 1, 21), Layer(29), Mix&, (Lxo%, 21)-STEP(F(0, 36 + T%% - 97).Xsiz, 10)
      xs% = xs% + (F(0, 36 + T%% - 97).Xsiz * 2)
    END SELECT
   NEXT I%%
 END SELECT
 ' _CLEARCOLOR _RGB32(0, 0, 0), Layer(9)
 ' _PUTIMAGE , Layer(9), Mix&
END SUB
 
REM'$include:'DeInflator.bi'
FUNCTION Deflate$ (text$)
 $CHECKING:OFF
 DIM FileSize AS LONG, CompSize AS LONG
 DIM m AS _MEM
 FileSize = LEN(text$): CompSize = compressBound(FileSize)
 m = _MEMNEW(FileSize)
 _MEMPUT m, m.OFFSET, text$ 'set the variable length text into a memblock so it won't move in memory as we access it.
 REDIM CompBuff(1 TO CompSize) AS _UNSIGNED _BYTE
 Result = compress2(_OFFSET(CompBuff(1)), CompSize, m.OFFSET, FileSize, 9)
 REDIM _PRESERVE CompBuff(1 TO CompSize) AS _UNSIGNED _BYTE
 _MEMFREE m
 m = _MEM(CompBuff())
 Deflate$ = SPACE$(CompSize)
 _MEMGET m, m.OFFSET, Deflate$
 _MEMFREE m
 Deflate$ = MKL$(FileSize) + Deflate$
 $CHECKING:ON
END FUNCTION
 
FUNCTION Inflate$ (text$)
 $CHECKING:OFF
 DIM m AS _MEM, m1 AS _MEM
 FileSize& = CVL(LEFT$(text$, 4))
 text1$ = MID$(text$, 5): temp$ = SPACE$(FileSize&)
 m = _MEMNEW(FileSize&): m1 = _MEMNEW(LEN(text1$))
 _MEMPUT m1, m1.OFFSET, text1$
 Result = uncompress(m.OFFSET, FileSize&, m1.OFFSET, LEN(text1$))
 _MEMGET m, m.OFFSET, temp$
 _MEMFREE m
 _MEMFREE m1
 Inflate$ = temp$
 $CHECKING:ON
END FUNCTION
 
 
REM '$include:'Play_Intro.bi'
SUB Play_Intro
 OPEN "DatatempI.dat" FOR BINARY AS #1
 GET #1, , Elements%
 DIM Offs(Elements%) AS LONG, Sizs(Elements%) AS LONG, FadeIns%(8), FadeOuts%(8)
 DATA 0,115,145,215,284,324
 DATA 114,144,214,283,323,533
 FOR i%% = 0 TO 5
  READ FadeIns%(i%%)
 NEXT i%%
 FOR i%% = 0 TO 5
  READ FadeOuts%(i%%)
 NEXT i%%
 
 GET #1, , Offs()
 GET #1, , Sizs()
 
 NF%% = 0: NFO%% = 0
 FOR i% = 0 TO 533
 
  IF i% = FadeIns%(NF%%) THEN
   '-----------Fade image in--------------
   GetFrame Sizs(i%), Offs(i%), 1
   _DEST Mix&
   FOR fade% = 63 TO 0 STEP -4
    _PUTIMAGE , Temp&, Mix&
    LINE (0, 0)-(639, 399), _RGBA32(0, 0, 0, fade% * 4), BF
    _PUTIMAGE , Mix&, _DISPLAY
    _DELAY .075
   NEXT fade%
   _DEST _DISPLAY
   NF%% = NF%% + 1
 
  ELSEIF i% = FadeOuts%(NFO%%) THEN
   '-----------Fade image out----------------
   GetFrame Sizs(i%), Offs(i%), 1
   _DEST Mix&
   FOR fade% = 0 TO 63 STEP 4
    _PUTIMAGE , Temp&, Mix&
    LINE (0, 0)-(639, 399), _RGBA32(0, 0, 0, fade% * 4), BF
    _PUTIMAGE , Mix&, _DISPLAY
    _DELAY .075
   NEXT fade%
   _DEST _DISPLAY
   NFO%% = NFO%% + 1
 
  ELSE
   GetFrame Sizs(i%), Offs(i%), 1
   _PUTIMAGE , Temp&, _DISPLAY
  END IF
 
  _DELAY .125
  IF INKEY$ = CHR$(27) THEN exitflag% = -1: i% = 999
 NEXT i%
 CLOSE #1
END SUB
 
REM'$include:'New_Game.bi'
FUNCTION NewGame
 Result%% = 4
 BuildClickLayer Layer(30), 2
 _MOUSEHIDE
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   opt%% = Check_Pos(X%, Y%)
   Result%% = opt%%
   SELECT CASE opt%%
    CASE 1 'Galaxy Size
     G.Galaxy_Size = G.Galaxy_Size + 1
     IF G.Galaxy_Size = 4 THEN G.Galaxy_Size = 0
    CASE 2 'difficulty
     G.Difficulty = G.Difficulty + 1
     IF G.Difficulty = 5 THEN G.Difficulty = 0
    CASE 3 'races
     G.Races = G.Races + 1
     IF G.Races = 5 THEN G.Races = 0
    CASE 4 'cancel
     exitflag%% = TRUE
    CASE 5 'Ok
     exitflag%% = TRUE
   END SELECT
   DO: nul% = _MOUSEINPUT: _DELAY .001: LOOP WHILE _MOUSEBUTTON(1)
  END IF
  _PUTIMAGE , Layer(6), Mix&
  _PUTIMAGE (354, 62)-STEP(111, 26), Layer(7), Mix&, (0, 0 + 13 * G.Galaxy_Size)-STEP(55, 12) 'size
  _PUTIMAGE (354, 140)-STEP(111, 26), Layer(7), Mix&, (55, 0 + 13 * G.Difficulty)-STEP(55, 12) 'difficulty
  _PUTIMAGE (354, 218)-STEP(111, 26), Layer(7), Mix&, (110, 0 + 13 * G.Races)-STEP(55, 12) 'races
  _PUTIMAGE (X%, Y%), Layer(5), Mix&, (0, 0)-STEP(28, 24)
 
  _PUTIMAGE , Mix&, _DISPLAY
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE
 
 LOOP UNTIL exitflag%%
 _MOUSESHOW
 NewGame = Result%%
END FUNCTION
 
FUNCTION Choose_Race
 Result%% = -1
 selection%% = 1
 BuildClickLayer Layer(30), 3
 _MOUSEHIDE
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   opt%% = Check_Pos(X%, Y%)
   Result%% = opt%%
   exitflag%% = TRUE
   DO: nul% = _MOUSEINPUT: _DELAY .001: LOOP WHILE _MOUSEBUTTON(1)
  ELSE
   opt%% = Check_Pos(X%, Y%)
   IF opt%% THEN selection%% = opt%%
  END IF
 
  _PUTIMAGE , Layer(8), Mix&
  Oprint 20, 20, "Choose Race", White, NORMAL
  'selection hi-lite
  _DEST Mix&
  LINE (20, 42 + ((selection%% - 1) * 24))-STEP(110, 21), _RGBA32(255, 255, 255, 56), BF
  _DEST _DISPLAY
  'display race face
  _PUTIMAGE (182, 22)-STEP(79, 69), Layer(10), Mix&, (0 + (selection%% - 1) * 40, 0)-STEP(40, 34)
  'display race description
  Oprint 162, 100, Rdescript(selection%%), 0, SMALL
 
  FOR i%% = 1 TO 10
   Oprint 36, 20 + 24 * i%%, Races(i%%), Black, NORMAL
  NEXT i%%
  _PUTIMAGE (X%, Y% - 24), Layer(5), Mix&, (0, 0)-STEP(28, 24)
  _PUTIMAGE , Mix&, _DISPLAY
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
 LOOP UNTIL exitflag%%
 _MOUSESHOW
 G.Player_Race = Result%%
 Choose_Race = Result%%
END FUNCTION
 
FUNCTION Choose_Banner
 TIMER(T(2)) ON
 Result%% = -1
 selection%% = 1
 Frame%% = 0
 BuildClickLayer Layer(30), 4
 _MOUSEHIDE
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   opt%% = Check_Pos(X%, Y%)
   Result%% = opt%%
   exitflag%% = TRUE
   DO: nul% = _MOUSEINPUT: _DELAY .001: LOOP WHILE _MOUSEBUTTON(1)
  ELSE
   opt%% = Check_Pos(X%, Y%)
   IF opt%% THEN selection%% = opt%%
  END IF
 
  _PUTIMAGE , Layer(8), Mix&
  Oprint 20, 20, "Choose Banner", White, NORMAL
  'selection hi-lite
  _DEST Mix&
  LINE (20, 42 + ((selection%% - 1) * 24))-STEP(110, 21), _RGBA32(255, 255, 255, 56), BF
  _DEST _DISPLAY
  'display race face
  _PUTIMAGE (182, 22)-STEP(79, 69), Layer(10), Mix&, (0 + (G.Player_Race - 1) * 40, 0)-STEP(40, 34)
  'display flag
  _PUTIMAGE (180, 106)-STEP(84, 76), Layer(4), Mix&, (0, 72)-STEP(41, 37)
  _PUTIMAGE (182, 108)-STEP(80, 72), Layer(11), Mix&, (0 + 40 * G.Frame, 0 + 36 * (selection%% - 1))-STEP(39, 35)
 
 
  FOR i%% = 1 TO 6
   Oprint 36, 20 + 24 * i%%, Colrs(i%%), Black, NORMAL
  NEXT i%%
 
 
  _PUTIMAGE , Layer(2), Mix&
  _PUTIMAGE (X%, Y% - 24), Layer(5), Mix&, (0, 0)-STEP(28, 24)
  _PUTIMAGE , Mix&, _DISPLAY
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
 LOOP UNTIL exitflag%%
 _MOUSESHOW
 G.Player_Colr = Result%%
 Choose_Flag = Result%%
END FUNCTION
 
SUB Choose_Leader_Name
 temp$ = Leaders(G.Player_Race, INT(RND * 6) + 1)
 _MOUSEHIDE
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   Result%% = opt%%
   exitflag%% = TRUE
   DO: nul% = _MOUSEINPUT: _DELAY .001: LOOP WHILE _MOUSEBUTTON(1)
  END IF
 
  KBD& = _KEYHIT
  SELECT CASE KBD&
   CASE 8 'backspace
    IF LEN(temp$) > 0 THEN temp$ = LEFT$(temp$, LEN(temp$) - 1)
   CASE 32, 45, 48 TO 57, 65 TO 90, 97 TO 122
    '    IF LEN(temp$) < 13 THEN temp$ = temp$ + CHR$(KBD&)
    IF NameLength(temp$) < 130 THEN temp$ = temp$ + CHR$(KBD&)
   CASE 13
    G.Player_Name = temp$
    exitflag%% = TRUE
  END SELECT
 
  _PUTIMAGE , Layer(8), Mix&
  Oprint 20, 20, "Your Name...", White, NORMAL
 
  _DEST Mix&
  LINE (20, 42)-STEP(150, 21), _RGBA32(255, 255, 255, 56), BF
  _DEST _DISPLAY
 
  'display race face
  _PUTIMAGE (182, 22)-STEP(79, 69), Layer(10), Mix&, (0 + (G.Player_Race - 1) * 40, 0)-STEP(40, 34)
  'display flag
  _PUTIMAGE (180, 106)-STEP(84, 76), Layer(4), Mix&, (0, 72)-STEP(41, 37)
  _PUTIMAGE (182, 108)-STEP(80, 72), Layer(11), Mix&, (0 + 40 * G.Frame, 0 + 36 * (G.Player_Colr - 1))-STEP(39, 35)
  'coursor
  _PUTIMAGE (22 + NameLength(temp$), 45)-STEP(8, 14), Layer(4), Mix&, (42, 87 + G.Frame * 2)-STEP(4, 7)
  'print name
  Oprint 22, 45, temp$, Black, NORMAL
 
  _PUTIMAGE (X%, Y% - 24), Layer(5), Mix&, (0, 0)-STEP(28, 24)
  _PUTIMAGE , Mix&, _DISPLAY
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
 LOOP UNTIL exitflag%%
 _MOUSESHOW
END SUB
 
SUB Choose_System_Name
 temp$ = Planets(G.Player_Race)
 _MOUSEHIDE
 DO
  nul% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  IF _MOUSEBUTTON(1) THEN
   Result%% = opt%%
   exitflag%% = TRUE
   DO: nul% = _MOUSEINPUT: _DELAY .001: LOOP WHILE _MOUSEBUTTON(1)
  END IF
 
  KBD& = _KEYHIT
  SELECT CASE KBD&
   CASE 8 'backspace
    IF LEN(temp$) > 0 THEN temp$ = LEFT$(temp$, LEN(temp$) - 1)
   CASE 32, 45, 48 TO 57, 65 TO 90, 97 TO 122
    IF LEN(temp$) < 13 THEN temp$ = temp$ + CHR$(KBD&)
   CASE 13
    G.Player_Name = temp$
    exitflag%% = TRUE
  END SELECT
 
  _PUTIMAGE , Layer(8), Mix&
  Oprint 20, 20, "Home World...", White, NORMAL
 
  _DEST Mix&
  LINE (20, 42)-STEP(150, 21), _RGBA32(255, 255, 255, 56), BF
  _DEST _DISPLAY
 
  'display race face
  _PUTIMAGE (182, 22)-STEP(79, 69), Layer(10), Mix&, (0 + (G.Player_Race - 1) * 40, 0)-STEP(40, 34)
  'display flag
  _PUTIMAGE (180, 106)-STEP(84, 76), Layer(4), Mix&, (0, 72)-STEP(41, 37)
  _PUTIMAGE (182, 108)-STEP(80, 72), Layer(11), Mix&, (0 + 40 * G.Frame, 0 + 36 * (G.Player_Colr - 1))-STEP(39, 35)
  'coursor
  _PUTIMAGE (22 + (LEN(temp$)) * 10, 45)-STEP(8, 14), Layer(4), Mix&, (42, 87 + G.Frame * 2)-STEP(4, 7)
  'print name
  Oprint 22, 45, temp$, Black, NORMAL
 
  _PUTIMAGE (X%, Y% - 24), Layer(5), Mix&, (0, 0)-STEP(28, 24)
  _PUTIMAGE , Mix&, _DISPLAY
  IF INKEY$ = CHR$(27) THEN exitflag%% = TRUE
  _DELAY .025
  DO: LOOP WHILE _MOUSEINPUT
 LOOP UNTIL exitflag%%
 _MOUSESHOW
END SUB
 
 
 
SUB GetFrame (SID&, OID&, F%%)
 temp$ = SPACE$(SID&)
 GET #F%%, OID&, temp$
 Frame$ = Inflate(temp$)
 _MEMPUT m, m.OFFSET, Frame$
END SUB
 
SUB ClearLayer (L&)
 _DEST L&
 CLS
 _DEST _DISPLAY
END SUB
 
FUNCTION NameLength~%% (N$)
 FOR i%% = 1 TO LEN(N$)
  T%% = ASC(MID$(N$, i%%, 1))
  SELECT CASE T%%
   CASE 32
    Result~%% = Result~%% + 10
   CASE 45
    Result~%% = Result~%% + (F(0, 62).Xsiz * 2)
   CASE 46
    Result~%% = Result~%% + (F(0, 63).Xsiz * 2)
   CASE 48 TO 57
    Result~%% = Result~%% + F(0, T%% - 48).Xsiz * 2
   CASE 65 TO 90
    Result~%% = Result~%% + F(0, 10 + T%% - 65).Xsiz * 2
   CASE 97 TO 122
    Result~%% = Result~%% + F(0, 36 + T%% - 97).Xsiz * 2
  END SELECT
 NEXT i%%
 NameLength~%% = Result~%%
END FUNCTION
 
FUNCTION PlanetProduction (T%%)
 'ship maintance is 2% of ship production cost(ie: 600bc to build, maintance is 12bc)
 SELECT CASE T%%
  CASE ACT
   Result% = Planet(G.Selected_Planet).CurPop * .51 + Player(Planet(G.Selected_Planet).Owner).Planetology * 2
   Result% = Result% + Planet(G.Selected_Planet).Factory
   Result% = Result% * (1 + trade)
   Result% = Result% * (1 - ships - spys - bases)
  CASE TOT
   Result% = Planet(G.Selected_Planet).CurPop * .51 + Player(Planet(G.Selected_Planet).Owner).Planetology * 2
   Result% = Result% + Planet(G.Selected_Planet).Factory
 END SELECT
 PlanetProduction = Result%
END FUNCTION
 
SUB Button_Down_Lock
 ButtonDown%% = TRUE
 '--------lock mouse until button release---------
 DO
  IF _MOUSEINPUT THEN
   IF NOT _MOUSEBUTTON(1) THEN ButtonDown%% = FALSE
  END IF
  _DELAY .001
 LOOP WHILE ButtonDown%%
 '------------------------------------------------
END SUB
 
SUB InitFont (C%%)
 SELECT CASE C%%
  CASE 0 'font startup
   _PALETTECOLOR 1, _RGB32(5, 5, 5), Layer(29)
   _PALETTECOLOR 2, _RGB32(255, 255, 255), Layer(29)
   _PALETTECOLOR 3, _RGB32(112, 112, 112), Layer(29)
   _PALETTECOLOR 4, _RGB32(170, 170, 170), Layer(29)
   _PALETTECOLOR 5, _RGB32(150, 150, 150), Layer(29)
   _PALETTECOLOR 6, _RGB32(175, 175, 175), Layer(29)
   _PALETTECOLOR 7, _RGB32(200, 200, 200), Layer(29)
   _PALETTECOLOR 8, _RGB32(216, 216, 216), Layer(29)
   _PALETTECOLOR 9, _RGB32(180, 180, 180), Layer(29)
   _PALETTECOLOR 10, _RGB32(205, 205, 205), Layer(29)
   _PALETTECOLOR 11, _RGB32(221, 221, 221), Layer(29)
   _PALETTECOLOR 12, _RGB32(240, 240, 240), Layer(29)
   _PALETTECOLOR 13, _RGB32(245, 245, 245), Layer(29)
   _SOURCE Layer(28)
   _DEST Layer(29)
   FOR y% = 0 TO 63
    FOR x% = 0 TO 539
     c~& = POINT(x%, y%)
     R~%% = _RED(c~&, Nuk&)
     G~%% = _GREEN(c~&, Nuk&)
     B~%% = _BLUE(c~&, Nuk&)
     PSET (x%, y%), _RGB(R~%%, G~%%, B~%%)
     'LINE (ox%, oy%)-STEP(1, 1), _RGB(R~%%, G~%%, B~%%), BF '2x font size
     ox% = ox% + 2
    NEXT x%
    ox% = 0
    oy% = oy% + 2
   NEXT y%
   _SOURCE Layer(30)
   _DEST _DISPLAY
  CASE 1 'Black font
   _PALETTECOLOR 2, _RGB32(8, 8, 8), Layer(29) 'black text
   _PALETTECOLOR 3, _RGB32(4, 4, 4), Layer(29) 'black text secondary(med font)
  CASE 2 'white font
   _PALETTECOLOR 2, _RGB32(255, 255, 255), Layer(29) 'white text
   _PALETTECOLOR 3, _RGB32(112, 112, 112), Layer(29) 'white text secondary(med font)
  CASE 3 'blue font
   _PALETTECOLOR 2, _RGB32(116, 148, 188), Layer(29) 'blue text
   _PALETTECOLOR 3, _RGB32(76, 124, 172), Layer(29) 'blue text secondary(med font)
  CASE 4 'green font
   _PALETTECOLOR 2, _RGB32(73, 207, 36), Layer(29) 'green text
   _PALETTECOLOR 3, _RGB32(44, 150, 12), Layer(29) 'green text secondary(med font)
  CASE 5 'yellow font
   _PALETTECOLOR 2, _RGB32(255, 224, 80), Layer(29) 'yellow text
   _PALETTECOLOR 3, _RGB32(200, 144, 0), Layer(29) 'yellow text secondary(med font)
  CASE 6 'red font
   _PALETTECOLOR 2, _RGB32(220, 32, 32), Layer(29) 'red text
   _PALETTECOLOR 3, _RGB32(144, 24, 4), Layer(29) 'red text secondary(med font)
  CASE 7 'grey font
   _PALETTECOLOR 2, _RGB32(160, 160, 160), Layer(29) 'grey text
   _PALETTECOLOR 3, _RGB32(140, 140, 140), Layer(29) 'grey text secondary(med font)
  CASE 8 'yellow gradiant
   _PALETTECOLOR 1, _RGB32(3, 3, 3), Layer(29) '
   _PALETTECOLOR 4, _RGB32(224, 186, 84), Layer(29) 'Yellow gradiant text
   _PALETTECOLOR 5, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 6, _RGB32(224, 186, 84), Layer(29) '
   _PALETTECOLOR 7, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 8, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 9, _RGB32(224, 186, 84), Layer(29) '
   _PALETTECOLOR 10, _RGB32(230, 208, 138), Layer(29) '
   _PALETTECOLOR 11, _RGB32(244, 230, 196), Layer(29) '
   _PALETTECOLOR 12, _RGB32(244, 230, 196), Layer(29) '
   _PALETTECOLOR 13, _RGB32(248, 244, 200), Layer(29) '
  CASE 9 'white gradiant
   _PALETTECOLOR 4, _RGB32(170, 170, 170), Layer(29) 'white gradiant text
   _PALETTECOLOR 5, _RGB32(150, 150, 150), Layer(29) '
   _PALETTECOLOR 6, _RGB32(170, 170, 170), Layer(29) '
   _PALETTECOLOR 7, _RGB32(200, 200, 200), Layer(29) '
   _PALETTECOLOR 8, _RGB32(216, 216, 216), Layer(29) '
   _PALETTECOLOR 9, _RGB32(180, 180, 180), Layer(29) '
   _PALETTECOLOR 10, _RGB32(200, 200, 200), Layer(29) '
   _PALETTECOLOR 11, _RGB32(216, 216, 216), Layer(29) '
   _PALETTECOLOR 12, _RGB32(246, 246, 246), Layer(29) '
   _PALETTECOLOR 13, _RGB32(246, 246, 246), Layer(29) '
  CASE 10 'grey gradiant
   _PALETTECOLOR 4, _RGB32(84, 84, 84), Layer(29) 'Grey gradiant text
   _PALETTECOLOR 5, _RGB32(68, 68, 68), Layer(29) '
   _PALETTECOLOR 6, _RGB32(84, 84, 84), Layer(29) '
   _PALETTECOLOR 7, _RGB32(104, 104, 104), Layer(29) '
   _PALETTECOLOR 8, _RGB32(120, 120, 120), Layer(29) '
   _PALETTECOLOR 9, _RGB32(104, 104, 104), Layer(29) '
   _PALETTECOLOR 10, _RGB32(120, 120, 120), Layer(29) '
   _PALETTECOLOR 11, _RGB32(142, 142, 142), Layer(29) '
   _PALETTECOLOR 12, _RGB32(142, 142, 142), Layer(29) '
   _PALETTECOLOR 13, _RGB32(160, 160, 160), Layer(29) '
  CASE 11 'Dark Green
   _PALETTECOLOR 2, _RGB32(0, 130, 94), Layer(29) 'green text
   _PALETTECOLOR 3, _RGB32(0, 110, 74), Layer(29) 'green text secondary(med font)
  CASE 12 'Bright Green
   _PALETTECOLOR 2, _RGB32(184, 240, 224), Layer(29) 'green text
   _PALETTECOLOR 3, _RGB32(124, 180, 164), Layer(29) 'green text secondary(med font)
  CASE 13 'Medium Green
   _PALETTECOLOR 2, _RGB32(32, 190, 144), Layer(29) 'green text
   _PALETTECOLOR 3, _RGB32(32, 190, 144), Layer(29) 'green text secondary(med font)
  CASE 14 'Lite Green
   _PALETTECOLOR 2, _RGB32(124, 216, 124), Layer(29) 'green text
   _PALETTECOLOR 3, _RGB32(100, 180, 100), Layer(29) 'green text secondary(med font)
  CASE 15 'yellow gradiant Brown outline
   _PALETTECOLOR 1, _RGB32(70, 52, 40), Layer(29) '
   _PALETTECOLOR 4, _RGB32(224, 186, 84), Layer(29) 'Yellow gradiant text
   _PALETTECOLOR 5, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 6, _RGB32(224, 186, 84), Layer(29) '
   _PALETTECOLOR 7, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 8, _RGB32(210, 166, 36), Layer(29) '
   _PALETTECOLOR 9, _RGB32(224, 186, 84), Layer(29) '
   _PALETTECOLOR 10, _RGB32(230, 208, 138), Layer(29) '
   _PALETTECOLOR 11, _RGB32(244, 230, 196), Layer(29) '
   _PALETTECOLOR 12, _RGB32(244, 230, 196), Layer(29) '
   _PALETTECOLOR 13, _RGB32(248, 244, 200), Layer(29) '
 
 END SELECT
END SUB
 
SUB MFI_Loader (FN$)
 DIM Size(64) AS LONG, FOffset(64) AS LONG
 OPEN FN$ FOR BINARY AS #1
 GET #1, , c~%% 'retrieve number of files
 FOR I~%% = 1 TO c~%%
  GET #1, , FOffset(I~%%)
  GET #1, , Size(I~%%)
  FOffset&(I~%%) = FOffset&(I~%%) + 1
 NEXT I~%%
 'load the files where they go here----------
 ' Layer(2) = LoadGFX(FOffset(1), Size(1)) '_LOADIMAGE("Upper_Card.png", 32) 'upper score card
 Layer(3) = LoadGFX(FOffset(1), Size(1)) ' Layer(3) = _LOADIMAGE("SpaceLord.bmp", 32)
 Layer(4) = LoadGFX(FOffset(2), Size(2)) ' Layer(4) = _LOADIMAGE("menuchoice.bmp", 32)
 Layer(5) = LoadGFX(FOffset(3), Size(3)) ' Layer(5) = _LOADIMAGE("HandPointer.bmp", 32)
 Layer(6) = LoadGFX(FOffset(4), Size(4)) ' Layer(6) = _LOADIMAGE("NewGame0.bmp", 32)
 Layer(7) = LoadGFX(FOffset(5), Size(5)) ' Layer(7) = _LOADIMAGE("GameOptions.bmp", 32)
 Layer(8) = LoadGFX(FOffset(6), Size(6)) ' Layer(8) = _LOADIMAGE("custom0.bmp", 32)
 Layer(10) = LoadGFX(FOffset(7), Size(7)) ' Layer(10) = _LOADIMAGE("RaceFaces.bmp", 32)
 Layer(11) = LoadGFX(FOffset(8), Size(8)) ' Layer(11) = _LOADIMAGE("Flags.bmp", 32)
 Layer(12) = LoadGFX(FOffset(9), Size(9)) ' Layer(12) = _LOADIMAGE("MainView0.bmp", 32)
 Layer(13) = LoadGFX(FOffset(10), Size(10)) ' Layer(13) = _LOADIMAGE("Game_Options.bmp", 32)
 Layer(14) = LoadGFX(FOffset(11), Size(11)) ' Layer(14) = _LOADIMAGE("Design_Screen.bmp", 32)
 Layer(15) = LoadGFX(FOffset(12), Size(12)) ' Layer(15) = _LOADIMAGE("shipsheet.bmp", 32)
 Layer(16) = LoadGFX(FOffset(13), Size(13)) ' Layer(16) = _LOADIMAGE("fleetbrb0.bmp", 32)
 Layer(17) = LoadGFX(FOffset(14), Size(14)) ' Layer(17) = _LOADIMAGE("viewship0.bmp", 32)
 Layer(18) = LoadGFX(FOffset(15), Size(15)) ' Layer(18) = _LOADIMAGE("shipspec.bmp", 32)
 Layer(19) = LoadGFX(FOffset(16), Size(16)) ' Layer(19) = _LOADIMAGE("mapview0.bmp", 32)
 Layer(20) = LoadGFX(FOffset(17), Size(17)) ' Layer(20) = _LOADIMAGE("sky.bmp", 32)
 Layer(28) = LoadGFX(FOffset(18), Size(18)) ' Layer(28) = _LOADIMAGE("FontAdvanced.bmp", 32)
 LoadData FOffset(19), Size(19)
 LoadData FOffset(20), Size(20)
 '-------------------------------------------
 CLOSE #1
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
 
 
FUNCTION LoadGFX& (Foff&, Size&)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
 
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
 
FUNCTION LoadSFX& (Foff&, Size&)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
 
SUB LoadData (Foff&, Size&)
 IF _FILEEXISTS("DatatempI.dat") THEN 'KILL "Datatemp.dat"
  OPEN "DatatempA.dat" FOR BINARY AS #3
  dat$ = SPACE$(Size&)
  GET #1, Foff&, dat$
  PUT #3, , dat$
  CLOSE #3
 ELSE
  OPEN "DatatempI.dat" FOR BINARY AS #3
  dat$ = SPACE$(Size&)
  GET #1, Foff&, dat$
  PUT #3, , dat$
  CLOSE #3
 END IF
END SUB
 

it became quite a mess, so I've stepped away from it for a bit.
but that plays the intro animation, runs the menu, and allows setup of a new game.

zlib1.dll goes in the QB64 folder, its for playing back the animations(intro, and swirl on the main menu)

the MFI file contains all the graphics and animation.

I have a second R&D(research and development) copy that generates the galaxy. and displays it in the map view and main view.

When I was looking up information on the game, it seems that Microprose is not opposed to clones, just as long as it does not use the name "Master Of Orion".

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 02:07:51 pm

Who would have ever thought MOO would be that complicated to program. I can't imagine then what the code for Stellaris might look like. The space 4x that I had been playing most recently is Star Drive 2. I absolutely love the ship design 'workshop' and then watching them in real time battles. It is the rest of the game that leaves me wishing for something better. Despite MOO 1's flaws it is the best space 4x ever created.

If I could ask a computer_game_god for the perfect game it would be MOO 1 without any of the bad and it would have Star Drive 2's ship design/combat and it would be in real time. It probably is never going to happen though.

Now that I understand real time programming a whole lot better than before I feel as though I could make an attempt. But, the graphics are my weakest point. What you see in this game is the "grandest" graphics I have ever done, LOL. I would be open to the idea of having a partner if they brought graphical ability to the table.

Even if this project does not go much further I had a good time getting this far. It was fun creating something a bit different! Oh, and I will take a closer look at your game when I get a chance.

Title: Re: Beyond Sol
Post by: Petr on December 09, 2019, 04:53:15 pm

romichess: I played your latest version for about an hour now! It's a hell of a lot of fun!

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 06:04:08 pm

Quote from: Petr on December 09, 2019, 04:53:15 pm

romichess: I played your latest version for about an hour now! It's a hell of a lot of fun!

Thank you Petr, If you have any suggestions to make it even more fun please let me know!

I have to add pause and save game. Also I'm working on a right click panel to give repeating orders to a star. Like if ships > 800 then send 100 ships to [star] increase 800 by 10 to 810 for next time. Thanks again.

Title: Re: Beyond Sol
Post by: romichess on December 09, 2019, 10:34:25 pm

Just a bug fix and maybe a bit better 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 INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
END TYPE
 
TYPE FLEETS
    n AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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 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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx AS INTEGER
DIM SHARED id 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
cx = sw
cp = 100
h = 100
ar = 0
rng = 300
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 14 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 200 '                        Set to 200 frames per second
 
    CLS
 
    id = INT(RND * 5 + 2)
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Identify x, y '                    Identify star mouse is over if any
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    IF ships = 0 THEN
 
    END IF
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).n = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            IF rng < 4000 THEN rng = rng + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    RANDOMIZE TIMER
    FOR i = 0 TO 99
        r = INT(RND * 120)
        IF r < star(i).p THEN
            IF star(i).o > 0 THEN
                star(i).t = star(i).t + 1
            ELSE
                IF INT(RND * 10) < 2 THEN
                    star(i).t = star(i).t + 1
                END IF
            END IF
        END IF
    NEXT
    FOR j = 0 TO 99
        IF star(j).o = id AND j <> home(id) AND star(j).t > LL + star(j).p * 16 THEN
            SendFleet j, home(id), star(j).t - LL - star(j).p * 8
        END IF
    NEXT
    org = home(id)
    dst = 100
    num = 10000
    FOR j = 0 TO 99
        IF star(j).o <> id THEN
            sway = SQR(ABS(star(org).x - star(j).x) ^ 2 + ABS(star(org).y - star(j).y) ^ 2)
            IF star(org).t > star(j).t * 5 + SQR(sway) AND sway < num THEN
                num = sway
                dst = j
            END IF
        END IF
    NEXT
    IF dst < 100 AND star(dst).o <> id AND star(org).t > LL * 2 THEN
        IF star(org).t > star(dst).t * 4 THEN
            SendFleet org, dst, star(org).t / 2
        END IF
    END IF
    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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).n
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    alive = 1
                    WHILE alive
                        alive = 0
                        damorg = fleet(i).n / 11 + 1
                        damdst = star(dst).t / 10 + 1
                        fleet(i).n = fleet(i).n - damdst
                        star(dst).t = star(dst).t - damorg
                        IF fleet(i).n > 0 AND star(dst).t > 0 THEN
                            alive = 1
                        END IF
                    WEND
                    IF star(dst).t < 1 THEN
                        star(dst).t = fleet(i).n
                        star(dst).o = fleet(i).o
                    END IF
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    ch = ""
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 6 AND ABS(y - cy) < 6 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        LINE (px, py)-(x, y), 10
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            END IF
            IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                dig = (x - x1 - 32 * ratio) / (38 * ratio)
                strng = tmp$ + STR$(dig)
            END IF
            IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                strng = ""
            END IF
            IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                value = VAL(strng)
                strng = ""
                pact = 0
                IF value <= star(srcidx).t THEN
                    SendFleet srcidx, dstidx, value
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF pact = 0 AND ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
            ii = i
            IF star(i).o = 1 AND slct = 0 THEN
                IF clk THEN
                    slct = 1
                END IF
                px = x
                py = y
                srcstr = star(i).n
                srcidx = i
            ELSE
                IF slct = 1 OR pact = 1 THEN
                    IF clk THEN
                        slct = 0
                        pact = 1
                        dststr = star(i).n
                        dstidx = i
                    END IF
                END IF
            END IF
            EXIT FOR
        END IF
    NEXT
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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 32 * ratio: xd = 182 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    xo = 216 * ratio: xd = 366 * ratio: yo = 460 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    COLOR 8, 7
    _FONT ttf1
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 460 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 460 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 + 6) * ratio, c
        COLOR 15
        IF o > 0 THEN
            PAINT (x, y), o + 8, c
        END IF
        _FONT ttf1
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            L = _PRINTWIDTH(n$)
        ELSE
            n$ = STR$(star(i).t)
            L = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - L / 2, y + 12), n$, 0
    NEXT
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
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 20
    star(0).t = 100
    home(0) = 0
    FOR i = 1 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 * 8) + 1
        star(i).t = 0
    NEXT
    FOR i = 2 TO 6
        k = 1
        WHILE k
            k = 0
            r = RND * 100
            FOR j = 1 TO i - 1
                IF r = home(j) THEN k = 1
                x = star(0).x
                y = star(0).y
                dx = ABS(star(r).x - x)
                dy = ABS(star(r).y - y)
                IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
            NEXT
        WEND
        home(i) = r
        star(r).o = i
        star(r).p = 20
        star(r).t = 100
    NEXT
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
 

Title: Re: Beyond Sol
Post by: romichess on December 11, 2019, 09:45:29 pm

The letter 'p' can be pressed to pause the game and pressed again to unpause. It is becoming intense and fast paced. If the starting position is not good I suggest pressing 'n' for a new game. All players are range bound now. The rule for range is that if a player cannot reach at least 12 stars that they do not own their range is increased until they can attack at least 12 stars they do not own. The green from/to line changes to red if a star is out of range and nothing happens if the mouse is clicked.

Any feedback good or bad is not only welcome it is needed for this project to last much longer. I'll be on to something else if no one is interested. As it is it seems like at least an interesting example of GUI on demand.

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 INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
END TYPE
 
TYPE FLEETS
    n AS INTEGER
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
    o AS INTEGER
    d AS INTEGER
END TYPE
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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 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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx AS INTEGER
DIM SHARED id AS INTEGER
DIM SHARED maxdst(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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 200 '                        Set to 200 frames per second
 
    CLS
 
    id = INT(RND * 5 + 2)
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Identify x, y '                    Identify star mouse is over if any
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).n = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    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
 
    FOR i = 0 TO 99
        IF star(i).t > 50 AND star(i).o = id AND i <> home(id) THEN
            ok = 1
            FOR j = 1 TO 6
                IF j <> id THEN
                    h = home(j)
                    sway = SQR(ABS(star(h).x - star(i).x) ^ 2 + ABS(star(h).y - star(i).y) ^ 2)
                    IF sway - 50 < maxdst(j) 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
    NEXT
 
    org = home(id)
    IF star(org).o <> id THEN
        FOR j = 0 TO 99
            IF star(j).o = id THEN home(id) = j: EXIT FOR
        NEXT
    END IF
 
    count = 0
    FOR j = 0 TO 99
        IF star(j).o <> id THEN
            sway = SQR(ABS(star(org).x - star(j).x) ^ 2 + ABS(star(org).y - star(j).y) ^ 2)
            IF sway < maxdst(id) THEN count = count + 1
            IF count > 11 THEN EXIT FOR
        END IF
    NEXT
    IF count < 12 THEN maxdst(id) = maxdst(id) + 1
 
    FOR j = 0 TO 99
        sway = SQR(ABS(star(org).x - star(j).x) ^ 2 + ABS(star(org).y - star(j).y) ^ 2)
        IF sway < maxdst(id) AND star(j).o <> id AND star(org).t > LL * 2 THEN
            IF star(org).t > star(j).t * 5 THEN
                SendFleet org, j, star(org).t / 3
            END IF
        END IF
    NEXT
 
    FOR j = 0 TO 99
        IF star(j).o = id AND j <> home(id) AND star(j).t > LL * 1.5 THEN
            SendFleet j, home(id), star(j).t / 3
        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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).n
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    alive = 1
                    WHILE alive
                        alive = 0
                        damorg = fleet(i).n / 11 + 1
                        damdst = star(dst).t / 10 + 1
                        fleet(i).n = fleet(i).n - damdst
                        star(dst).t = star(dst).t - damorg
                        IF fleet(i).n > 0 AND star(dst).t > 0 THEN
                            alive = 1
                        END IF
                    WEND
                    IF star(dst).t < 1 THEN
                        star(dst).t = fleet(i).n
                        star(dst).o = fleet(i).o
                    END IF
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
 
    WHILE (ch = "p")
        IF INKEY$ = "p" THEN EXIT WHILE
    WEND
 
    ch = ""
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 8 AND ABS(y - cy) < 8 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    count = 0
    FOR j = 0 TO 99
        IF star(j).o <> 1 THEN
            sway = SQR(ABS(star(home(1)).x - star(j).x) ^ 2 + ABS(star(home(1)).y - star(j).y) ^ 2)
            IF sway < maxdst(1) THEN count = count + 1
            IF count > 11 THEN EXIT FOR
        END IF
    NEXT
    IF count < 12 THEN maxdst(1) = maxdst(1) + 1
    IF slct = 1 THEN
        sway = SQR(ABS(star(home(i)).x - x) ^ 2 + ABS(star(home(1)).y - y) ^ 2)
        c = 10
        IF sway > maxdst(1) THEN
            c = 12
            clk = 0
        END IF
        LINE (px, py)-(x, y), c
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            ELSE IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (38 * ratio)
                    strng = tmp$ + STR$(dig)
                ELSE IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                        strng = ""
                    ELSE IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                            value = VAL(strng)
                            strng = ""
                            pact = 0
                            IF value <= star(srcidx).t THEN
                                SendFleet srcidx, dstidx, value
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    FOR i = 0 TO 99
        dx = star(i).x - x
        dy = star(i).y - y
        IF pact = 0 AND ABS(dx) <= star(i).s + 8 AND ABS(dy) <= star(i).s + 8 THEN
            ii = i
            IF star(i).o = 1 AND slct = 0 THEN
                IF clk THEN
                    slct = 1
                END IF
                px = x
                py = y
                srcstr = star(i).n
                srcidx = i
            ELSE
                IF slct = 1 OR pact = 1 THEN
                    IF clk THEN
                        slct = 0
                        pact = 1
                        dststr = star(i).n
                        dstidx = i
                    END IF
                END IF
            END IF
            EXIT FOR
        END IF
    NEXT
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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * 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 = 216 * ratio: xd = 366 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf1
    COLOR 7, 8
    _PRINTSTRING (100 * ratio, 112 * ratio), STR$(star(srcidx).t), ps
    _PRINTSTRING (270 * ratio, 112 * ratio), STR$(star(dstidx).t), ps
    COLOR 0, 7
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 458 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 ttf1
        IF tt THEN
            n$ = star(i).n
            n$ = RTRIM$(n$)
            L = _PRINTWIDTH(n$)
        ELSE
            n$ = STR$(star(i).t)
            L = _PRINTWIDTH(n$)
        END IF
        _PRINTSTRING (x - L / 2, y + 14), n$, 0
    NEXT
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
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 10
    star(0).t = 100
    home(1) = 0
    maxdst(1) = 200
    FOR i = 1 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) + 4
        star(i).t = 0
    NEXT
    FOR i = 2 TO 6
        k = 1
        WHILE k
            k = 0
            r = RND * 100
            FOR j = 1 TO i - 1
                IF r = home(j) THEN k = 1
                x = star(0).x
                y = star(0).y
                dx = ABS(star(r).x - x)
                dy = ABS(star(r).y - y)
                IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
            NEXT
        WEND
        home(i) = r
        star(r).o = i
        star(r).p = 10
        star(r).t = 100
        maxdst(i) = 200
    NEXT
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
 

Title: Re: Beyond Sol
Post by: romichess on December 16, 2019, 11:54:16 pm

It is enough better to make a new post.

Press:
esc to quit
p to pause/unpause
t toggles star name and production value
n for new game

Click:
on a blue planet then any planet to send ships
on numbers to select number of ships
on OK to send ships
on QUIT to cancel send
on CLEAR to start over selecting number of ships
can only click on second planet if range line is green
if range line is red second planet is out of range

I think that is all actions for now.

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 '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
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
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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 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 cx AS INTEGER
DIM SHARED cy AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED nclk AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx AS INTEGER
DIM SHARED id AS INTEGER
DIM SHARED hate(7, 7) AS INTEGER
DIM SHARED pause 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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 200 '                        Set to 200 frames per second
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Identify x, y '                     Identify star mouse is over if any
 
    Player
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).t = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    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
 
    org = home(id)
    IF star(org).o <> id THEN
        FOR j = 0 TO 99
            IF star(j).o = id THEN home(id) = j: EXIT FOR
        NEXT
    END IF
 
    FOR p = 0 TO 3
 
        IF p = 0 THEN
            sf2 = 100
            sf1 = home(id)
            IF star(sf1).t > LL * 2 THEN
                sf3 = star(sf1).t / 2
                g = -1
                FOR j = 0 TO 99
                    IF star(j).o <> id THEN
                        IF hate(id, star(j).o) > g THEN
                            IF star(sf1).t > star(j).t * 5 + RND * 200 - 100 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
                                            sf2 = j
                                            g = hate(id, star(j).o)
                                            EXIT FOR
                                        END IF
                                    END IF
                                NEXT
                            END IF
                        END IF
                    END IF
                    IF g = h THEN EXIT FOR
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    sf2 = 100
                    EXIT FOR
                END IF
            END IF
        END IF
 
        IF p = 1 THEN
            ok = 0
            FOR i = 1 TO 99
                IF i <> home(id) AND star(i).o = id THEN
                    IF star(i).t > LL * 1.5 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
 
        IF p = 2 THEN
            FOR i = 1 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 <= 350 * 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
            sf2 = 100
            FOR i = 0 TO 99
                IF star(i).o = id AND star(i).t > LL * 1.5 THEN
                    sf3 = star(i).t / 2
                    FOR j = 0 TO 99
                        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
                                        g = hate(id, star(j).o)
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                        END IF
                    NEXT
                    IF g = h THEN EXIT FOR
                END IF
            NEXT
            IF sf2 < 100 THEN
                SendFleet sf1, sf2, sf3
                sf2 = 100
                EXIT FOR
            END IF
        END IF
 
    NEXT
 
    GetInput
 
    Identify x, y '                     Identify star mouse is over if any
 
    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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).t
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    IF fleet(i).t > star(dst).t * 1.1 THEN
                        alive = 1
                        WHILE alive
                            alive = 0
                            damorg = fleet(i).t / 11 + 1
                            damdst = star(dst).t / 10 + 1
                            fleet(i).t = fleet(i).t - damdst
                            star(dst).t = star(dst).t - damorg
                            IF fleet(i).t > 0 AND star(dst).t > 0 THEN
                                alive = 1
                            END IF
                        WEND
                        IF star(dst).t < 1 THEN
                            hate(star(dst).o, fleet(i).o) = hate(star(dst).o, fleet(i).o) + 1
                            star(dst).t = fleet(i).t
                            star(dst).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
                        END IF
                    END IF
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN pause = 1
 
    WHILE (pause = 1)
        IF INKEY$ = "p" THEN
            pause = 0
        END IF
    WEND
 
    WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
 
    x = _MOUSEX
    y = _MOUSEY
    mb = _MOUSEBUTTON(1)
    clk = 0
 
    IF mb = -1 AND cx = sw THEN
        cx = x
        cy = y
    END IF
 
    IF mb = 0 AND cx < sw THEN
        IF ABS(x - cx) < 9 AND ABS(y - cy) < 9 THEN
            clk = 1
        END IF
        cx = sw
    END IF
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        nclk = 1
        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 <= 200 * ratio THEN
                    nclk = 0
                    EXIT FOR
                END IF
            END IF
        NEXT
        c = 10
        IF nclk = 1 THEN
            c = 12
            clk = 0
        END IF
        LINE (px, py)-(x, y), c
        EXIT SUB
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            ELSE IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (38 * ratio)
                    strng = tmp$ + STR$(dig)
                ELSE IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                        strng = ""
                    ELSE IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                            value = VAL(strng)
                            strng = ""
                            pact = 0
                            IF value <= star(srcidx).t THEN
                                SendFleet srcidx, dstidx, value
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    IF nclk = 0 THEN
        FOR i = 0 TO 99
            dx = star(i).x - x
            dy = star(i).y - y
            IF pact = 0 AND ABS(dx) <= star(i).s + 8 AND ABS(dy) <= star(i).s + 8 THEN
                ii = i
                IF star(i).o = 1 AND slct = 0 THEN
                    IF clk THEN
                        slct = 1
                    END IF
                    px = x
                    py = y
                    srcstr = star(i).n
                    srcidx = i
                ELSE
                    IF slct = 1 OR pact = 1 THEN
                        IF clk THEN
                            slct = 0
                            pact = 1
                            dststr = star(i).n
                            dstidx = i
                        END IF
                    END IF
                END IF
                EXIT FOR
            END IF
        NEXT
    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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * 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 = 216 * ratio: xd = 366 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf1
    COLOR 7, 8
    _PRINTSTRING (100 * ratio, 112 * ratio), STR$(star(srcidx).t), ps
    _PRINTSTRING (270 * ratio, 112 * ratio), STR$(star(dstidx).t), ps
    COLOR 0, 7
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 458 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 ttf1
        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 NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 0
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 10
    star(0).t = 100
    home(1) = 0
    FOR i = 1 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
    NEXT
    FOR i = 2 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 <= 250 THEN ok = ok + 1
                    IF ok = 1 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).t = 100
    NEXT
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
 
 
 

Title: Re: Beyond Sol
Post by: bplus on December 17, 2019, 10:06:17 am

Quote

Any feedback good or bad is not only welcome it is needed for this project to last much longer. I'll be on to something else if no one is interested. As it is it seems like at least an interesting example of GUI on demand.

OK in last post you start explaining some things, I have no idea idea why I want to send ships anywhere? So if you want a new audience, you might consider explaining the the game setup and objectives.

Title: Re: Beyond Sol
Post by: romichess on December 17, 2019, 11:31:31 am

Quote from: bplus on December 17, 2019, 10:06:17 am

OK in last post you start explaining some things, I have no idea idea why I want to send ships anywhere? So if you want a new audience, you might consider explaining the the game setup and objectives.

From the op.

The game lives! Save humanity from the alien threat!!

To play just click on one of your stars. Then click (don't drag) on any other star and then send ships. That is all there is to it. The esc key exits the game. The "t' key toggles the star names. Look for the blue star. That is Sol the human's home star.

I'm pretty sure any child could figure it out from that. :)

Title: Re: Beyond Sol
Post by: bplus on December 17, 2019, 12:25:03 pm

LOL sure a child can figure it out but well a little far from that...

OK so I click Sol and then click another star and a blue bubble travels (and not as the crow flies, which I can fix if you are interested) ever so slowly from Sol to planet and back and then nothing changes... ??? Still don't get it?

Title: Re: Beyond Sol
Post by: romichess on December 18, 2019, 12:28:53 am

Quote from: bplus on December 17, 2019, 12:25:03 pm

LOL sure a child can figure it out but well a little far from that...

OK so I click Sol and then click another star and a blue bubble travels (and not as the crow flies, which I can fix if you are interested) ever so slowly from Sol to planet and back and then nothing changes... ??? Still don't get it?

You have to send enough ships to take over the star system. If you don't the fleet turns around. Afterall they don't want to die for nothing, LOL. The graphics are not the final graphics. I'm just working on game play right now. When the ships are not traveling as the crow flies it is unknown by the player where the computers ships are going until they make the turn. In some cases that gives the player little time to react. It is a work in progress.

Title: Re: Beyond Sol
Post by: Kazman on December 18, 2019, 10:07:25 am

I'm playing the game, I like it but mouse reactions are too slow... I often had to click several times on every button in order to make effect

Title: Re: Beyond Sol
Post by: romichess on December 18, 2019, 04:50:48 pm

Quote from: Kazman on December 18, 2019, 10:07:25 am

I'm playing the game, I like it but mouse reactions are too slow... I often had to click several times on every button in order to make effect

Thank you for trying the game and thanks for liking it! The mouse is a problem. It seems to be the speed of the click. If I hesitate in the button down position for just a moment before letting the button up it works every time. If I could figure out why then maybe it can be fixed. Also my goal is for the computer to be a challenge without resorting to cheating like so many games do.

Title: Re: Beyond Sol
Post by: romichess on December 20, 2019, 06:15:23 am

The news is that the mouse problem is solved. It is silky smooth now. Still if one is in a hurry moving and clicking the mouse at the same time especially if clicking at double click speed there are still issues. But that is like at crazy speed. One can operate the mouse very quickly without any problems at all. And clicking on the numbers is more accurate as well. Also the computer target selection code has been completely rewritten. I do have a friend that test almost every new version. And he really likes this version. He says it is more challenging. So it seems that the playing algorithm may be finalized soon.

In the next update (not this one) starbases will be added. Basically starbases will be from level 0 to 9. The math will be like a lvl 0 (1) will be like 1 x 1 x 1000 ships. They will do the damage of a thousand ships but only cost 500 ships to build. They will take normal damage. A lvl 9 (10) starbase will be like 10 x 10 x 1000 ships and they will do the damage of 100,000 ships but because of their size and thickness of hull they will take half damage. It will cost ships at one fourth to repair them. Just wanted to let everyone know it was coming! :)

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 '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
    p AS INTEGER '                     (Population) For now ships produced per turn
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
 
'DECLARE SUB NewGame
'DECLARE SUB PaintStars
'DECLARE SUB StarNames
'DECLARE SUB ShowPanel (i)
'DECLARE SUB Identify (x, y)
'DECLARE SUB PaintBackground
'DECLARE SUB GetInput
 
' 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 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 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 cx AS INTEGER
DIM SHARED cp AS INTEGER
DIM SHARED ps AS LONG
DIM SHARED clk AS LONG
DIM SHARED h AS INTEGER
DIM SHARED x1 AS INTEGER
DIM SHARED y1 AS INTEGER
DIM SHARED x2 AS INTEGER
DIM SHARED y2 AS INTEGER
DIM SHARED ch AS STRING * 1 '          Game loop key input variable
DIM SHARED repeat AS INTEGER '         Game loop control variable
DIM SHARED ttf1 AS LONG
DIM SHARED ttf2 AS LONG
DIM SHARED fleet(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED nclk AS INTEGER
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED ii AS INTEGER
DIM SHARED srcstr AS STRING * 10
DIM SHARED dststr AS STRING * 10
DIM SHARED panx, pany AS INTEGER
DIM SHARED dig AS INTEGER
DIM SHARED strng AS STRING * 10
DIM SHARED value AS INTEGER
DIM SHARED srcidx AS INTEGER
DIM SHARED dstidx AS INTEGER
DIM SHARED id AS INTEGER
DIM SHARED hate(7, 7) AS INTEGER
DIM SHARED pause 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
cx = sw
cp = 100
h = 100
ar = 0
rng = 200
slct = 0
strng = ""
 
SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
 
_FULLSCREEN
 
ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
NewGame
 
ttf1 = _LOADFONT("cyberbit.ttf", 16 * ratio, "BOLD")
ttf2 = _LOADFONT("cyberbit.ttf", 72 * ratio, "BOLD")
 
repeat = 1
 
WHILE repeat
 
    _LIMIT 60 '                        Set to 200 frames per second
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Identify x, y
 
    Player
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
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 SendFleet (org, dst, ships)
    FOR i = 0 TO 999
        IF fleet(i).o = 0 THEN
            fleet(i).o = star(org).o
            fleet(i).d = dst
            fleet(i).x1 = star(org).x
            fleet(i).y1 = star(org).y
            fleet(i).x2 = star(dst).x
            fleet(i).y2 = star(dst).y
            fleet(i).t = ships
            star(org).t = star(org).t - ships
            fltcnt = fltcnt + 1
            EXIT FOR
        END IF
    NEXT
    LL = LL + 1
END SUB
 
SUB Computer
    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
 
    org = home(id)
    IF star(org).o <> id THEN
        FOR j = 0 TO 99
            IF star(j).o = id THEN home(id) = j: EXIT FOR
        NEXT
    END IF
 
    FOR p = 0 TO 3
 
        IF p = 0 THEN
            away = 10000
            i = home(id)
            IF star(i).t > LL * 2 THEN
                FOR j = 0 TO 99
                    IF star(j).o <> id THEN
                        dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                        IF dist <= 250 AND star(j).t > star(i).t / 3 THEN
                            away = 10000
                            EXIT FOR
                        END IF
                        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(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                            IF dist < away AND star(i).t > star(j).t * 3 THEN
                                away = dist
                                jay = j
                            END IF
                        END IF
                    END IF
                NEXT
                IF away < 10000 THEN
                    SendFleet i, jay, star(i).t / 2
                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.5 THEN
                    sf3 = star(i).t / 2
                    FOR j = 0 TO 99
                        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
                    NEXT
                    IF sf2 < 100 THEN EXIT FOR
                END IF
            NEXT
            IF sf2 < 100 THEN
                SendFleet sf1, sf2, sf3
                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 <= 350 * 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
 
    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
                dst = fleet(i).d
                IF star(dst).o = fleet(i).o THEN
                    star(dst).t = star(dst).t + fleet(i).t
                    fleet(i).o = 0
                    fltcnt = fltcnt - 1
                ELSE
                    IF fleet(i).t > star(dst).t * 0.6 THEN
                        alive = 1
                        WHILE alive
                            alive = 0
                            damorg = fleet(i).t / 10 + 1
                            damdst = star(dst).t / 9 + 1
                            fleet(i).t = fleet(i).t - damdst
                            star(dst).t = star(dst).t - damorg
                            IF fleet(i).t > 0 AND star(dst).t > 0 THEN
                                alive = 1
                            END IF
                        WEND
                        IF star(dst).t < 1 THEN
                            hate(star(dst).o, fleet(i).o) = hate(star(dst).o, fleet(i).o) + 1
                            star(dst).t = fleet(i).t
                            star(dst).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
                        END IF
                    END IF
                END IF
            END IF
        END IF
        i = i + 1
    WEND
END SUB
 
SUB GetInput
 
    ch = INKEY$
    IF ch = CHR$(27) THEN repeat = 0
    IF ch = "n" THEN NewGame
    IF ch = "t" THEN tt = 1 - tt
    IF ch = "p" THEN pause = 1
 
    WHILE (pause = 1)
        IF INKEY$ = "p" THEN
            pause = 0
        END IF
    WEND
 
    clk = 0
 
    WHILE _MOUSEINPUT
 
        x = _MOUSEX
        y = _MOUSEY
        mb = _MOUSEBUTTON(1)
 
        IF mb AND cx = sw THEN cx = x
 
    WEND
 
    IF mb = 0 AND cx < sw THEN clk = 1
 
    cx = sw
 
    x = _MOUSEX
    y = _MOUSEY
 
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 Player
    tmp$ = RTRIM$(strng)
    IF slct = 1 THEN
        nclk = 1
        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 <= 250 * ratio THEN
                    nclk = 0
                    EXIT FOR
                END IF
            END IF
        NEXT
        c = 10
        IF nclk = 1 THEN
            c = 12
            clk = 0
        END IF
        LINE (px, py)-(x, y), c
        n$ = STR$(INT(dist))
        _PRINTSTRING (x + 20, y), n$, 0
        EXIT SUB
    END IF
    IF pact = 1 THEN
        ShowPanel ii
        IF clk = 1 THEN
            x1 = panx: x2 = panx + 400 * ratio
            y1 = pany: y2 = pany + 540 * ratio
            IF x > x1 + 216 * ratio AND x < x1 + 366 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                pact = 0
            ELSE IF x > x1 + 20 * ratio AND x < x1 + 380 * ratio AND y > y1 + 260 * ratio AND y < y1 + 320 * ratio THEN
                    dig = (x - x1 - 32 * ratio) / (37 * ratio)
                    strng = tmp$ + STR$(dig)
                ELSE IF x > x1 + 266 * ratio AND x < x1 + 366 * ratio AND y > y1 + 366 * ratio AND y < y1 + 406 * ratio THEN
                        strng = ""
                    ELSE IF x > x1 + 32 * ratio AND x < x1 + 182 * ratio AND y > y1 + 460 * ratio AND y < y1 + 530 * ratio THEN
                            value = VAL(strng)
                            strng = ""
                            pact = 0
                            IF value <= star(srcidx).t THEN
                                SendFleet srcidx, dstidx, value
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
END SUB
 
SUB Identify (x, y)
    IF nclk = 0 THEN
        FOR i = 0 TO 99
            dx = star(i).x - x
            dy = star(i).y - y
            IF pact = 0 AND ABS(dx) <= star(i).s + 8 AND ABS(dy) <= star(i).s + 8 THEN
                ii = i
                IF star(i).o = 1 AND slct = 0 THEN
                    IF clk THEN
                        slct = 1
                    END IF
                    px = x
                    py = y
                    srcstr = star(i).n
                    srcidx = i
                ELSE
                    IF slct = 1 OR pact = 1 THEN
                        IF clk THEN
                            slct = 0
                            pact = 1
                            dststr = star(i).n
                            dstidx = i
                        END IF
                    END IF
                END IF
                EXIT FOR
            END IF
        NEXT
    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 ps
    CLS 0, 8
    COLOR 0, 8
    _FONT ttf2
    n$ = RTRIM$(srcstr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 8 * ratio), n$, ps
    n$ = "to"
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 80 * ratio), n$, ps
    n$ = RTRIM$(dststr)
    L = _PRINTWIDTH(n$)
    _PRINTSTRING ((400 * ratio - L) / 2, 152 * ratio), n$, ps
    LINE (20 * ratio, 240 * ratio)-(380 * ratio, 240 * ratio), 0
    _PRINTSTRING (20 * ratio, 260 * ratio), "0123456789", ps
    _PRINTSTRING (20 * ratio, 346 * ratio), strng, ps
    xo = 286 * ratio: xd = 366 * ratio: yo = 366 * ratio: yd = 406 * 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 = 216 * ratio: xd = 366 * ratio: yo = 458 * ratio: yd = 530 * ratio
    LINE (xo, yo)-(xd, yd), 7, BF
    _FONT ttf1
    COLOR 7, 8
    _PRINTSTRING (100 * ratio, 112 * ratio), STR$(star(srcidx).t), ps
    _PRINTSTRING (270 * ratio, 112 * ratio), STR$(star(dstidx).t), ps
    COLOR 0, 7
    _PRINTSTRING (300 * ratio, 380 * ratio), "CLEAR", ps
    _FONT ttf2
    _PRINTSTRING (60 * ratio, 458 * ratio), "Ok", ps
    _PRINTSTRING (220 * ratio, 458 * ratio), "Quit", ps
    _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
    panx = x1: pany = y1
    _DEST 0
END SUB
 
SUB PaintStars
    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 ttf1
        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 NewGame
    DIM k AS INTEGER
    DIM r AS INTEGER
    DIM dx AS INTEGER
    DIM dy AS INTEGER
    DIM n AS STRING * 10
    FOR i = 0 TO 999
        fleet(i).o = 0
    NEXT
    slct = 0
    fltcnt = 0
    LL = 25
    RANDOMIZE TIMER
    seed = RND * 1000
    star(0).n = "Sol"
    star(0).x = RND * (sw - sww) + swn
    star(0).y = RND * (sh - shw) + shn
    star(0).c = 14
    star(0).s = 2
    star(0).o = 1
    star(0).p = 10
    star(0).t = 100
    home(1) = 0
    FOR i = 1 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
    NEXT
    FOR i = 2 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 = 1 THEN EXIT FOR
                NEXT
            END IF
        WEND
        home(i) = j
        star(j).o = i
        star(j).p = 10
        star(j).t = 100
    NEXT
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
 
 

Title: Re: Beyond Sol
Post by: romichess on December 23, 2019, 04:23:36 am

First of all when over 60 y.o. never program when tired. I just went through several days of hell making and fixing bugs only to create more bugs than I fixed. After taking a day and a half off and getting lots of sleep I was able to fix all the bugs and add a ton of new features. No star bases yet but that is next. Much of the code was completely rewritten and is much cleaner. That process will continue. Optimising for speed will come later.

I probably can't name all the changes but here is a list of what I can remember.

Send all, send half and send third buttons to the fleet send panel.
A standing orders panel. So stars can automatically send ships to another planet.
Right clicking the mouse will cancel a panel
Right clicking on empty space will pause/unpause the game. Orders can still be issued.
Pressing "p" will do the same and orders can be issued.
The range line will when over a star snap to the center of the star and give the exact range
Range can be gotten between any two stars.
Right clicking will cancel range lines.
The computer players start the game paused so that a player can find his home star. Initial orders can be placed before unpausing.
And a few more minor changes.
The computer players are better than ever also! And still no cheating!!

To bring up a panel left or right click on one of your stars. Then left click another star to send ships or right click another one of your planets to bring up the standing orders panel. To cancel a standing order just enter 0 and 0. One standing order per star.

I was going to add star bases before making another post but I'm at the point of needing another day and a half off. That is all there is for now. Opinions about the interface are welcome as well as suggestions and opinions about the computer's play. Thanks!

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 '                     (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 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 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 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(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact 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 INTEGER
DIM SHARED id AS INTEGER
DIM SHARED hate(7, 7) 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 box AS INTEGER
DIM SHARED ord AS ORDERS
 
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
 
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
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
 
    _LIMIT 60 '                        Set to 200 frames per second
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
    STATIC last(7) AS INTEGER
 
    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
 
        org = home(id)
        IF star(org).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                away = 10000
                i = home(id)
                IF star(i).t > LL THEN
                    FOR j = 0 TO 99
                        IF star(j).o <> id AND last(id) <> j THEN
                            dist = SQR(ABS(star(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                            IF dist <= 250 AND star(j).t > star(i).t / 3 THEN
                                away = 10000
                                EXIT FOR
                            END IF
                            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(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                IF dist < away AND star(i).t > star(j).t * 2 THEN
                                    away = dist
                                    jay = j
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF away < 10000 THEN
                        last(id) = jay
                        SendFleet i, jay, star(i).t / 1.5
                    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.5 THEN
                        sf3 = star(i).t / 2
                        FOR j = 0 TO 99
                            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
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    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 <= 350 * 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
 
        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
                        IF fleet(i).t > star(dest).t * 0.6 THEN
                            alive = 1
                            WHILE alive
                                alive = 0
                                damorg = fleet(i).t / 10 + 1
                                damdst = star(dest).t / 9 + 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
                                hate(star(dest).o, fleet(i).o) = hate(star(dest).o, fleet(i).o) + 1
                                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
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
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
    ch = INKEY$
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        x = _MOUSEX
        y = _MOUSEY
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
    WEND
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF rclk = 1 THEN
        i = Identify
        IF i = 100 THEN
            IF src = 100 THEN
                paused = 1 - paused
                ch = ""
            ELSE
                src = 100
                oact = 0
                pact = 0
            END IF
            rclk = 0
        END IF
        IF pact = 1 OR oact = 1 THEN
            rclk = 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
    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
        ord.src = 100
    END IF
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).o <> 1 THEN
                order(i).src = 100
            ELSE
                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
 
    IF pact = 0 AND oact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = Identify
            END IF
        END IF
 
        ' If there is a source star then look for a right click else draw a range line
        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 <= 250 * ratio THEN
                        c = 10
                        EXIT FOR
                    END IF
                END IF
            NEXT
            rang = SQR(ABS(star(src).x - x) ^ 2 + ABS(star(src).y - y) ^ 2)
            i = Identify
            IF i <> 100 THEN
                x = star(i).x
                y = star(i).y
            END IF
            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 < 100 AND i <> src THEN
                    dst = i
                    IF lclk = 1 THEN
                        lclk = 0
                        pact = 1
                    ELSE
                        rclk = 0
                        IF star(i).o = 1 THEN
                            oact = 1
                        END IF
                    END IF
                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))
                        strng0 = ""
                        strng1 = ""
                        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
                            ord.src = src
                            ord.shp = VAL(strng1)
                            ord.dst = dst
                            box = 0
                            oact = 0
                            strng0 = ""
                            strng1 = ""
                            src = 100
                        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 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 SendFleet (src, dst, ships)
    FOR i = 0 TO 999
        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
    LL = LL + 1
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 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 = 25
    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 = 1 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
        star(home(1)).n = "Sol"
        star(home(1)).c = 14
    NEXT
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
 
 

Title: Re: Beyond Sol
Post by: Kazman on December 23, 2019, 07:31:44 am

I will test last version at home, because I'm testing it at work and it does almost nothing... no right click, no menus, no ships moving... I thing it is my problem, this pc is a sh#t :P

Title: Re: Beyond Sol
Post by: romichess on December 23, 2019, 02:04:47 pm

Quote from: Kazman on December 23, 2019, 07:31:44 am

I will test last version at home, because I'm testing it at work and it does almost nothing... no right click, no menus, no ships moving... I thing it is my problem, this pc is a sh#t :P

I'm sorry! Just to be sure I copied the posted code and ran it. It works on my machine. The game DOES START PAUSED now. Right clicking or pressing "p" toggles the paused mode. Even paused, orders should be able to be entered. Thus one should get menus. Please let me know when you get home if it is working for you, or not. Thanks!

Title: Re: Beyond Sol
Post by: romichess on December 24, 2019, 04:31:28 pm

I did find a couple of bugs. They were not fatal bugs. Anyway they are squashed now. And I performed more rigorous testing to make sure that there are no more bugs. And I added two more features. Lines were added for standing orders which are barely visible but if I can see them with my old eyes ... but if they are not visible on a lower contrast monitor, let me know. The second feature is a "mystery player". One of the computer players is randomly selected to use a different algorithm.

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 '                     (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 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 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 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(1000) AS FLEETS
DIM SHARED fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact 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 INTEGER
DIM SHARED id AS INTEGER
DIM SHARED hate(7, 7) 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 box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED hid 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
 
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
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
 
    _LIMIT 60 '                        Set to 200 frames per second
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    GetInput
 
    Player
 
    Computer
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
    STATIC last(7) AS INTEGER
 
    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
 
        org = home(id)
        IF star(org).o <> id THEN
            FOR j = 0 TO 99
                IF star(j).o = id THEN home(id) = j: EXIT FOR
            NEXT
        END IF
 
        FOR p = 0 TO 3
 
            IF p = 0 THEN
                away = 10000
                i = home(id)
                IF id = hid THEN
                    most = 0
                    FOR j = 0 TO 99
                        IF star(j).o <> hid THEN
                            ok = 0
                            FOR k = 0 TO 99
                                IF star(k).o = hid 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
                                IF star(j).p >= most THEN
                                    most = star(j).p
                                    jay = j
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF star(i).t > star(jay).t * 3 THEN
                        SendFleet i, jay, star(i).t / 2
                    END IF
                ELSE
                    IF star(i).t > LL THEN
                        FOR j = 0 TO 99
                            IF star(j).o <> id AND last(id) <> j THEN
                                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(i).x - star(j).x) ^ 2 + ABS(star(i).y - star(j).y) ^ 2)
                                    IF dist < away AND star(i).t > star(j).t * 2 THEN
                                        away = dist
                                        jay = j
                                    END IF
                                END IF
                            END IF
                        NEXT
                        IF away < 10000 THEN
                            last(id) = jay
                            SendFleet i, jay, star(i).t / 1.5
                        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.5 THEN
                        sf3 = star(i).t / 2
                        FOR j = 0 TO 99
                            IF star(j).o <> id AND star(i).t > star(j).t * 4 AND id <> hid 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
                        NEXT
                        IF sf2 < 100 THEN EXIT FOR
                    END IF
                NEXT
                IF sf2 < 100 THEN
                    SendFleet sf1, sf2, sf3
                    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 <= 350 * 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
 
        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
                        IF fleet(i).t > star(dest).t * 0.6 THEN
                            alive = 1
                            WHILE alive
                                alive = 0
                                damorg = fleet(i).t / 10 + 1
                                damdst = star(dest).t / 9 + 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
                                hate(star(dest).o, fleet(i).o) = hate(star(dest).o, fleet(i).o) + 1
                                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
                            END IF
                        END IF
                    END IF
                END IF
            END IF
            i = i + 1
        WEND
    END IF
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
    ch = INKEY$
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        x = _MOUSEX
        y = _MOUSEY
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
    WEND
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF rclk = 1 THEN
        i = Identify
        IF i = 100 THEN
            IF src = 100 THEN
                paused = 1 - paused
                ch = ""
            ELSE
                src = 100
                oact = 0
                pact = 0
            END IF
            rclk = 0
        END IF
        IF pact = 1 OR oact = 1 THEN
            rclk = 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
    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
 
    'execute standing orders
    FOR i = 0 TO 99
        IF order(i).src <> 100 THEN
            IF star(i).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
 
    IF pact = 0 AND oact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = Identify
            END IF
        END IF
 
        ' If there is a source star then look for a right click else draw a range line
        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 <= 250 * 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 < 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
 
    '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 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 SendFleet (src, dst, ships)
    FOR i = 0 TO 999
        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
    LL = LL + 1
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 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 = 25
    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 = 1 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
    away = 0
    from = home(1)
    FOR i = 2 TO 6
        too = home(i)
        dist = SQR(ABS(star(from).x - star(too).x ^ 2 - ABS(star(from).y - star(too).y) ^ 2))
        IF dist > away THEN
            away = dist
            hid = i
        END IF
    NEXT
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
 

Title: Re: Beyond Sol
Post by: romichess on December 30, 2019, 07:25:47 pm

The instructions are in the attachment.

Starbases are still in development. To do them well is proving more difficult than expected. When and where to build them is not easy. Unless one gets off to a good start it is very hard to beat the computer. If beating the computer is too difficult I may add starbases for the human player first.

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 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 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 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 fltcnt AS INTEGER
DIM SHARED LL AS INTEGER
DIM SHARED rng AS INTEGER
DIM SHARED slct AS INTEGER
DIM SHARED pact AS INTEGER
DIM SHARED oact 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 hate(7, 7) 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 box AS INTEGER
DIM SHARED ord AS ORDERS
DIM SHARED it AS INTEGER
DIM SHARED speed AS INTEGER
DIM SHARED hate(7, 7) AS LONG
 
 
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
 
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
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
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    PRINT LL
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    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
 
        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
 
        dis = 0
        hid = 0
        FOR j = 1 TO 6
            IF j <> id THEN
                IF hate(id, j) > dis THEN
                    dis = hate(id, j)
                    hid = j
                END IF
            END IF
        NEXT
 
        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).d > 0 THEN
                            star(j).d = star(j).d - 1
                        ELSE
                            IF star(j).o = hid THEN th = 3 ELSE th = 4
                            IF star(j).o <> id AND star(i).t > star(j).t * th THEN
                                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
                                        away = dist
                                        jay = j
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay < 100 THEN
                        SendFleet i, jay, star(i).t / 1.5
                        star(jay).d = 1000
                    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.5 THEN
                        sf3 = star(i).t / 2
                        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 = 1000
                    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 > LL / 2 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 <= 350 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t / 2
                                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
 
        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
                            SendFleet dest, home(o), star(dest).t * 0.9
                            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 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
    ch = INKEY$
 
 
    lclk = 0
    rclk = 0
 
    WHILE _MOUSEINPUT
 
        x = _MOUSEX
        y = _MOUSEY
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
    WEND
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF rclk = 1 THEN
        i = Identify
        IF i = 100 THEN
            IF src = 100 THEN
                paused = 1 - paused
                ch = ""
            ELSE
                src = 100
                oact = 0
                pact = 0
            END IF
            rclk = 0
        END IF
        IF pact = 1 OR oact = 1 THEN
            rclk = 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
    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
 
    '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
 
    IF pact = 0 AND oact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = Identify
            END IF
        END IF
 
        ' If there is a source star then look for a right click else draw a range line
        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 < 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
 
    '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 SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        hate(star(src).o, star(dst).o) = hate(star(src).o, star(dst).o) + 1
        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
        LL = LL + 1
        IF LL > 20000 THEN LL = 20000
    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 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 = 25
    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
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
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Beyond Sol
Post by: romichess on December 30, 2019, 07:46:47 pm

Updated Readme

"Beyond Sol - Pre Alpha Version

A space 4x conquest game by Michael Sherwin

Every thing so far in the game

Game starts off paused but when paused one can still enter orders
Right clicking the mouse on the map will pause unpause the game
If a panel is displayed right clicking will cancel the panel
Left or right clicking on a star brings up the distance line
If the distance line is green ships can be sent
To send ships left click on a destination star and the send panel will appear
Click on the numbers to send ships by then clicking "OK"
The "clear" button clears the numbers
The "All" button sends all ships
There is a send "Half" and send "Third" button as well
The "Quit" button quits the panel
Right clicking on a self owned destination brings up the standing orders panel
Enter number that ships must be greator than in order to send, click "OK"
Or click "X" to clear
Then enter number of ships to send, click "OK" or click "X" to start over
For now untill a "Cancel" button is added just enter 0 and 0 to cancel
The "+" and "-" keys will speed up and slow down the game
If attacking fleets are too out matched they will turn around
If defending fleets are too out matched they will evacuate
The computer player will hate the player that has attacked them the most
A hated player will more likely be attacked
Pressing "p" will pause and unpause the game
Pressing "t" will show star names and production
"t" can be pressed while game is paused
And pressing "Esc" exits the game, no questions asked, so be careful
Pressing "n" stars a new game, no questions asked, be careful
More work needed, remember it is still pre alpha!

The computer is now a very dangerous opponent. However, if one gets off to a very good start the game is not that difficult
There are many features left to be added before it reaches, alpha"

Title: Re: Beyond Sol
Post by: romichess on December 30, 2019, 08:58:21 pm

Oh no! I just discovered that there is a game on Steam that is already named Beyond Sol. And I thought I was being so original, LOL. Back to the name hunt!

Title: Re: Beyond Sol
Post by: romichess on December 30, 2019, 09:28:39 pm

Okay, I have a couple of name ideas.

Et Go Home
We're Not Alone
Star Trak
It's a Cookbook
Deep Space
Planet of the Rabbits
We Should Not Have Sent That Probe Out
Aliens? Just Pretend They Aren't Real
Journey to the Center of the Galaxy
Stupid Aliens
Annoy the Aliens Until They leave
Those Human Hybrids Sure Look Funny
That Should Have Been Our Planet
Let's Irradiate Our Entire Planet With Nuclear Waste So They Won't Want It
Your Step Father is a What
They Are preparing a Stew and We Are Invited
Final Frontier (probably taken)
Time to Move
Mandela Effect
Earth and Beyond (?)
The Sky's the Limit
Beware the Wife Swappers (snatchers?)

Still working on it. I'll need some time!

Title: Re: Beyond Sol
Post by: Kazman on December 31, 2019, 05:03:48 am

Hi Romichess! As I said before, I'm trying now your game at my home's desktop PC. It runs very much faster! :D
I love it, and I can't wait until the new update ;)
Thank u very much :)

Title: Re: Beyond Sol
Post by: romichess on December 31, 2019, 06:00:19 pm

Quote from: Kazman on December 31, 2019, 05:03:48 am

Hi Romichess! As I said before, I'm trying now your game at my home's desktop PC. It runs very much faster! :D
I love it, and I can't wait until the new update ;)
Thank u very much :)

You are very welcome Kazman! And thank you for the feedback. Feedback is extremely important for development. So anything you can tell me, what you like, what you don't like, any suggestions, anything. I can't promise I'll add a suggestion but I will certainly consider whether or not it should be added. I'm working on a game menu so save and load game can be added as well as other options like playing with a different color, etc.

Title: Re: Beyond Sol
Post by: Kazman on January 02, 2020, 05:24:55 am

Ok, I will try to send you feedback as long as I can :P

One thing, I don't know if it is important. Remember my work PC? I said that the game and clicks were slow. Well, today I tried it on QB64 64 BITS and OMG speed has increased!!! And mouse behaviour! ;)

I like your idea of a game menu :)

What are your plans of graphics? I read before that these are not the final ones...

Happy 2020 ;)

Title: Re: Beyond Sol
Post by: romichess on January 02, 2020, 12:39:48 pm

Quote from: Kazman on January 02, 2020, 05:24:55 am

Ok, I will try to send you feedback as long as I can :P

One thing, I don't know if it is important. Remember my work PC? I said that the game and clicks were slow. Well, today I tried it on QB64 64 BITS and OMG speed has increased!!! And mouse behaviour! ;)

I like your idea of a game menu :)

What are your plans of graphics? I read before that these are not the final ones...

Happy 2020 ;)

For graphics I have downloaded some nice Hubble pictures. One is a nice star background. And the others have some really nice stars. The plan is to make sprites out of the stars. The next update will have a game menu! It is tedious to make panels by hand using trial and small adjustments. So I am working on a visual panel designer. It won't produce code, but it will give me all the x, y coordinates!

Title: Re: Beyond Sol
Post by: romichess on January 05, 2020, 06:55:39 pm

There was a request for some kind of a save and load so I added a quick save "q" and quick restore "r". IT DOES NOT SAVE TO DISK. The new game is saved so one can restart the exact game by pressing "r". But once "q" is pressed the start is replaced by a new save. See attached readme for some minor changes.

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 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 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 hate(7, 7) AS LONG
DIM SHARED qhate(7, 7) AS LONG
 
 
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
 
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
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
 
    id = INT(RND * 5 + 2)
 
    CLS
 
    PaintBackground
 
    PaintStars
 
    PaintFleet
 
    FOR it = 0 TO speed
 
        GetInput
 
        Player
 
        Computer
 
    NEXT
 
    _DISPLAY
 
WEND
 
SYSTEM
 
SUB Computer
 
    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
 
        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
 
        dis = 0
        hid = 0
        FOR j = 1 TO 6
            IF j <> id THEN
                IF hate(id, j) > dis THEN
                    dis = hate(id, j)
                    hid = j
                END IF
            END IF
        NEXT
 
        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).d > 0 THEN
                            star(j).d = star(j).d - 1
                        ELSE
                            IF star(j).o = hid THEN th = 3 ELSE th = 4
                            IF star(j).o <> id AND star(i).t > star(j).t * th THEN
                                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
                                        away = dist
                                        jay = j
                                    END IF
                                END IF
                            END IF
                        END IF
                    NEXT
                    IF jay < 100 THEN
                        SendFleet i, jay, star(i).t / 1.6
                        star(jay).d = 1000
                    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 = 1000
                    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 > LL / 2 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 <= 350 * ratio THEN
                                        ok = 0
                                        EXIT FOR
                                    END IF
                                END IF
                            NEXT
                            IF ok = 1 THEN
                                SendFleet i, home(id), star(i).t / 2
                                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
 
        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
                            SendFleet dest, home(o), star(dest).t * 0.9
                            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 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
 
        x = _MOUSEX
        y = _MOUSEY
        lmb = _MOUSEBUTTON(1)
        rmb = _MOUSEBUTTON(2)
 
        IF lmb AND lcx = sw THEN lcx = x
        IF rmb AND rcx = sw THEN rcx = x
    WEND
 
    IF lmb = 0 AND lcx < sw THEN lclk = 1
    IF rmb = 0 AND rcx < sw THEN rclk = 1
 
    lcx = sw
    rcx = sw
 
    x = _MOUSEX
    y = _MOUSEY
 
    IF rclk = 1 THEN
        i = Identify
        IF i = 100 THEN
            IF src = 100 THEN
                paused = 1 - paused
                ch = ""
            ELSE
                src = 100
                oact = 0
                pact = 0
            END IF
            rclk = 0
        END IF
        IF pact = 1 OR oact = 1 THEN
            rclk = 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
    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
 
    '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
 
    IF pact = 0 AND oact = 0 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = Identify
            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 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)
        FOR j = 0 TO 7
            qhate(i, j) = hate(i, j)
        NEXT
    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)
        FOR j = 0 TO 7
            hate(i, j) = qhate(i, j)
        NEXT
    NEXT
    fltcnt = qfltcnt
    LL = qLL
    paused = 1
END SUB
 
SUB SendFleet (src, dst, ships)
    IF fltcnt < 2000 THEN
        hate(star(src).o, star(dst).o) = hate(star(src).o, star(dst).o) + 1
        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 fleet(i).o > 1 AND LL < 10000 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 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 = 25
    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
 

Title: Re: Beyond Sol
Post by: romichess on January 06, 2020, 02:57:41 am

It was too easy to hit the "r" by mistake when pressing the "t". So the above source was edited to "l" for Quick Load but now it is next to the "p" for pause. SO if it is a problem then just change it to anything best for you before compiling. It is in get input. The subroutines are alphabetized.

Title: Re: Beyond Sol
Post by: dajan on January 06, 2020, 11:47:22 am

If the "Beyond Sol" is already taken, just name it "Beyond two Sols".

Title: Re: Beyond Sol
Post by: SMcNeill on January 06, 2020, 11:58:28 am

Quote from: dajan on January 06, 2020, 11:47:22 am

If the "Beyond Sol" is already taken, just name it "Beyond two Sols".

I like, "Beyond The Beyond!!!"

Title: Re: Beyond Sol
Post by: romichess on January 06, 2020, 09:34:01 pm

Very cool names, but you can only help name the game if you play it! :)

Title: Re: Beyond Sol
Post by: Kazman on January 07, 2020, 04:30:04 am

"Beyond Stars", maybe? ;)

Title: Re: Beyond Sol
Post by: Cobalt on January 07, 2020, 11:31:25 am

Quote from: SMcNeill on January 06, 2020, 11:58:28 am

I like, "Beyond The Beyond!!!"

made me think of this...
"From the land beyond beyond.
From the world past hope and fear.
I bid you, genie, now appear."

Anyway, how about "QB64 Beyond Sol!" ?

Title: Re: Beyond Sol
Post by: romichess on January 07, 2020, 11:57:03 am

If I add a QB64 star, it can be called Master of QB64! Whoever takes QB64 first wins the game. But beware it will be protected by a powerful starbase. "Beyond the Stars", maybe? I don't think people here would like, "Beyond QB64". Or maybe just, "The Beyond". Or, "Yonder Star".

Title: Re: Beyond Sol
Post by: Kazman on January 14, 2020, 08:07:33 am

Any game update news? Me want !!! :P

I like "Beyond the stars" :)

Title: Re: Beyond Sol
Post by: romichess on January 14, 2020, 12:41:12 pm

Quote from: Kazman on January 14, 2020, 08:07:33 am

Any game update news? Me want !!! :P

I like "Beyond the stars" :)

Thanks Kazman! Yes, Beyond the Stars seems pretty good. It was really your suggestion anyway. All I did was add the, "the". I do have an updated version. Except, I have not added the game menu yet like I said I was going to do. I've not been feeling very well and I'm a bit burned out. However, for my game's only fan I will load up on caffeine and work on it today. And here is the latest version. The computer's playing AI is finalized for the alpha version. As always if the human gets off to a good start the game is easy but maybe not as easy. And if one of the computer players gets off to a good start then it can be a real bear. The only cosmetic change is that now the stars paint over the standing order lines and therefore the lines only go to the edge of the star. I have to say that if it weren't for your support I'd have stopped working on it by now!

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 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 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
 
sp = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
op = _NEWIMAGE(400 * ratio, 225 * ratio, 256)
 
StarNames '                            Routine to load star names into string array stars(200)
 
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 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
        i = Identify
        IF i = 100 THEN
            IF src = 100 THEN
                paused = 1 - paused
                ch = ""
            ELSE
                src = 100
                oact = 0
                pact = 0
            END IF
            rclk = 0
        END IF
        IF pact = 1 OR oact = 1 THEN
            rclk = 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 THEN
 
        'If there is no source star see if we can get one
        IF src = 100 THEN
            IF lclk = 1 OR rclk = 1 THEN
                lclk = 0
                rclk = 0
                src = Identify
            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 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 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 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
 
 

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: romichess on December 08, 2019, 07:04:46 am