Author Topic: Beyond Sol (Read 16208 times)

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
 
 
 
 
 
 
 
 
 
 

OldMoses · « **Reply #1 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.

Petr · « **Reply #2 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.

romichess · « **Reply #3 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.

romichess · « **Reply #4 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
 
 
 
 
 
 
 
 
 
 

OldMoses · « **Reply #5 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.

romichess · « **Reply #6 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
 

Cobalt · « **Reply #7 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?

romichess · « **Reply #8 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.

Cobalt · « **Reply #9 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".

romichess · « **Reply #10 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.

Petr · « **Reply #11 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!

romichess · « **Reply #12 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.

romichess · « **Reply #13 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
 

romichess · « **Reply #14 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
 

News:

Author Topic: Beyond Sol (Read 16208 times)

romichess

Beyond Sol

OldMoses

Re: Beyond Sol

Petr

Re: Beyond Sol

romichess

Re: Beyond Sol

romichess

Re: Beyond Sol

OldMoses

Re: Beyond Sol

romichess

Re: Beyond Sol

Cobalt

Re: Beyond Sol

romichess

Re: Beyond Sol

Cobalt

Re: Beyond Sol

romichess

Re: Beyond Sol

Petr

Re: Beyond Sol

romichess

Re: Beyond Sol

romichess

Re: Beyond Sol

romichess

Re: Beyond Sol