« previous next »
Pages: 1 [2]   Go Down

Author Topic: MOO  (Read 7231 times)

0 Members and 1 Guest are viewing this topic.

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #15 on: December 05, 2019, 05:34:32 pm »
Quote from: bplus on December 05, 2019, 04:26:46 pm
Hi Mike,

Quick tip, in Toolbox board there is a really nice circle fill routine you might want to pickup, first entry I think.

Cool!
Logged
My name is Michael, but you can call me Mike :)

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: MOO
« Reply #16 on: December 06, 2019, 08:14:02 am »
Fine!
please say me
what is the conceptual difference between star showed as a voide circle and star showed as a full colored circle?

it is not necessary but I must note that
Code: QB64: [Select]
  1. DECLARE SUB NewGame
  2. DECLARE SUB PaintStars
  3. DECLARE SUB StarNames
  4. DECLARE SUB ShowPanel (i)
  5. DECLARE SUB Identify (x, y)
  6. DECLARE SUB PaintBackground
  7. DECLARE SUB GetInput
  8.  
  9.  
are declaration of subprograms need in QB4.5 QBASIC and QB PDS
for QB64 you can  change the code into this one
Code: QB64: [Select]
  1. 'DECLARE SUB NewGame
  2. 'DECLARE SUB PaintStars
  3. 'DECLARE SUB StarNames
  4. 'DECLARE SUB ShowPanel (i)
  5. 'DECLARE SUB Identify (x, y)
  6. 'DECLARE SUB PaintBackground
  7. 'DECLARE SUB GetInput
  8.  
  9.  
as you can read here http://www.qb64.org/wiki/DECLARE

PS Welcome to QB64 forum!
Logged
Programming isn't difficult, only it's  consuming time and coffee

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #17 on: December 06, 2019, 10:15:04 am »
Quote from: TempodiBasic on December 06, 2019, 08:14:02 am
Fine!
please say me
what is the conceptual difference between star showed as a voide circle and star showed as a full colored circle?

it is not necessary but I must note that
Code: QB64: [Select]
  1. DECLARE SUB NewGame
  2. DECLARE SUB PaintStars
  3. DECLARE SUB StarNames
  4. DECLARE SUB ShowPanel (i)
  5. DECLARE SUB Identify (x, y)
  6. DECLARE SUB PaintBackground
  7. DECLARE SUB GetInput
  8.  
  9.  
are declaration of subprograms need in QB4.5 QBASIC and QB PDS
for QB64 you can  change the code into this one
Code: QB64: [Select]
  1. 'DECLARE SUB NewGame
  2. 'DECLARE SUB PaintStars
  3. 'DECLARE SUB StarNames
  4. 'DECLARE SUB ShowPanel (i)
  5. 'DECLARE SUB Identify (x, y)
  6. 'DECLARE SUB PaintBackground
  7. 'DECLARE SUB GetInput
  8.  
  9.  
as you can read here http://www.qb64.org/wiki/DECLARE

PS Welcome to QB64 forum!

Thanks, glad to be here. A painted circle is one of the six players. The human player for now always plays from Sol.
« Last Edit: December 06, 2019, 10:21:44 am by romichess »
Logged
My name is Michael, but you can call me Mike :)

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: MOO
« Reply #18 on: December 06, 2019, 12:02:10 pm »
It looks like there are a few black holes in your star field. ;) Name boxes pop up where I don't see anything.

Welcome to the forum.

Logged

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #19 on: December 06, 2019, 02:41:49 pm »
Quote from: OldMoses on December 06, 2019, 12:02:10 pm
It looks like there are a few black holes in your star field. ;) Name boxes pop up where I don't see anything.

Welcome to the forum.

Thanks! That should have been fixed a couple of post ago. I'm about to make a new post and I'll make sure it does not do that anymore. Hmm, maybe a few cloaked planets is not a bad idea. The mouse did detect them by the way as they were there but painted black, lol.
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #20 on: December 06, 2019, 03:19:58 pm »
I have decided to code the simplest space game possible just to have a game and not just some example code. Then I was reminded of a game that I used to play on my Atari 800 around 1984. It was a text screen space conquest game that used 40 characters, A thru z and the symbols above the numbers. Each turn every planet produced a number of ships. The players played by the hot seat style and there were no computer players. Each turn a player could send ships to another planet either friendly or hostile. It was a very simple yet fun game. So first I'll aim for something close to that.

I'm old and my eyes are not the greatest. Just a short while ago I noticed the cyberbit.ttf font that comes with QB64. So I switched to that font. It would have saved me a lot of time had I seen it sooner.

Now hitting 't' toggles between the name and the number of ships printed under the star. Trying to print both introduced noticeable lag. Printing must be very expensive. Now I'm wondering if QB64 will be fast enough. I suppose that the frame rate can be reduced to compensate.

Code: QB64: [Select]
  1. TYPE stars
  2.     n AS STRING * 10 '                 Name of star
  3.     x AS INTEGER '                     x-position
  4.     y AS INTEGER '                     y-position
  5.     o AS INTEGER '                     Owner
  6.     c AS INTEGER '                     Color
  7.     s AS INTEGER '                     Size
  8.     t AS INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
  9.     p AS INTEGER '                     (Population) For now ships produced per turn
  11.  
  12. 'DECLARE SUB NewGame
  13. 'DECLARE SUB PaintStars
  14. 'DECLARE SUB StarNames
  15. 'DECLARE SUB ShowPanel (i)
  16. 'DECLARE SUB Identify (x, y)
  17. 'DECLARE SUB PaintBackground
  18. 'DECLARE SUB GetInput
  19.  
  20. ' Global variables shared because they are needed in more than one routine
  21. DIM SHARED sw AS INTEGER '             Screen Width
  22. DIM SHARED sh AS INTEGER '             Screen Height
  23. DIM SHARED sww AS INTEGER '            Screen Width Wide margin
  24. DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
  25. DIM SHARED shw AS INTEGER '            Screen Height Wide margine
  26. DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
  27. DIM SHARED nw AS INTEGER '             games Natural screen Width
  28. DIM SHARED nh AS INTEGER '             games Natural screen Height
  29. DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
  30. DIM SHARED star(100) AS stars '        100 stars - may change
  31. DIM SHARED names(200) AS STRING * 10 ' 200 star names
  32. DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
  33. DIM SHARED home(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
  34. DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
  49. DIM SHARED ch AS STRING * 1 '          Game loop key input variable
  50. DIM SHARED repeat AS INTEGER '         Game loop control variable
  53.  
  54. sw = _DESKTOPWIDTH '                   native video with of syatem
  55. sww = sw / 24 '                        margin based on native video width to keep stars away from edge
  56. swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
  57. nw = 1920
  58.  
  59. ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
  60.  
  62. shw = sh / 20
  63. shn = sh / 40
  64. nh = 1080
  65.  
  66. tt = 0
  67. cx = sw
  68. cp = 100
  69. h = 100
  70. ar = 0
  71.  
  72. SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
  73.  
  75.  
  76. ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
  77.  
  78. StarNames '                            Routine to load star names into string array stars(200)
  79.  
  80. NewGame
  81.  
  82. ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
  83. ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
  84.  
  85. repeat = 1
  86.  
  87. WHILE repeat
  88.  
  89.     _LIMIT 60 '                        Set to 60 frames per second
  90.  
  91.     CLS
  92.  
  93.     PaintBackground
  94.  
  95.     PaintStars
  96.  
  97.     GetInput
  98.  
  99.     Identify x, y '                    Identify star mouse is over if any
  100.  
  101.     computer
  102.  
  103.     _DISPLAY
  104.  
  106.  
  108.  
  109. SUB computer
  111.     FOR i = 0 TO 99
  112.         r = INT(RND * 120)
  113.         IF r < star(i).p THEN star(i).t = star(i).t + 1
  114.     NEXT
  116.  
  117. SUB GetInput
  118.  
  119.     ch = INKEY$
  120.     IF ch = CHR$(27) THEN repeat = 0
  121.     IF ch = "n" THEN NewGame
  122.     IF ch = "t" THEN tt = 1 - tt
  123.     ch = ""
  124.  
  125.     WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
  126.  
  127.     x = _MOUSEX
  128.     y = _MOUSEY
  129.     mb = _MOUSEBUTTON(1)
  130.     clk = 0
  131.  
  132.     IF mb = -1 AND cx = sw THEN
  133.         cx = x
  134.         cy = y
  135.     END IF
  136.  
  137.     IF mb = 0 AND cx < sw THEN
  138.         IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
  139.             clk = 1
  140.         END IF
  141.         cx = sw
  142.     END IF
  144.  
  145. SUB PaintBackground
  147.     x = RND * sw
  148.     y = RND * sh
  149.     c = RND * 14 + 1
  150.     PSET (x, y), c
  151.     RANDOMIZE USING seed
  152.     FOR i = 1 TO 600 * ratio
  153.         x = RND * sw
  154.         y = RND * sh
  155.         c = RND * 14 + 1
  156.         PSET (x, y), c
  157.     NEXT
  159.  
  160. SUB ProcessPanel
  161.  
  163.  
  164. SUB Identify (x, y)
  165.     IF ar = 1 THEN
  166.         ShowPanel h
  167.         IF clk THEN
  168.             IF x >= x1 AND x <= x2 AND y >= y1 AND y <= y2 THEN
  169.                 ProcessPanel
  170.             ELSE
  171.                 ar = 0
  172.             END IF
  173.         END IF
  174.     END IF
  175.     IF ar = 0 THEN
  176.         FOR i = 0 TO 99
  177.             dx = star(i).x - x
  178.             dy = star(i).y - y
  179.             IF ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
  180.                 ShowPanel i
  181.                 IF clk THEN
  182.                     clk = 0
  183.                     h = i
  184.                     ar = 1
  185.                     ax = x
  186.                 END IF
  187.             END IF
  188.         NEXT
  189.     END IF
  191.  
  192. SUB ShowPanel (i)
  193.     x1 = star(i).x - 420 * ratio
  194.     IF star(i).x < sw / 2 THEN x1 = star(i).x + 20
  195.     x2 = x1 + 400 * ratio
  196.     y1 = star(i).y
  197.     IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
  198.     y2 = y1 + 540 * ratio
  199.     _DEST ps
  200.     CLS 0, 8
  201.     COLOR 0, 8
  202.     _FONT ttf2
  203.     n$ = RTRIM$(star(i).n)
  204.     l = _PRINTWIDTH(n$)
  205.     _PRINTSTRING ((400 - l) / 2, 8), n$, ps
  206.     _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
  207.     _DEST 0
  209.  
  210. SUB PaintStars
  211.     FOR i = 0 TO 99
  212.         c = star(i).c
  213.         x = star(i).x
  214.         y = star(i).y
  215.         o = star(i).o
  216.         CIRCLE (x, y), (star(i).s + 6) * ratio, c
  217.         COLOR 15
  218.         IF o > 0 THEN
  219.             PAINT (x, y), o + 8, c
  220.             COLOR o + 8
  221.         END IF
  222.         _FONT ttf1
  223.         IF tt THEN
  224.             n$ = star(i).n
  225.             n$ = RTRIM$(n$)
  226.             l = _PRINTWIDTH(n$)
  227.         ELSE
  228.             n$ = STR$(star(i).t)
  229.             l = _PRINTWIDTH(n$)
  230.         END IF
  231.         _PRINTSTRING (x - l / 2, y + 12), n$, 0
  232.     NEXT
  234.  
  235. SUB NewGame
  236.     DIM k AS INTEGER
  237.     DIM r AS INTEGER
  238.     DIM dx AS INTEGER
  239.     DIM dy AS INTEGER
  240.     DIM n AS STRING * 10
  242.     seed = RND * 1000
  243.     star(0).n = "Sol"
  244.     star(0).x = RND * (sw - sww) + swn
  245.     star(0).y = RND * (sh - shw) + shn
  246.     star(0).c = 14
  247.     star(0).s = 2
  248.     star(0).o = 1
  249.     star(0).p = 10
  250.     star(0).t = 100
  251.     home(0) = 0
  252.     FOR i = 1 TO 99
  253.         k = 1
  254.         WHILE k
  255.             k = 0
  256.             x = RND * (sw - sww) + swn
  257.             y = RND * (sh - shw) + shn
  258.             r = INT(RND * 200)
  259.             n = names(r)
  260.             FOR j = 0 TO i - 1
  261.                 dx = x - star(j).x
  262.                 dy = y - star(j).y
  263.                 IF ABS(dx) < sww AND ABS(dy) < shw THEN
  264.                     k = 1
  265.                 END IF
  266.                 IF n = star(j).n THEN
  267.                     k = 1
  268.                 END IF
  269.             NEXT
  270.         WEND
  271.         star(i).n = n
  272.         star(i).x = x
  273.         star(i).y = y
  274.         star(i).c = RND * 6 + 9
  275.         star(i).s = RND * 5
  276.         star(i).o = 0
  277.         star(i).p = star(i).s + (RND * 8) + 1
  278.         star(i).t = 0
  279.     NEXT
  280.     FOR i = 2 TO 6
  281.         k = 1
  282.         WHILE k
  283.             k = 0
  284.             r = RND * 100
  285.             FOR j = 1 TO i - 1
  286.                 IF r = home(j) THEN k = 1
  287.                 x = star(0).x
  288.                 y = star(0).y
  289.                 dx = ABS(star(r).x - x)
  290.                 dy = ABS(star(r).y - y)
  291.                 IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
  292.             NEXT
  293.         WEND
  294.         home(i) = r
  295.         star(r).o = i
  296.         star(r).p = 10
  297.         star(r).t = 100
  298.     NEXT
  300.  
  301. ' A lot of star names I made up
  302.  
  303. SUB StarNames
  304.     names(0) = "Acamar"
  305.     names(1) = "Arcab"
  306.     names(2) = "Acrux"
  307.     names(3) = "Adhara"
  308.     names(4) = "Arneb"
  309.     names(5) = "Antares"
  310.     names(6) = "Arcturus"
  311.     names(7) = "Atria"
  312.     names(8) = "Beid"
  313.     names(9) = "Betelgeuse"
  314.     names(10) = "Botein"
  315.     names(11) = "Beemim"
  316.     names(12) = "Bellatrix"
  317.     names(13) = "Bharani"
  318.     names(14) = "Biham"
  319.     names(15) = "Brachium"
  320.     names(16) = "Canopus"
  321.     names(17) = "Capella"
  322.     names(18) = "Castor"
  323.     names(19) = "Chara"
  324.     names(20) = "Cursa"
  325.     names(21) = "Copernicus"
  326.     names(22) = "Chalawan"
  327.     names(23) = "Chertan"
  328.     names(24) = "Dabih"
  329.     names(25) = "Dalim"
  330.     names(26) = "Deneb"
  331.     names(27) = "Denebola"
  332.     names(28) = "Diadem"
  333.     names(29) = "Diphda"
  334.     names(30) = "Dschubba"
  335.     names(31) = "Dziban"
  336.     names(32) = "Edasich"
  337.     names(33) = "Electra"
  338.     names(34) = "Elgafar"
  339.     names(35) = "Elkurud"
  340.     names(36) = "Elnath"
  341.     names(37) = "Eltanin"
  342.     names(38) = "Enif"
  343.     names(39) = "Errai"
  344.     names(40) = "Fafnir"
  345.     names(41) = "Fang"
  346.     names(42) = "Fawaris"
  347.     names(43) = "Felis"
  348.     names(44) = "Fomalhaut"
  349.     names(45) = "Fulu"
  350.     names(46) = "Fumal"
  351.     names(47) = "Furud"
  352.     names(48) = "Garnet"
  353.     names(49) = "Giausar"
  354.     names(50) = "Gienah"
  355.     names(51) = "Ginan"
  356.     names(52) = "Gomeisa"
  357.     names(53) = "Graffias"
  358.     names(54) = "Grumium"
  359.     names(55) = "Gudja"
  360.     names(56) = "Hadar"
  361.     names(57) = "Haedus"
  362.     names(58) = "Hamal"
  363.     names(59) = "Hassaleh"
  364.     names(60) = "Hatysa"
  365.     names(61) = "Helvetios"
  366.     names(62) = "Heze"
  367.     names(63) = "Homan"
  368.     names(64) = "Iklil"
  369.     names(65) = "Imai"
  370.     names(66) = "Intercrus"
  371.     names(67) = "Izar"
  372.     names(68) = "Iccar"
  373.     names(69) = "Inar"
  374.     names(70) = "Iaeth"
  375.     names(71) = "Imaous"
  376.     names(72) = "Jabbah"
  377.     names(73) = "Jishui"
  378.     names(74) = "Jax"
  379.     names(75) = "Jalae"
  380.     names(76) = "Jewel"
  381.     names(77) = "Jumbo"
  382.     names(78) = "Jerue"
  383.     names(79) = "Jabear"
  384.     names(80) = "Kakkab"
  385.     names(81) = "Kang"
  386.     names(82) = "Kekouan"
  387.     names(83) = "Keid"
  388.     names(84) = "Kitalpha"
  389.     names(85) = "Kochab"
  390.     names(86) = "Kolob"
  391.     names(87) = "Kobol"
  392.     names(88) = "Larawag"
  393.     names(89) = "Lesath"
  394.     names(90) = "Libertas"
  395.     names(91) = "Lich"
  396.     names(92) = "Lilly"
  397.     names(93) = "Laddel"
  398.     names(94) = "Luminous"
  399.     names(95) = "Lasacious"
  400.     names(96) = "Mizar"
  401.     names(97) = "Markab"
  402.     names(98) = "Matar"
  403.     names(99) = "Mintaka"
  404.     names(100) = "Meleph"
  405.     names(101) = "Menkar"
  406.     names(102) = "Merga"
  407.     names(103) = "Merope"
  408.     names(104) = "Nahn"
  409.     names(105) = "Naos"
  410.     names(106) = "Nashira"
  411.     names(107) = "Navi"
  412.     names(108) = "Nekkar"
  413.     names(109) = "Nembus"
  414.     names(110) = "Nihal"
  415.     names(111) = "Nunki"
  416.     names(112) = "Ogma"
  417.     names(113) = "Okab"
  418.     names(114) = "Ohmy"
  419.     names(115) = "Oragami"
  420.     names(116) = "Origen"
  421.     names(117) = "Omanii"
  422.     names(118) = "Obytewa"
  423.     names(119) = "Oglok"
  424.     names(120) = "Phact"
  425.     names(121) = "Pherkad"
  426.     names(122) = "Pleione"
  427.     names(122) = "Polaris"
  428.     names(123) = "Pollux"
  429.     names(124) = "Procyon"
  430.     names(125) = "Proxima"
  431.     names(126) = "Polis"
  432.     names(127) = "Quaint"
  433.     names(128) = "Quazzat"
  434.     names(129) = "Quetzal"
  435.     names(130) = "Qussol"
  436.     names(131) = "Quella"
  437.     names(132) = "Quyaeo"
  438.     names(133) = "Ququdas"
  439.     names(134) = "Quekak"
  440.     names(135) = "Rasalas"
  441.     names(136) = "Regor"
  442.     names(137) = "Regulus"
  443.     names(138) = "Rigel"
  444.     names(139) = "Revati"
  445.     names(140) = "Rotenev"
  446.     names(141) = "Rukbat"
  447.     names(142) = "Rastaban"
  448.     names(143) = "Sabik"
  449.     names(144) = "Sadr"
  450.     names(145) = "Saiph"
  451.     names(146) = "Sargas"
  452.     names(147) = "Sarin"
  453.     names(148) = "Syrma"
  454.     names(149) = "Spica"
  455.     names(150) = "Sirius"
  456.     names(151) = "Tarazed"
  457.     names(152) = "Taygeta"
  458.     names(153) = "Tejat"
  459.     names(154) = "Thabit"
  460.     names(155) = "Thuban"
  461.     names(156) = "Tiaki"
  462.     names(157) = "Toliman"
  463.     names(158) = "Torcular"
  464.     names(157) = "Umala"
  465.     names(158) = "Ulatte"
  466.     names(159) = "Ubbessa"
  467.     names(160) = "Unoless"
  468.     names(161) = "Umaddem"
  469.     names(162) = "Ummbra"
  470.     names(162) = "Uniqu"
  471.     names(163) = "Uzzaal"
  472.     names(164) = "Vega"
  473.     names(165) = "Veritate"
  474.     names(166) = "Vindetrix"
  475.     names(167) = "Vedas"
  476.     names(168) = "Vergg"
  477.     names(169) = "Vacant"
  478.     names(170) = "Vucae"
  479.     names(171) = "Vicar"
  480.     names(172) = "Wasat"
  481.     names(173) = "Wazn"
  482.     names(174) = "Wezen"
  483.     names(175) = "Waiten"
  484.     names(176) = "Wachar"
  485.     names(177) = "Wheelz"
  486.     names(178) = "Whatsp"
  487.     names(179) = "Wassand"
  488.     names(180) = "Xenno"
  489.     names(181) = "Xyphod"
  490.     names(182) = "Xu"
  491.     names(183) = "Xaal"
  492.     names(184) = "Xyross"
  493.     names(185) = "Xiggot"
  494.     names(186) = "Xirrks"
  495.     names(187) = "Yed"
  496.     names(188) = "Yildun"
  497.     names(189) = "Yundun"
  498.     names(190) = "Yavyo"
  499.     names(191) = "Yotrac"
  500.     names(192) = "Yxzoqu"
  501.     names(193) = "Ynnot"
  502.     names(194) = "Zaniah"
  503.     names(195) = "Zaurak"
  504.     names(196) = "Zhang"
  505.     names(197) = "Zibal"
  506.     names(198) = "Zosma"
  507.     names(199) = "Zuben"
  509.  
  510.  
  511.  
  512.  
  513.  
  514.  
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #21 on: December 06, 2019, 11:58:31 pm »
I did not get to work on my game today as much as I would have liked. But I id get it to the level of demo, :), at least. It is not a game yet or even a simulation as the A.I. if one wants to call it that is way too rudimentary. My goal for today was just to verify the mechanics and that seems to have been a success.

Code: QB64: [Select]
  1. TYPE stars
  2.     n AS STRING * 10 '                 Name of star
  3.     x AS INTEGER '                     x-position
  4.     y AS INTEGER '                     y-position
  5.     o AS INTEGER '                     Owner
  6.     c AS INTEGER '                     Color
  7.     s AS INTEGER '                     Size
  8.     t AS INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
  9.     p AS INTEGER '                     (Population) For now ships produced per turn
  11.  
  12. TYPE FLEETS
  13.     n AS INTEGER
  14.     x1 AS INTEGER
  15.     y1 AS INTEGER
  16.     x2 AS INTEGER
  17.     y2 AS INTEGER
  18.     o AS INTEGER
  19.     d AS INTEGER
  21.  
  22. 'DECLARE SUB NewGame
  23. 'DECLARE SUB PaintStars
  24. 'DECLARE SUB StarNames
  25. 'DECLARE SUB ShowPanel (i)
  26. 'DECLARE SUB Identify (x, y)
  27. 'DECLARE SUB PaintBackground
  28. 'DECLARE SUB GetInput
  29.  
  30. ' Global variables shared because they are needed in more than one routine
  31. DIM SHARED sw AS INTEGER '             Screen Width
  32. DIM SHARED sh AS INTEGER '             Screen Height
  33. DIM SHARED sww AS INTEGER '            Screen Width Wide margin
  34. DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
  35. DIM SHARED shw AS INTEGER '            Screen Height Wide margine
  36. DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
  37. DIM SHARED nw AS INTEGER '             games Natural screen Width
  38. DIM SHARED nh AS INTEGER '             games Natural screen Height
  39. DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
  40. DIM SHARED star(100) AS stars '        100 stars - may change
  41. DIM SHARED names(200) AS STRING * 10 ' 200 star names
  42. DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
  43. DIM SHARED home(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
  44. DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
  59. DIM SHARED ch AS STRING * 1 '          Game loop key input variable
  60. DIM SHARED repeat AS INTEGER '         Game loop control variable
  63. DIM SHARED fleet(1000) AS FLEETS
  65.  
  66. sw = _DESKTOPWIDTH '                   native video with of syatem
  67. sww = sw / 24 '                        margin based on native video width to keep stars away from edge
  68. swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
  69. nw = 1920
  70.  
  71. ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
  72.  
  74. shw = sh / 20
  75. shn = sh / 40
  76. nh = 1080
  77.  
  78. tt = 0
  79. cx = sw
  80. cp = 100
  81. h = 100
  82. ar = 0
  83.  
  84. SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
  85.  
  87.  
  88. ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
  89.  
  90. StarNames '                            Routine to load star names into string array stars(200)
  91.  
  92. NewGame
  93.  
  94. ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
  95. ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
  96.  
  97. repeat = 1
  98.  
  99. WHILE repeat
  100.  
  101.     _LIMIT 30 '                        Set to 60 frames per second
  102.  
  103.     CLS
  104.  
  105.     PaintBackground
  106.  
  107.     PaintStars
  108.  
  109.     PaintFleet
  110.  
  111.     GetInput
  112.  
  113.     Identify x, y '                    Identify star mouse is over if any
  114.  
  115.     computer
  116.  
  117.     _DISPLAY
  118.  
  120.  
  122.  
  123. SUB PaintFleet
  124.     count = fltcnt
  125.     i = 0
  126.     WHILE count
  127.         IF fleet(i).o <> 0 THEN
  128.             CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
  129.             count = count - 1
  130.         END IF
  131.         i = i + 1
  132.     WEND
  134.  
  135. SUB SendFleet (org, dst)
  136.     FOR i = 0 TO 999
  137.         IF fleet(i).o = 0 THEN
  138.             fleet(i).o = star(org).o
  139.             fleet(i).d = dst
  140.             fleet(i).x1 = star(org).x
  141.             fleet(i).y1 = star(org).y
  142.             fleet(i).x2 = star(dst).x
  143.             fleet(i).y2 = star(dst).y
  144.             fleet(i).n = star(org).t / 2
  145.             star(org).t = star(org).t / 2
  146.             fltcnt = fltcnt + 1
  147.             EXIT FOR
  148.         END IF
  149.     NEXT
  151.  
  152. SUB computer
  154.     FOR i = 0 TO 99
  155.         r = INT(RND * 120)
  156.         IF r < star(i).p THEN
  157.             IF star(i).o > 0 THEN
  158.                 star(i).t = star(i).t + 1
  159.             ELSE
  160.                 IF INT(RND * 10) = 0 AND star(i).t < 40 THEN
  161.                     star(i).t = star(i).t + 1
  162.                 END IF
  163.             END IF
  164.         END IF
  165.     NEXT
  166.     num = 0
  167.     FOR i = 1 TO 6
  168.         FOR j = 0 TO 99
  169.             IF star(j).o = i THEN
  170.                 IF star(j).t > num THEN
  171.                     num = star(j).t
  172.                     idx = j
  173.                 END IF
  174.             END IF
  175.         NEXT
  176.         org = idx
  177.         num = 10000
  178.         FOR j = 0 TO 99
  179.             IF star(j).o <> i THEN
  180.                 IF star(j).t < num THEN
  181.                     num = star(j).t
  182.                     idx = j
  183.                 END IF
  184.             END IF
  185.         NEXT
  186.         dst = idx
  187.         IF star(org).t > 100 AND star(org).t > star(dst).t * 2 THEN
  188.             SendFleet org, dst
  189.         END IF
  190.     NEXT
  191.     count = fltcnt
  192.     PRINT fltcnt
  193.     i = 0
  194.     WHILE count
  195.         IF fleet(i).o <> 0 THEN
  196.             count = count - 1
  197.             IF fleet(i).x2 > fleet(i).x1 THEN
  198.                 fleet(i).x1 = fleet(i).x1 + 1
  199.             END IF
  200.             IF fleet(i).x2 < fleet(i).x1 THEN
  201.                 fleet(i).x1 = fleet(i).x1 - 1
  202.             END IF
  203.             IF fleet(i).y2 > fleet(i).y1 THEN
  204.                 fleet(i).y1 = fleet(i).y1 + 1
  205.             END IF
  206.             IF fleet(i).y2 < fleet(i).y1 THEN
  207.                 fleet(i).y1 = fleet(i).y1 - 1
  208.             END IF
  209.             IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
  210.                 dst = fleet(i).d
  211.                 IF star(dst).o = fleet(i).o THEN
  212.                     star(dst).t = star(dst).t + fleet(i).n
  213.                     fleet(i).o = 0
  214.                     fltcnt = fltcnt - 1
  215.                 ELSE
  216.                     star(dst).t = star(dst).t - fleet(i).n
  217.                     IF star(dst).t < 0 THEN
  218.                         star(dst).t = fleet(i).n / 2
  219.                         star(dst).o = fleet(i).o
  220.                     END IF
  221.                     fleet(i).o = 0
  222.                     fltcnt = fltcnt - 1
  223.                 END IF
  224.             END IF
  225.         END IF
  226.         i = i + 1
  227.     WEND
  229.  
  230. SUB GetInput
  231.  
  232.     ch = INKEY$
  233.     IF ch = CHR$(27) THEN repeat = 0
  234.     IF ch = "n" THEN NewGame
  235.     IF ch = "t" THEN tt = 1 - tt
  236.     ch = ""
  237.  
  238.     WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
  239.  
  240.     x = _MOUSEX
  241.     y = _MOUSEY
  242.     mb = _MOUSEBUTTON(1)
  243.     clk = 0
  244.  
  245.     IF mb = -1 AND cx = sw THEN
  246.         cx = x
  247.         cy = y
  248.     END IF
  249.  
  250.     IF mb = 0 AND cx < sw THEN
  251.         IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
  252.             clk = 1
  253.         END IF
  254.         cx = sw
  255.     END IF
  257.  
  258. SUB PaintBackground
  260.     x = RND * sw
  261.     y = RND * sh
  262.     c = RND * 14 + 1
  263.     PSET (x, y), c
  264.     RANDOMIZE USING seed
  265.     FOR i = 1 TO 600 * ratio
  266.         x = RND * sw
  267.         y = RND * sh
  268.         c = RND * 14 + 1
  269.         PSET (x, y), c
  270.     NEXT
  272.  
  273. SUB ProcessPanel
  274.  
  276.  
  277. SUB Identify (x, y)
  278.     IF ar = 1 THEN
  279.         ShowPanel h
  280.         IF clk THEN
  281.             IF x >= x1 AND x <= x2 AND y >= y1 AND y <= y2 THEN
  282.                 ProcessPanel
  283.             ELSE
  284.                 ar = 0
  285.             END IF
  286.         END IF
  287.     END IF
  288.     IF ar = 0 THEN
  289.         FOR i = 0 TO 99
  290.             dx = star(i).x - x
  291.             dy = star(i).y - y
  292.             IF ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
  293.                 ShowPanel i
  294.                 IF clk THEN
  295.                     clk = 0
  296.                     h = i
  297.                     ar = 1
  298.                     ax = x
  299.                 END IF
  300.             END IF
  301.         NEXT
  302.     END IF
  304.  
  305. SUB ShowPanel (i)
  306.     x1 = star(i).x - 420 * ratio
  307.     IF star(i).x < sw / 2 THEN x1 = star(i).x + 20
  308.     x2 = x1 + 400 * ratio
  309.     y1 = star(i).y
  310.     IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
  311.     y2 = y1 + 540 * ratio
  312.     _DEST ps
  313.     CLS 0, 8
  314.     COLOR 0, 8
  315.     _FONT ttf2
  316.     n$ = RTRIM$(star(i).n)
  317.     l = _PRINTWIDTH(n$)
  318.     _PRINTSTRING ((400 - l) / 2, 8), n$, ps
  319.     _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
  320.     _DEST 0
  322.  
  323. SUB PaintStars
  324.     FOR i = 0 TO 99
  325.         c = star(i).c
  326.         x = star(i).x
  327.         y = star(i).y
  328.         o = star(i).o
  329.         CIRCLE (x, y), (star(i).s + 6) * ratio, c
  330.         COLOR 15
  331.         IF o > 0 THEN
  332.             PAINT (x, y), o + 8, c
  333.             COLOR o + 8
  334.         END IF
  335.         _FONT ttf1
  336.         IF tt THEN
  337.             n$ = star(i).n
  338.             n$ = RTRIM$(n$)
  339.             l = _PRINTWIDTH(n$)
  340.         ELSE
  341.             n$ = STR$(star(i).t)
  342.             l = _PRINTWIDTH(n$)
  343.         END IF
  344.         _PRINTSTRING (x - l / 2, y + 12), n$, 0
  345.     NEXT
  347.  
  348. SUB NewGame
  349.     DIM k AS INTEGER
  350.     DIM r AS INTEGER
  351.     DIM dx AS INTEGER
  352.     DIM dy AS INTEGER
  353.     DIM n AS STRING * 10
  354.     FOR i = 0 TO 999
  355.         fleet(i).o = 0
  356.     NEXT
  357.     fltcnt = 0
  359.     seed = RND * 1000
  360.     star(0).n = "Sol"
  361.     star(0).x = RND * (sw - sww) + swn
  362.     star(0).y = RND * (sh - shw) + shn
  363.     star(0).c = 14
  364.     star(0).s = 2
  365.     star(0).o = 1
  366.     star(0).p = 10
  367.     star(0).t = 100
  368.     home(0) = 0
  369.     FOR i = 1 TO 99
  370.         k = 1
  371.         WHILE k
  372.             k = 0
  373.             x = RND * (sw - sww) + swn
  374.             y = RND * (sh - shw) + shn
  375.             r = INT(RND * 200)
  376.             n = names(r)
  377.             FOR j = 0 TO i - 1
  378.                 dx = x - star(j).x
  379.                 dy = y - star(j).y
  380.                 IF ABS(dx) < sww AND ABS(dy) < shw THEN
  381.                     k = 1
  382.                 END IF
  383.                 IF n = star(j).n THEN
  384.                     k = 1
  385.                 END IF
  386.             NEXT
  387.         WEND
  388.         star(i).n = n
  389.         star(i).x = x
  390.         star(i).y = y
  391.         star(i).c = RND * 6 + 9
  392.         star(i).s = RND * 5
  393.         star(i).o = 0
  394.         star(i).p = star(i).s + (RND * 8) + 1
  395.         star(i).t = 0
  396.     NEXT
  397.     FOR i = 2 TO 6
  398.         k = 1
  399.         WHILE k
  400.             k = 0
  401.             r = RND * 100
  402.             FOR j = 1 TO i - 1
  403.                 IF r = home(j) THEN k = 1
  404.                 x = star(0).x
  405.                 y = star(0).y
  406.                 dx = ABS(star(r).x - x)
  407.                 dy = ABS(star(r).y - y)
  408.                 IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
  409.             NEXT
  410.         WEND
  411.         home(i) = r
  412.         star(r).o = i
  413.         star(r).p = 10
  414.         star(r).t = 100
  415.     NEXT
  417.  
  418. ' A lot of star names I made up
  419.  
  420. SUB StarNames
  421.     names(0) = "Acamar"
  422.     names(1) = "Arcab"
  423.     names(2) = "Acrux"
  424.     names(3) = "Adhara"
  425.     names(4) = "Arneb"
  426.     names(5) = "Antares"
  427.     names(6) = "Arcturus"
  428.     names(7) = "Atria"
  429.     names(8) = "Beid"
  430.     names(9) = "Betelgeuse"
  431.     names(10) = "Botein"
  432.     names(11) = "Beemim"
  433.     names(12) = "Bellatrix"
  434.     names(13) = "Bharani"
  435.     names(14) = "Biham"
  436.     names(15) = "Brachium"
  437.     names(16) = "Canopus"
  438.     names(17) = "Capella"
  439.     names(18) = "Castor"
  440.     names(19) = "Chara"
  441.     names(20) = "Cursa"
  442.     names(21) = "Copernicus"
  443.     names(22) = "Chalawan"
  444.     names(23) = "Chertan"
  445.     names(24) = "Dabih"
  446.     names(25) = "Dalim"
  447.     names(26) = "Deneb"
  448.     names(27) = "Denebola"
  449.     names(28) = "Diadem"
  450.     names(29) = "Diphda"
  451.     names(30) = "Dschubba"
  452.     names(31) = "Dziban"
  453.     names(32) = "Edasich"
  454.     names(33) = "Electra"
  455.     names(34) = "Elgafar"
  456.     names(35) = "Elkurud"
  457.     names(36) = "Elnath"
  458.     names(37) = "Eltanin"
  459.     names(38) = "Enif"
  460.     names(39) = "Errai"
  461.     names(40) = "Fafnir"
  462.     names(41) = "Fang"
  463.     names(42) = "Fawaris"
  464.     names(43) = "Felis"
  465.     names(44) = "Fomalhaut"
  466.     names(45) = "Fulu"
  467.     names(46) = "Fumal"
  468.     names(47) = "Furud"
  469.     names(48) = "Garnet"
  470.     names(49) = "Giausar"
  471.     names(50) = "Gienah"
  472.     names(51) = "Ginan"
  473.     names(52) = "Gomeisa"
  474.     names(53) = "Graffias"
  475.     names(54) = "Grumium"
  476.     names(55) = "Gudja"
  477.     names(56) = "Hadar"
  478.     names(57) = "Haedus"
  479.     names(58) = "Hamal"
  480.     names(59) = "Hassaleh"
  481.     names(60) = "Hatysa"
  482.     names(61) = "Helvetios"
  483.     names(62) = "Heze"
  484.     names(63) = "Homan"
  485.     names(64) = "Iklil"
  486.     names(65) = "Imai"
  487.     names(66) = "Intercrus"
  488.     names(67) = "Izar"
  489.     names(68) = "Iccar"
  490.     names(69) = "Inar"
  491.     names(70) = "Iaeth"
  492.     names(71) = "Imaous"
  493.     names(72) = "Jabbah"
  494.     names(73) = "Jishui"
  495.     names(74) = "Jax"
  496.     names(75) = "Jalae"
  497.     names(76) = "Jewel"
  498.     names(77) = "Jumbo"
  499.     names(78) = "Jerue"
  500.     names(79) = "Jabear"
  501.     names(80) = "Kakkab"
  502.     names(81) = "Kang"
  503.     names(82) = "Kekouan"
  504.     names(83) = "Keid"
  505.     names(84) = "Kitalpha"
  506.     names(85) = "Kochab"
  507.     names(86) = "Kolob"
  508.     names(87) = "Kobol"
  509.     names(88) = "Larawag"
  510.     names(89) = "Lesath"
  511.     names(90) = "Libertas"
  512.     names(91) = "Lich"
  513.     names(92) = "Lilly"
  514.     names(93) = "Laddel"
  515.     names(94) = "Luminous"
  516.     names(95) = "Lasacious"
  517.     names(96) = "Mizar"
  518.     names(97) = "Markab"
  519.     names(98) = "Matar"
  520.     names(99) = "Mintaka"
  521.     names(100) = "Meleph"
  522.     names(101) = "Menkar"
  523.     names(102) = "Merga"
  524.     names(103) = "Merope"
  525.     names(104) = "Nahn"
  526.     names(105) = "Naos"
  527.     names(106) = "Nashira"
  528.     names(107) = "Navi"
  529.     names(108) = "Nekkar"
  530.     names(109) = "Nembus"
  531.     names(110) = "Nihal"
  532.     names(111) = "Nunki"
  533.     names(112) = "Ogma"
  534.     names(113) = "Okab"
  535.     names(114) = "Ohmy"
  536.     names(115) = "Oragami"
  537.     names(116) = "Origen"
  538.     names(117) = "Omanii"
  539.     names(118) = "Obytewa"
  540.     names(119) = "Oglok"
  541.     names(120) = "Phact"
  542.     names(121) = "Pherkad"
  543.     names(122) = "Pleione"
  544.     names(122) = "Polaris"
  545.     names(123) = "Pollux"
  546.     names(124) = "Procyon"
  547.     names(125) = "Proxima"
  548.     names(126) = "Polis"
  549.     names(127) = "Quaint"
  550.     names(128) = "Quazzat"
  551.     names(129) = "Quetzal"
  552.     names(130) = "Qussol"
  553.     names(131) = "Quella"
  554.     names(132) = "Quyaeo"
  555.     names(133) = "Ququdas"
  556.     names(134) = "Quekak"
  557.     names(135) = "Rasalas"
  558.     names(136) = "Regor"
  559.     names(137) = "Regulus"
  560.     names(138) = "Rigel"
  561.     names(139) = "Revati"
  562.     names(140) = "Rotenev"
  563.     names(141) = "Rukbat"
  564.     names(142) = "Rastaban"
  565.     names(143) = "Sabik"
  566.     names(144) = "Sadr"
  567.     names(145) = "Saiph"
  568.     names(146) = "Sargas"
  569.     names(147) = "Sarin"
  570.     names(148) = "Syrma"
  571.     names(149) = "Spica"
  572.     names(150) = "Sirius"
  573.     names(151) = "Tarazed"
  574.     names(152) = "Taygeta"
  575.     names(153) = "Tejat"
  576.     names(154) = "Thabit"
  577.     names(155) = "Thuban"
  578.     names(156) = "Tiaki"
  579.     names(157) = "Toliman"
  580.     names(158) = "Torcular"
  581.     names(157) = "Umala"
  582.     names(158) = "Ulatte"
  583.     names(159) = "Ubbessa"
  584.     names(160) = "Unoless"
  585.     names(161) = "Umaddem"
  586.     names(162) = "Ummbra"
  587.     names(162) = "Uniqu"
  588.     names(163) = "Uzzaal"
  589.     names(164) = "Vega"
  590.     names(165) = "Veritate"
  591.     names(166) = "Vindetrix"
  592.     names(167) = "Vedas"
  593.     names(168) = "Vergg"
  594.     names(169) = "Vacant"
  595.     names(170) = "Vucae"
  596.     names(171) = "Vicar"
  597.     names(172) = "Wasat"
  598.     names(173) = "Wazn"
  599.     names(174) = "Wezen"
  600.     names(175) = "Waiten"
  601.     names(176) = "Wachar"
  602.     names(177) = "Wheelz"
  603.     names(178) = "Whatsp"
  604.     names(179) = "Wassand"
  605.     names(180) = "Xenno"
  606.     names(181) = "Xyphod"
  607.     names(182) = "Xu"
  608.     names(183) = "Xaal"
  609.     names(184) = "Xyross"
  610.     names(185) = "Xiggot"
  611.     names(186) = "Xirrks"
  612.     names(187) = "Yed"
  613.     names(188) = "Yildun"
  614.     names(189) = "Yundun"
  615.     names(190) = "Yavyo"
  616.     names(191) = "Yotrac"
  617.     names(192) = "Yxzoqu"
  618.     names(193) = "Ynnot"
  619.     names(194) = "Zaniah"
  620.     names(195) = "Zaurak"
  621.     names(196) = "Zhang"
  622.     names(197) = "Zibal"
  623.     names(198) = "Zosma"
  624.     names(199) = "Zuben"
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #22 on: December 07, 2019, 05:13:32 am »
The A.I. looks good enough now to add a human player.
Code: QB64: [Select]
  1. TYPE stars
  2.     n AS STRING * 10 '                 Name of star
  3.     x AS INTEGER '                     x-position
  4.     y AS INTEGER '                     y-position
  5.     o AS INTEGER '                     Owner
  6.     c AS INTEGER '                     Color
  7.     s AS INTEGER '                     Size
  8.     t AS INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
  9.     p AS INTEGER '                     (Population) For now ships produced per turn
  11.  
  12. TYPE FLEETS
  13.     n AS INTEGER
  14.     x1 AS INTEGER
  15.     y1 AS INTEGER
  16.     x2 AS INTEGER
  17.     y2 AS INTEGER
  18.     o AS INTEGER
  19.     d AS INTEGER
  21.  
  22. 'DECLARE SUB NewGame
  23. 'DECLARE SUB PaintStars
  24. 'DECLARE SUB StarNames
  25. 'DECLARE SUB ShowPanel (i)
  26. 'DECLARE SUB Identify (x, y)
  27. 'DECLARE SUB PaintBackground
  28. 'DECLARE SUB GetInput
  29.  
  30. ' Global variables shared because they are needed in more than one routine
  31. DIM SHARED sw AS INTEGER '             Screen Width
  32. DIM SHARED sh AS INTEGER '             Screen Height
  33. DIM SHARED sww AS INTEGER '            Screen Width Wide margin
  34. DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
  35. DIM SHARED shw AS INTEGER '            Screen Height Wide margine
  36. DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
  37. DIM SHARED nw AS INTEGER '             games Natural screen Width
  38. DIM SHARED nh AS INTEGER '             games Natural screen Height
  39. DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
  40. DIM SHARED star(100) AS stars '        100 stars - may change
  41. DIM SHARED names(200) AS STRING * 10 ' 200 star names
  42. DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
  43. DIM SHARED home(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
  44. DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
  59. DIM SHARED ch AS STRING * 1 '          Game loop key input variable
  60. DIM SHARED repeat AS INTEGER '         Game loop control variable
  63. DIM SHARED fleet(1000) AS FLEETS
  66.  
  67. sw = _DESKTOPWIDTH '                   native video with of syatem
  68. sww = sw / 24 '                        margin based on native video width to keep stars away from edge
  69. swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
  70. nw = 1920
  71.  
  72. ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
  73.  
  75. shw = sh / 20
  76. shn = sh / 40
  77. nh = 1080
  78.  
  79. tt = 0
  80. cx = sw
  81. cp = 100
  82. h = 100
  83. ar = 0
  84.  
  85. SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
  86.  
  88.  
  89. ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
  90.  
  91. StarNames '                            Routine to load star names into string array stars(200)
  92.  
  93. NewGame
  94.  
  95. ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
  96. ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
  97.  
  98. repeat = 1
  99.  
  100. WHILE repeat
  101.  
  102.     _LIMIT 60 '                        Set to 60 frames per second
  103.  
  104.     CLS
  105.  
  106.     PaintBackground
  107.  
  108.     PaintStars
  109.  
  110.     PaintFleet
  111.  
  112.     GetInput
  113.  
  114.     Identify x, y '                    Identify star mouse is over if any
  115.  
  116.     computer
  117.  
  118.     _DISPLAY
  119.  
  121.  
  123.  
  124. SUB PaintFleet
  125.     count = fltcnt
  126.     i = 0
  127.     WHILE count
  128.         IF fleet(i).o <> 0 THEN
  129.             CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
  130.             count = count - 1
  131.         END IF
  132.         i = i + 1
  133.     WEND
  135.  
  136. SUB SendFleet (org, dst)
  137.     FOR i = 0 TO 999
  138.         IF fleet(i).o = 0 THEN
  139.             fleet(i).o = star(org).o
  140.             fleet(i).d = dst
  141.             fleet(i).x1 = star(org).x
  142.             fleet(i).y1 = star(org).y
  143.             fleet(i).x2 = star(dst).x
  144.             fleet(i).y2 = star(dst).y
  145.             fleet(i).n = star(org).t / 2
  146.             star(org).t = star(org).t / 2
  147.             fltcnt = fltcnt + 1
  148.             EXIT FOR
  149.         END IF
  150.     NEXT
  151.     LL = LL + 1
  153.  
  154. SUB computer
  156.     FOR i = 0 TO 99
  157.         r = INT(RND * 120)
  158.         IF r < star(i).p THEN
  159.             IF star(i).o > 0 THEN
  160.                 star(i).t = star(i).t + 1
  161.             ELSE
  162.                 IF INT(RND * 10) = 0 AND star(i).t < 40 THEN
  163.                     star(i).t = star(i).t + 1
  164.                 END IF
  165.             END IF
  166.         END IF
  167.     NEXT
  168.     num = 0
  169.     FOR i = 1 TO 6
  170.         FOR j = 0 TO 99
  171.             IF star(j).o = i THEN
  172.                 IF star(j).t > num THEN
  173.                     num = star(j).t
  174.                     idx = j
  175.                 END IF
  176.             END IF
  177.         NEXT
  178.         org = idx
  179.         num = 10000
  180.         FOR j = 0 TO 99
  181.             IF star(j).o <> i THEN
  182.                 sway = ABS(star(org).x - star(j).x) + ABS(star(org).y - star(j).y)
  183.                 sway = sway / 16
  184.                 IF star(j).t + sway < num THEN
  185.                     num = star(j).t
  186.                     idx = j
  187.                 END IF
  188.             END IF
  189.         NEXT
  190.         dst = idx
  191.         IF star(org).t > 100 AND star(org).t > star(dst).t * 2 AND star(org).t > LL THEN
  192.             SendFleet org, dst
  193.         END IF
  194.     NEXT
  195.     count = fltcnt
  196.     PRINT fltcnt
  197.     i = 0
  198.     WHILE count
  199.         IF fleet(i).o <> 0 THEN
  200.             count = count - 1
  201.             IF fleet(i).x2 > fleet(i).x1 THEN
  202.                 fleet(i).x1 = fleet(i).x1 + 1
  203.             END IF
  204.             IF fleet(i).x2 < fleet(i).x1 THEN
  205.                 fleet(i).x1 = fleet(i).x1 - 1
  206.             END IF
  207.             IF fleet(i).y2 > fleet(i).y1 THEN
  208.                 fleet(i).y1 = fleet(i).y1 + 1
  209.             END IF
  210.             IF fleet(i).y2 < fleet(i).y1 THEN
  211.                 fleet(i).y1 = fleet(i).y1 - 1
  212.             END IF
  213.             IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
  214.                 dst = fleet(i).d
  215.                 IF star(dst).o = fleet(i).o THEN
  216.                     star(dst).t = star(dst).t + fleet(i).n
  217.                     fleet(i).o = 0
  218.                     fltcnt = fltcnt - 1
  219.                 ELSE
  220.                     star(dst).t = star(dst).t - fleet(i).n
  221.                     IF star(dst).t < 0 THEN
  222.                         star(dst).t = fleet(i).n / 2
  223.                         star(dst).o = fleet(i).o
  224.                     END IF
  225.                     fleet(i).o = 0
  226.                     fltcnt = fltcnt - 1
  227.                 END IF
  228.             END IF
  229.         END IF
  230.         i = i + 1
  231.     WEND
  233.  
  234. SUB GetInput
  235.  
  236.     ch = INKEY$
  237.     IF ch = CHR$(27) THEN repeat = 0
  238.     IF ch = "n" THEN NewGame
  239.     IF ch = "t" THEN tt = 1 - tt
  240.     ch = ""
  241.  
  242.     WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
  243.  
  244.     x = _MOUSEX
  245.     y = _MOUSEY
  246.     mb = _MOUSEBUTTON(1)
  247.     clk = 0
  248.  
  249.     IF mb = -1 AND cx = sw THEN
  250.         cx = x
  251.         cy = y
  252.     END IF
  253.  
  254.     IF mb = 0 AND cx < sw THEN
  255.         IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
  256.             clk = 1
  257.         END IF
  258.         cx = sw
  259.     END IF
  261.  
  262. SUB PaintBackground
  264.     x = RND * sw
  265.     y = RND * sh
  266.     c = RND * 14 + 1
  267.     PSET (x, y), c
  268.     RANDOMIZE USING seed
  269.     FOR i = 1 TO 600 * ratio
  270.         x = RND * sw
  271.         y = RND * sh
  272.         c = RND * 14 + 1
  273.         PSET (x, y), c
  274.     NEXT
  276.  
  277. SUB ProcessPanel
  278.  
  280.  
  281. SUB Identify (x, y)
  282.     IF ar = 1 THEN
  283.         ShowPanel h
  284.         IF clk THEN
  285.             IF x >= x1 AND x <= x2 AND y >= y1 AND y <= y2 THEN
  286.                 ProcessPanel
  287.             ELSE
  288.                 ar = 0
  289.             END IF
  290.         END IF
  291.     END IF
  292.     IF ar = 0 THEN
  293.         FOR i = 0 TO 99
  294.             dx = star(i).x - x
  295.             dy = star(i).y - y
  296.             IF ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
  297.                 ShowPanel i
  298.                 IF clk THEN
  299.                     clk = 0
  300.                     h = i
  301.                     ar = 1
  302.                     ax = x
  303.                 END IF
  304.             END IF
  305.         NEXT
  306.     END IF
  308.  
  309. SUB ShowPanel (i)
  310.     x1 = star(i).x - 420 * ratio
  311.     IF star(i).x < sw / 2 THEN x1 = star(i).x + 20
  312.     x2 = x1 + 400 * ratio
  313.     y1 = star(i).y
  314.     IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
  315.     y2 = y1 + 540 * ratio
  316.     _DEST ps
  317.     CLS 0, 8
  318.     COLOR 0, 8
  319.     _FONT ttf2
  320.     n$ = RTRIM$(star(i).n)
  321.     L = _PRINTWIDTH(n$)
  322.     _PRINTSTRING ((400 - L) / 2, 8), n$, ps
  323.     _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
  324.     _DEST 0
  326.  
  327. SUB PaintStars
  328.     FOR i = 0 TO 99
  329.         c = star(i).c
  330.         x = star(i).x
  331.         y = star(i).y
  332.         o = star(i).o
  333.         CIRCLE (x, y), (star(i).s + 6) * ratio, c
  334.         COLOR 15
  335.         IF o > 0 THEN
  336.             PAINT (x, y), o + 8, c
  337.             COLOR o + 8
  338.         END IF
  339.         _FONT ttf1
  340.         IF tt THEN
  341.             n$ = star(i).n
  342.             n$ = RTRIM$(n$)
  343.             L = _PRINTWIDTH(n$)
  344.         ELSE
  345.             n$ = STR$(star(i).t)
  346.             L = _PRINTWIDTH(n$)
  347.         END IF
  348.         _PRINTSTRING (x - L / 2, y + 12), n$, 0
  349.     NEXT
  351.  
  352. SUB NewGame
  353.     DIM k AS INTEGER
  354.     DIM r AS INTEGER
  355.     DIM dx AS INTEGER
  356.     DIM dy AS INTEGER
  357.     DIM n AS STRING * 10
  358.     FOR i = 0 TO 999
  359.         fleet(i).o = 0
  360.     NEXT
  361.     fltcnt = 0
  363.     seed = RND * 1000
  364.     star(0).n = "Sol"
  365.     star(0).x = RND * (sw - sww) + swn
  366.     star(0).y = RND * (sh - shw) + shn
  367.     star(0).c = 14
  368.     star(0).s = 2
  369.     star(0).o = 1
  370.     star(0).p = 10
  371.     star(0).t = 100
  372.     home(0) = 0
  373.     FOR i = 1 TO 99
  374.         k = 1
  375.         WHILE k
  376.             k = 0
  377.             x = RND * (sw - sww) + swn
  378.             y = RND * (sh - shw) + shn
  379.             r = INT(RND * 200)
  380.             n = names(r)
  381.             FOR j = 0 TO i - 1
  382.                 dx = x - star(j).x
  383.                 dy = y - star(j).y
  384.                 IF ABS(dx) < sww AND ABS(dy) < shw THEN
  385.                     k = 1
  386.                 END IF
  387.                 IF n = star(j).n THEN
  388.                     k = 1
  389.                 END IF
  390.             NEXT
  391.         WEND
  392.         star(i).n = n
  393.         star(i).x = x
  394.         star(i).y = y
  395.         star(i).c = RND * 6 + 9
  396.         star(i).s = RND * 5
  397.         star(i).o = 0
  398.         star(i).p = star(i).s + (RND * 8) + 1
  399.         star(i).t = 0
  400.     NEXT
  401.     FOR i = 2 TO 6
  402.         k = 1
  403.         WHILE k
  404.             k = 0
  405.             r = RND * 100
  406.             FOR j = 1 TO i - 1
  407.                 IF r = home(j) THEN k = 1
  408.                 x = star(0).x
  409.                 y = star(0).y
  410.                 dx = ABS(star(r).x - x)
  411.                 dy = ABS(star(r).y - y)
  412.                 IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
  413.             NEXT
  414.         WEND
  415.         home(i) = r
  416.         star(r).o = i
  417.         star(r).p = 10
  418.         star(r).t = 100
  419.     NEXT
  421.  
  422. ' A lot of star names I made up
  423.  
  424. SUB StarNames
  425.     names(0) = "Acamar"
  426.     names(1) = "Arcab"
  427.     names(2) = "Acrux"
  428.     names(3) = "Adhara"
  429.     names(4) = "Arneb"
  430.     names(5) = "Antares"
  431.     names(6) = "Arcturus"
  432.     names(7) = "Atria"
  433.     names(8) = "Beid"
  434.     names(9) = "Betelgeuse"
  435.     names(10) = "Botein"
  436.     names(11) = "Beemim"
  437.     names(12) = "Bellatrix"
  438.     names(13) = "Bharani"
  439.     names(14) = "Biham"
  440.     names(15) = "Brachium"
  441.     names(16) = "Canopus"
  442.     names(17) = "Capella"
  443.     names(18) = "Castor"
  444.     names(19) = "Chara"
  445.     names(20) = "Cursa"
  446.     names(21) = "Copernicus"
  447.     names(22) = "Chalawan"
  448.     names(23) = "Chertan"
  449.     names(24) = "Dabih"
  450.     names(25) = "Dalim"
  451.     names(26) = "Deneb"
  452.     names(27) = "Denebola"
  453.     names(28) = "Diadem"
  454.     names(29) = "Diphda"
  455.     names(30) = "Dschubba"
  456.     names(31) = "Dziban"
  457.     names(32) = "Edasich"
  458.     names(33) = "Electra"
  459.     names(34) = "Elgafar"
  460.     names(35) = "Elkurud"
  461.     names(36) = "Elnath"
  462.     names(37) = "Eltanin"
  463.     names(38) = "Enif"
  464.     names(39) = "Errai"
  465.     names(40) = "Fafnir"
  466.     names(41) = "Fang"
  467.     names(42) = "Fawaris"
  468.     names(43) = "Felis"
  469.     names(44) = "Fomalhaut"
  470.     names(45) = "Fulu"
  471.     names(46) = "Fumal"
  472.     names(47) = "Furud"
  473.     names(48) = "Garnet"
  474.     names(49) = "Giausar"
  475.     names(50) = "Gienah"
  476.     names(51) = "Ginan"
  477.     names(52) = "Gomeisa"
  478.     names(53) = "Graffias"
  479.     names(54) = "Grumium"
  480.     names(55) = "Gudja"
  481.     names(56) = "Hadar"
  482.     names(57) = "Haedus"
  483.     names(58) = "Hamal"
  484.     names(59) = "Hassaleh"
  485.     names(60) = "Hatysa"
  486.     names(61) = "Helvetios"
  487.     names(62) = "Heze"
  488.     names(63) = "Homan"
  489.     names(64) = "Iklil"
  490.     names(65) = "Imai"
  491.     names(66) = "Intercrus"
  492.     names(67) = "Izar"
  493.     names(68) = "Iccar"
  494.     names(69) = "Inar"
  495.     names(70) = "Iaeth"
  496.     names(71) = "Imaous"
  497.     names(72) = "Jabbah"
  498.     names(73) = "Jishui"
  499.     names(74) = "Jax"
  500.     names(75) = "Jalae"
  501.     names(76) = "Jewel"
  502.     names(77) = "Jumbo"
  503.     names(78) = "Jerue"
  504.     names(79) = "Jabear"
  505.     names(80) = "Kakkab"
  506.     names(81) = "Kang"
  507.     names(82) = "Kekouan"
  508.     names(83) = "Keid"
  509.     names(84) = "Kitalpha"
  510.     names(85) = "Kochab"
  511.     names(86) = "Kolob"
  512.     names(87) = "Kobol"
  513.     names(88) = "Larawag"
  514.     names(89) = "Lesath"
  515.     names(90) = "Libertas"
  516.     names(91) = "Lich"
  517.     names(92) = "Lilly"
  518.     names(93) = "Laddel"
  519.     names(94) = "Luminous"
  520.     names(95) = "Lasacious"
  521.     names(96) = "Mizar"
  522.     names(97) = "Markab"
  523.     names(98) = "Matar"
  524.     names(99) = "Mintaka"
  525.     names(100) = "Meleph"
  526.     names(101) = "Menkar"
  527.     names(102) = "Merga"
  528.     names(103) = "Merope"
  529.     names(104) = "Nahn"
  530.     names(105) = "Naos"
  531.     names(106) = "Nashira"
  532.     names(107) = "Navi"
  533.     names(108) = "Nekkar"
  534.     names(109) = "Nembus"
  535.     names(110) = "Nihal"
  536.     names(111) = "Nunki"
  537.     names(112) = "Ogma"
  538.     names(113) = "Okab"
  539.     names(114) = "Ohmy"
  540.     names(115) = "Oragami"
  541.     names(116) = "Origen"
  542.     names(117) = "Omanii"
  543.     names(118) = "Obytewa"
  544.     names(119) = "Oglok"
  545.     names(120) = "Phact"
  546.     names(121) = "Pherkad"
  547.     names(122) = "Pleione"
  548.     names(122) = "Polaris"
  549.     names(123) = "Pollux"
  550.     names(124) = "Procyon"
  551.     names(125) = "Proxima"
  552.     names(126) = "Polis"
  553.     names(127) = "Quaint"
  554.     names(128) = "Quazzat"
  555.     names(129) = "Quetzal"
  556.     names(130) = "Qussol"
  557.     names(131) = "Quella"
  558.     names(132) = "Quyaeo"
  559.     names(133) = "Ququdas"
  560.     names(134) = "Quekak"
  561.     names(135) = "Rasalas"
  562.     names(136) = "Regor"
  563.     names(137) = "Regulus"
  564.     names(138) = "Rigel"
  565.     names(139) = "Revati"
  566.     names(140) = "Rotenev"
  567.     names(141) = "Rukbat"
  568.     names(142) = "Rastaban"
  569.     names(143) = "Sabik"
  570.     names(144) = "Sadr"
  571.     names(145) = "Saiph"
  572.     names(146) = "Sargas"
  573.     names(147) = "Sarin"
  574.     names(148) = "Syrma"
  575.     names(149) = "Spica"
  576.     names(150) = "Sirius"
  577.     names(151) = "Tarazed"
  578.     names(152) = "Taygeta"
  579.     names(153) = "Tejat"
  580.     names(154) = "Thabit"
  581.     names(155) = "Thuban"
  582.     names(156) = "Tiaki"
  583.     names(157) = "Toliman"
  584.     names(158) = "Torcular"
  585.     names(157) = "Umala"
  586.     names(158) = "Ulatte"
  587.     names(159) = "Ubbessa"
  588.     names(160) = "Unoless"
  589.     names(161) = "Umaddem"
  590.     names(162) = "Ummbra"
  591.     names(162) = "Uniqu"
  592.     names(163) = "Uzzaal"
  593.     names(164) = "Vega"
  594.     names(165) = "Veritate"
  595.     names(166) = "Vindetrix"
  596.     names(167) = "Vedas"
  597.     names(168) = "Vergg"
  598.     names(169) = "Vacant"
  599.     names(170) = "Vucae"
  600.     names(171) = "Vicar"
  601.     names(172) = "Wasat"
  602.     names(173) = "Wazn"
  603.     names(174) = "Wezen"
  604.     names(175) = "Waiten"
  605.     names(176) = "Wachar"
  606.     names(177) = "Wheelz"
  607.     names(178) = "Whatsp"
  608.     names(179) = "Wassand"
  609.     names(180) = "Xenno"
  610.     names(181) = "Xyphod"
  611.     names(182) = "Xu"
  612.     names(183) = "Xaal"
  613.     names(184) = "Xyross"
  614.     names(185) = "Xiggot"
  615.     names(186) = "Xirrks"
  616.     names(187) = "Yed"
  617.     names(188) = "Yildun"
  618.     names(189) = "Yundun"
  619.     names(190) = "Yavyo"
  620.     names(191) = "Yotrac"
  621.     names(192) = "Yxzoqu"
  622.     names(193) = "Ynnot"
  623.     names(194) = "Zaniah"
  624.     names(195) = "Zaurak"
  625.     names(196) = "Zhang"
  626.     names(197) = "Zibal"
  627.     names(198) = "Zosma"
  628.     names(199) = "Zuben"
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  
  637.  
Logged
My name is Michael, but you can call me Mike :)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: MOO
« Reply #23 on: December 07, 2019, 01:04:18 pm »
Pretty cool so far! It reminds me of the population simulators that people make sometimes. Like the ones scientists use for showing that ants can produce only so much then they all die eventually. I also like the way you show the circle spacecraft going to each one. Pretty clever.
Logged

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #24 on: December 07, 2019, 01:14:01 pm »
Thanks! I have replaced the combat "hack" with a more realistic combat resolution. After that is tested I'll start the work of adding a player. :)
Logged
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: MOO
« Reply #25 on: December 07, 2019, 03:35:23 pm »
The AI is much better now balancing territory with far away jucy targets a little better. The battle resolution is better. The defence has a slight bonus which helps it maintain its territory better. If that causes a total standoff condition then that will have to be changed. I won't be posting source after today until the human player is working.

Code: QB64: [Select]
  1. TYPE stars
  2.     n AS STRING * 10 '                 Name of star
  3.     x AS INTEGER '                     x-position
  4.     y AS INTEGER '                     y-position
  5.     o AS INTEGER '                     Owner
  6.     c AS INTEGER '                     Color
  7.     s AS INTEGER '                     Size
  8.     t AS INTEGER '                     (Type of planetary system; terran, frozen, radiated, toxic, etc.) Ships
  9.     p AS INTEGER '                     (Population) For now ships produced per turn
  11.  
  12. TYPE FLEETS
  13.     n AS INTEGER
  14.     x1 AS INTEGER
  15.     y1 AS INTEGER
  16.     x2 AS INTEGER
  17.     y2 AS INTEGER
  18.     o AS INTEGER
  19.     d AS INTEGER
  21.  
  22. 'DECLARE SUB NewGame
  23. 'DECLARE SUB PaintStars
  24. 'DECLARE SUB StarNames
  25. 'DECLARE SUB ShowPanel (i)
  26. 'DECLARE SUB Identify (x, y)
  27. 'DECLARE SUB PaintBackground
  28. 'DECLARE SUB GetInput
  29.  
  30. ' Global variables shared because they are needed in more than one routine
  31. DIM SHARED sw AS INTEGER '             Screen Width
  32. DIM SHARED sh AS INTEGER '             Screen Height
  33. DIM SHARED sww AS INTEGER '            Screen Width Wide margin
  34. DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
  35. DIM SHARED shw AS INTEGER '            Screen Height Wide margine
  36. DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
  37. DIM SHARED nw AS INTEGER '             games Natural screen Width
  38. DIM SHARED nh AS INTEGER '             games Natural screen Height
  39. DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
  40. DIM SHARED star(100) AS stars '        100 stars - may change
  41. DIM SHARED names(200) AS STRING * 10 ' 200 star names
  42. DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
  43. DIM SHARED home(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
  44. DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
  59. DIM SHARED ch AS STRING * 1 '          Game loop key input variable
  60. DIM SHARED repeat AS INTEGER '         Game loop control variable
  63. DIM SHARED fleet(1000) AS FLEETS
  67.  
  68. sw = _DESKTOPWIDTH '                   native video with of syatem
  69. sww = sw / 24 '                        margin based on native video width to keep stars away from edge
  70. swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
  71. nw = 1920
  72.  
  73. ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
  74.  
  76. shw = sh / 20
  77. shn = sh / 40
  78. nh = 1080
  79.  
  80. tt = 0
  81. cx = sw
  82. cp = 100
  83. h = 100
  84. ar = 0
  85. rng = 200
  86.  
  87. SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
  88.  
  90.  
  91. ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
  92.  
  93. StarNames '                            Routine to load star names into string array stars(200)
  94.  
  95. NewGame
  96.  
  97. ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
  98. ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
  99.  
  100. repeat = 1
  101.  
  102. WHILE repeat
  103.  
  104.     _LIMIT 60 '                        Set to 60 frames per second
  105.  
  106.     CLS
  107.  
  108.     PaintBackground
  109.  
  110.     PaintStars
  111.  
  112.     PaintFleet
  113.  
  114.     GetInput
  115.  
  116.     Identify x, y '                    Identify star mouse is over if any
  117.  
  118.     computer
  119.  
  120.     _DISPLAY
  121.  
  123.  
  125.  
  126. SUB PaintFleet
  127.     count = fltcnt
  128.     i = 0
  129.     WHILE count
  130.         IF fleet(i).o <> 0 THEN
  131.             CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
  132.             count = count - 1
  133.         END IF
  134.         i = i + 1
  135.     WEND
  137.  
  138. SUB SendFleet (org, dst)
  139.     FOR i = 0 TO 999
  140.         IF fleet(i).o = 0 THEN
  141.             fleet(i).o = star(org).o
  142.             fleet(i).d = dst
  143.             fleet(i).x1 = star(org).x
  144.             fleet(i).y1 = star(org).y
  145.             fleet(i).x2 = star(dst).x
  146.             fleet(i).y2 = star(dst).y
  147.             fleet(i).n = star(org).t / 2
  148.             star(org).t = star(org).t / 2
  149.             fltcnt = fltcnt + 1
  150.             IF rng < 4000 THEN rng = rng + 4
  151.             EXIT FOR
  152.         END IF
  153.     NEXT
  154.     LL = LL + 1
  156.  
  157. SUB computer
  159.     FOR i = 0 TO 99
  160.         r = INT(RND * 120)
  161.         IF r < star(i).p THEN
  162.             IF star(i).o > 0 THEN
  163.                 star(i).t = star(i).t + 1
  164.             ELSE
  165.                 IF INT(RND * 10) = 0 AND star(i).t < 40 THEN
  166.                     star(i).t = star(i).t + 1
  167.                 END IF
  168.             END IF
  169.         END IF
  170.     NEXT
  171.     num = 0
  172.     FOR i = 1 TO 6
  173.         FOR j = 0 TO 99
  174.             IF star(j).o = i THEN
  175.                 IF star(j).t > num THEN
  176.                     num = star(j).t
  177.                     idx = j
  178.                 END IF
  179.             END IF
  180.         NEXT
  181.         org = idx
  182.         num = 10000
  183.         FOR j = 0 TO 99
  184.             IF star(j).o <> i THEN
  185.                 sway = ABS(star(org).x - star(j).x) + ABS(star(org).y - star(j).y)
  186.                 IF sway < rng AND star(j).t < num THEN
  187.                     num = star(j).t
  188.                     idx = j
  189.                 END IF
  190.             END IF
  191.         NEXT
  192.         dst = idx
  193.         IF star(org).t > 100 AND star(org).t > star(dst).t * 2 AND star(org).t > LL THEN
  194.             SendFleet org, dst
  195.         END IF
  196.     NEXT
  197.     count = fltcnt
  198.     PRINT fltcnt
  199.     i = 0
  200.     WHILE count
  201.         IF fleet(i).o <> 0 THEN
  202.             count = count - 1
  203.             IF fleet(i).x2 > fleet(i).x1 THEN
  204.                 fleet(i).x1 = fleet(i).x1 + 1
  205.             END IF
  206.             IF fleet(i).x2 < fleet(i).x1 THEN
  207.                 fleet(i).x1 = fleet(i).x1 - 1
  208.             END IF
  209.             IF fleet(i).y2 > fleet(i).y1 THEN
  210.                 fleet(i).y1 = fleet(i).y1 + 1
  211.             END IF
  212.             IF fleet(i).y2 < fleet(i).y1 THEN
  213.                 fleet(i).y1 = fleet(i).y1 - 1
  214.             END IF
  215.             IF fleet(i).x1 = fleet(i).x2 AND fleet(i).y1 = fleet(i).y2 THEN
  216.                 dst = fleet(i).d
  217.                 IF star(dst).o = fleet(i).o THEN
  218.                     star(dst).t = star(dst).t + fleet(i).n
  219.                     fleet(i).o = 0
  220.                     fltcnt = fltcnt - 1
  221.                 ELSE
  222.                     alive = 1
  223.                     WHILE alive
  224.                         alive = 0
  225.                         damorg = fleet(i).n / 11 + 1
  226.                         damdst = star(dst).t / 10 + 1
  227.                         fleet(i).n = fleet(i).n - damdst
  228.                         star(dst).t = star(dst).t - damorg
  229.                         IF fleet(i).n > 0 AND star(dst).t > 0 THEN
  230.                             alive = 1
  231.                         END IF
  232.                     WEND
  233.                     IF star(dst).t < 1 THEN
  234.                         star(dst).t = fleet(i).n
  235.                         star(dst).o = fleet(i).o
  236.                     END IF
  237.                     fleet(i).o = 0
  238.                     fltcnt = fltcnt - 1
  239.                 END IF
  240.             END IF
  241.         END IF
  242.         i = i + 1
  243.     WEND
  245.  
  246. SUB GetInput
  247.  
  248.     ch = INKEY$
  249.     IF ch = CHR$(27) THEN repeat = 0
  250.     IF ch = "n" THEN NewGame
  251.     IF ch = "t" THEN tt = 1 - tt
  252.     ch = ""
  253.  
  254.     WHILE _MOUSEINPUT: WEND '          Eat all the mice but keep last mouse to toy with
  255.  
  256.     x = _MOUSEX
  257.     y = _MOUSEY
  258.     mb = _MOUSEBUTTON(1)
  259.     clk = 0
  260.  
  261.     IF mb = -1 AND cx = sw THEN
  262.         cx = x
  263.         cy = y
  264.     END IF
  265.  
  266.     IF mb = 0 AND cx < sw THEN
  267.         IF ABS(x - cx) < 4 AND ABS(y - cy) < 4 THEN
  268.             clk = 1
  269.         END IF
  270.         cx = sw
  271.     END IF
  273.  
  274. SUB PaintBackground
  276.     x = RND * sw
  277.     y = RND * sh
  278.     c = RND * 14 + 1
  279.     PSET (x, y), c
  280.     RANDOMIZE USING seed
  281.     FOR i = 1 TO 600 * ratio
  282.         x = RND * sw
  283.         y = RND * sh
  284.         c = RND * 14 + 1
  285.         PSET (x, y), c
  286.     NEXT
  288.  
  289. SUB ProcessPanel
  290.  
  292.  
  293. SUB Identify (x, y)
  294.     IF ar = 1 THEN
  295.         ShowPanel h
  296.         IF clk THEN
  297.             IF x >= x1 AND x <= x2 AND y >= y1 AND y <= y2 THEN
  298.                 ProcessPanel
  299.             ELSE
  300.                 ar = 0
  301.             END IF
  302.         END IF
  303.     END IF
  304.     IF ar = 0 THEN
  305.         FOR i = 0 TO 99
  306.             dx = star(i).x - x
  307.             dy = star(i).y - y
  308.             IF ABS(dx) <= star(i).s + 6 AND ABS(dy) <= star(i).s + 6 THEN
  309.                 ShowPanel i
  310.                 IF clk THEN
  311.                     clk = 0
  312.                     h = i
  313.                     ar = 1
  314.                     ax = x
  315.                 END IF
  316.             END IF
  317.         NEXT
  318.     END IF
  320.  
  321. SUB ShowPanel (i)
  322.     x1 = star(i).x - 420 * ratio
  323.     IF star(i).x < sw / 2 THEN x1 = star(i).x + 20
  324.     x2 = x1 + 400 * ratio
  325.     y1 = star(i).y
  326.     IF y1 > sh - 560 * ratio THEN y1 = sh - 560 * ratio
  327.     y2 = y1 + 540 * ratio
  328.     _DEST ps
  329.     CLS 0, 8
  330.     COLOR 0, 8
  331.     _FONT ttf2
  332.     n$ = RTRIM$(star(i).n)
  333.     L = _PRINTWIDTH(n$)
  334.     _PRINTSTRING ((400 - L) / 2, 8), n$, ps
  335.     _PUTIMAGE (x1, y1), ps, 0, (0, 0)-(400 * ratio, 540 * ratio)
  336.     _DEST 0
  338.  
  339. SUB PaintStars
  340.     FOR i = 0 TO 99
  341.         c = star(i).c
  342.         x = star(i).x
  343.         y = star(i).y
  344.         o = star(i).o
  345.         CIRCLE (x, y), (star(i).s + 6) * ratio, c
  346.         COLOR 15
  347.         IF o > 0 THEN
  348.             PAINT (x, y), o + 8, c
  349.             COLOR o + 8
  350.         END IF
  351.         _FONT ttf1
  352.         IF tt THEN
  353.             n$ = star(i).n
  354.             n$ = RTRIM$(n$)
  355.             L = _PRINTWIDTH(n$)
  356.         ELSE
  357.             n$ = STR$(star(i).t)
  358.             L = _PRINTWIDTH(n$)
  359.         END IF
  360.         _PRINTSTRING (x - L / 2, y + 12), n$, 0
  361.     NEXT
  363.  
  364. SUB NewGame
  365.     DIM k AS INTEGER
  366.     DIM r AS INTEGER
  367.     DIM dx AS INTEGER
  368.     DIM dy AS INTEGER
  369.     DIM n AS STRING * 10
  370.     FOR i = 0 TO 999
  371.         fleet(i).o = 0
  372.     NEXT
  373.     fltcnt = 0
  374.     LL = 50
  376.     seed = RND * 1000
  377.     star(0).n = "Sol"
  378.     star(0).x = RND * (sw - sww) + swn
  379.     star(0).y = RND * (sh - shw) + shn
  380.     star(0).c = 14
  381.     star(0).s = 2
  382.     star(0).o = 1
  383.     star(0).p = 10
  384.     star(0).t = 100
  385.     home(0) = 0
  386.     FOR i = 1 TO 99
  387.         k = 1
  388.         WHILE k
  389.             k = 0
  390.             x = RND * (sw - sww) + swn
  391.             y = RND * (sh - shw) + shn
  392.             r = INT(RND * 200)
  393.             n = names(r)
  394.             FOR j = 0 TO i - 1
  395.                 dx = x - star(j).x
  396.                 dy = y - star(j).y
  397.                 IF ABS(dx) < sww AND ABS(dy) < shw THEN
  398.                     k = 1
  399.                 END IF
  400.                 IF n = star(j).n THEN
  401.                     k = 1
  402.                 END IF
  403.             NEXT
  404.         WEND
  405.         star(i).n = n
  406.         star(i).x = x
  407.         star(i).y = y
  408.         star(i).c = RND * 6 + 9
  409.         star(i).s = RND * 5
  410.         star(i).o = 0
  411.         star(i).p = star(i).s + (RND * 8) + 1
  412.         star(i).t = 0
  413.     NEXT
  414.     FOR i = 2 TO 6
  415.         k = 1
  416.         WHILE k
  417.             k = 0
  418.             r = RND * 100
  419.             FOR j = 1 TO i - 1
  420.                 IF r = home(j) THEN k = 1
  421.                 x = star(0).x
  422.                 y = star(0).y
  423.                 dx = ABS(star(r).x - x)
  424.                 dy = ABS(star(r).y - y)
  425.                 IF dx < sw / 4 AND dy < sh / 4 THEN k = 1
  426.             NEXT
  427.         WEND
  428.         home(i) = r
  429.         star(r).o = i
  430.         star(r).p = 10
  431.         star(r).t = 100
  432.     NEXT
  434.  
  435. ' A lot of star names I made up
  436.  
  437. SUB StarNames
  438.     names(0) = "Acamar"
  439.     names(1) = "Arcab"
  440.     names(2) = "Acrux"
  441.     names(3) = "Adhara"
  442.     names(4) = "Arneb"
  443.     names(5) = "Antares"
  444.     names(6) = "Arcturus"
  445.     names(7) = "Atria"
  446.     names(8) = "Beid"
  447.     names(9) = "Betelgeuse"
  448.     names(10) = "Botein"
  449.     names(11) = "Beemim"
  450.     names(12) = "Bellatrix"
  451.     names(13) = "Bharani"
  452.     names(14) = "Biham"
  453.     names(15) = "Brachium"
  454.     names(16) = "Canopus"
  455.     names(17) = "Capella"
  456.     names(18) = "Castor"
  457.     names(19) = "Chara"
  458.     names(20) = "Cursa"
  459.     names(21) = "Copernicus"
  460.     names(22) = "Chalawan"
  461.     names(23) = "Chertan"
  462.     names(24) = "Dabih"
  463.     names(25) = "Dalim"
  464.     names(26) = "Deneb"
  465.     names(27) = "Denebola"
  466.     names(28) = "Diadem"
  467.     names(29) = "Diphda"
  468.     names(30) = "Dschubba"
  469.     names(31) = "Dziban"
  470.     names(32) = "Edasich"
  471.     names(33) = "Electra"
  472.     names(34) = "Elgafar"
  473.     names(35) = "Elkurud"
  474.     names(36) = "Elnath"
  475.     names(37) = "Eltanin"
  476.     names(38) = "Enif"
  477.     names(39) = "Errai"
  478.     names(40) = "Fafnir"
  479.     names(41) = "Fang"
  480.     names(42) = "Fawaris"
  481.     names(43) = "Felis"
  482.     names(44) = "Fomalhaut"
  483.     names(45) = "Fulu"
  484.     names(46) = "Fumal"
  485.     names(47) = "Furud"
  486.     names(48) = "Garnet"
  487.     names(49) = "Giausar"
  488.     names(50) = "Gienah"
  489.     names(51) = "Ginan"
  490.     names(52) = "Gomeisa"
  491.     names(53) = "Graffias"
  492.     names(54) = "Grumium"
  493.     names(55) = "Gudja"
  494.     names(56) = "Hadar"
  495.     names(57) = "Haedus"
  496.     names(58) = "Hamal"
  497.     names(59) = "Hassaleh"
  498.     names(60) = "Hatysa"
  499.     names(61) = "Helvetios"
  500.     names(62) = "Heze"
  501.     names(63) = "Homan"
  502.     names(64) = "Iklil"
  503.     names(65) = "Imai"
  504.     names(66) = "Intercrus"
  505.     names(67) = "Izar"
  506.     names(68) = "Iccar"
  507.     names(69) = "Inar"
  508.     names(70) = "Iaeth"
  509.     names(71) = "Imaous"
  510.     names(72) = "Jabbah"
  511.     names(73) = "Jishui"
  512.     names(74) = "Jax"
  513.     names(75) = "Jalae"
  514.     names(76) = "Jewel"
  515.     names(77) = "Jumbo"
  516.     names(78) = "Jerue"
  517.     names(79) = "Jabear"
  518.     names(80) = "Kakkab"
  519.     names(81) = "Kang"
  520.     names(82) = "Kekouan"
  521.     names(83) = "Keid"
  522.     names(84) = "Kitalpha"
  523.     names(85) = "Kochab"
  524.     names(86) = "Kolob"
  525.     names(87) = "Kobol"
  526.     names(88) = "Larawag"
  527.     names(89) = "Lesath"
  528.     names(90) = "Libertas"
  529.     names(91) = "Lich"
  530.     names(92) = "Lilly"
  531.     names(93) = "Laddel"
  532.     names(94) = "Luminous"
  533.     names(95) = "Lasacious"
  534.     names(96) = "Mizar"
  535.     names(97) = "Markab"
  536.     names(98) = "Matar"
  537.     names(99) = "Mintaka"
  538.     names(100) = "Meleph"
  539.     names(101) = "Menkar"
  540.     names(102) = "Merga"
  541.     names(103) = "Merope"
  542.     names(104) = "Nahn"
  543.     names(105) = "Naos"
  544.     names(106) = "Nashira"
  545.     names(107) = "Navi"
  546.     names(108) = "Nekkar"
  547.     names(109) = "Nembus"
  548.     names(110) = "Nihal"
  549.     names(111) = "Nunki"
  550.     names(112) = "Ogma"
  551.     names(113) = "Okab"
  552.     names(114) = "Ohmy"
  553.     names(115) = "Oragami"
  554.     names(116) = "Origen"
  555.     names(117) = "Omanii"
  556.     names(118) = "Obytewa"
  557.     names(119) = "Oglok"
  558.     names(120) = "Phact"
  559.     names(121) = "Pherkad"
  560.     names(122) = "Pleione"
  561.     names(122) = "Polaris"
  562.     names(123) = "Pollux"
  563.     names(124) = "Procyon"
  564.     names(125) = "Proxima"
  565.     names(126) = "Polis"
  566.     names(127) = "Quaint"
  567.     names(128) = "Quazzat"
  568.     names(129) = "Quetzal"
  569.     names(130) = "Qussol"
  570.     names(131) = "Quella"
  571.     names(132) = "Quyaeo"
  572.     names(133) = "Ququdas"
  573.     names(134) = "Quekak"
  574.     names(135) = "Rasalas"
  575.     names(136) = "Regor"
  576.     names(137) = "Regulus"
  577.     names(138) = "Rigel"
  578.     names(139) = "Revati"
  579.     names(140) = "Rotenev"
  580.     names(141) = "Rukbat"
  581.     names(142) = "Rastaban"
  582.     names(143) = "Sabik"
  583.     names(144) = "Sadr"
  584.     names(145) = "Saiph"
  585.     names(146) = "Sargas"
  586.     names(147) = "Sarin"
  587.     names(148) = "Syrma"
  588.     names(149) = "Spica"
  589.     names(150) = "Sirius"
  590.     names(151) = "Tarazed"
  591.     names(152) = "Taygeta"
  592.     names(153) = "Tejat"
  593.     names(154) = "Thabit"
  594.     names(155) = "Thuban"
  595.     names(156) = "Tiaki"
  596.     names(157) = "Toliman"
  597.     names(158) = "Torcular"
  598.     names(157) = "Umala"
  599.     names(158) = "Ulatte"
  600.     names(159) = "Ubbessa"
  601.     names(160) = "Unoless"
  602.     names(161) = "Umaddem"
  603.     names(162) = "Ummbra"
  604.     names(162) = "Uniqu"
  605.     names(163) = "Uzzaal"
  606.     names(164) = "Vega"
  607.     names(165) = "Veritate"
  608.     names(166) = "Vindetrix"
  609.     names(167) = "Vedas"
  610.     names(168) = "Vergg"
  611.     names(169) = "Vacant"
  612.     names(170) = "Vucae"
  613.     names(171) = "Vicar"
  614.     names(172) = "Wasat"
  615.     names(173) = "Wazn"
  616.     names(174) = "Wezen"
  617.     names(175) = "Waiten"
  618.     names(176) = "Wachar"
  619.     names(177) = "Wheelz"
  620.     names(178) = "Whatsp"
  621.     names(179) = "Wassand"
  622.     names(180) = "Xenno"
  623.     names(181) = "Xyphod"
  624.     names(182) = "Xu"
  625.     names(183) = "Xaal"
  626.     names(184) = "Xyross"
  627.     names(185) = "Xiggot"
  628.     names(186) = "Xirrks"
  629.     names(187) = "Yed"
  630.     names(188) = "Yildun"
  631.     names(189) = "Yundun"
  632.     names(190) = "Yavyo"
  633.     names(191) = "Yotrac"
  634.     names(192) = "Yxzoqu"
  635.     names(193) = "Ynnot"
  636.     names(194) = "Zaniah"
  637.     names(195) = "Zaurak"
  638.     names(196) = "Zhang"
  639.     names(197) = "Zibal"
  640.     names(198) = "Zosma"
  641.     names(199) = "Zuben"
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
Logged
My name is Michael, but you can call me Mike :)
Pages: 1 [2]   Go Up
« previous next »