Author Topic: MOO  (Read 867 times)

Offline romichess

  • Forum Regular
  • Posts: 143
Re: MOO
« Reply #15 on: December 05, 2019, 05:34:32 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!
My name is Michael, but you can call me Mike :)

Offline TempodiBasic

  • Forum Resident
  • Posts: 1408
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!
Programming isn't difficult, only it's  consuming time and coffee

Offline romichess

  • Forum Regular
  • Posts: 143
Re: MOO
« Reply #17 on: December 06, 2019, 10:15:04 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 »
My name is Michael, but you can call me Mike :)

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 324
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.

Andy

Offline romichess

  • Forum Regular
  • Posts: 143
Re: MOO
« Reply #19 on: December 06, 2019, 02:41:49 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.
My name is Michael, but you can call me Mike :)

Offline romichess

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

Offline romichess

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

Offline romichess

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

Offline SierraKen

  • Forum Resident
  • Posts: 943
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.

Offline romichess

  • Forum Regular
  • Posts: 143
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. :)
My name is Michael, but you can call me Mike :)

Offline romichess

  • Forum Regular
  • Posts: 143
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
  10.  
  11. TYPE FLEETS
  12.     n AS INTEGER
  13.     x1 AS INTEGER
  14.     y1 AS INTEGER
  15.     x2 AS INTEGER
  16.     y2 AS INTEGER
  17.     o AS INTEGER
  18.     d AS INTEGER
  19.  
  20. 'DECLARE SUB NewGame
  21. 'DECLARE SUB PaintStars
  22. 'DECLARE SUB StarNames
  23. 'DECLARE SUB ShowPanel (i)
  24. 'DECLARE SUB Identify (x, y)
  25. 'DECLARE SUB PaintBackground
  26. 'DECLARE SUB GetInput
  27.  
  28. ' Global variables shared because they are needed in more than one routine
  29. DIM SHARED sw AS INTEGER '             Screen Width
  30. DIM SHARED sh AS INTEGER '             Screen Height
  31. DIM SHARED sww AS INTEGER '            Screen Width Wide margin
  32. DIM SHARED swn AS INTEGER '            Screen Width Narrow adjustment
  33. DIM SHARED shw AS INTEGER '            Screen Height Wide margine
  34. DIM SHARED shn AS INTEGER '            Screen Height Narrow adjustment
  35. DIM SHARED nw AS INTEGER '             games Natural screen Width
  36. DIM SHARED nh AS INTEGER '             games Natural screen Height
  37. DIM SHARED ratio AS _FLOAT '           the Ratio of the games natural screen width to the actual
  38. DIM SHARED star(100) AS stars '        100 stars - may change
  39. DIM SHARED names(200) AS STRING * 10 ' 200 star names
  40. DIM SHARED seed AS INTEGER '           Seed to prime the Randomizer to display identical background each frame
  41. DIM SHARED home(6) AS INTEGER '        The starting star for each player. The human always has star(0), Sol
  42. DIM SHARED tt AS INTEGER '             tt = 0 star names displayed, tt = 0 star names not didplayed
  43. DIM SHARED ch AS STRING * 1 '          Game loop key input variable
  44. DIM SHARED repeat AS INTEGER '         Game loop control variable
  45. DIM SHARED fleet(1000) AS FLEETS
  46.  
  47. sw = _DESKTOPWIDTH '                   native video with of syatem
  48. sww = sw / 24 '                        margin based on native video width to keep stars away from edge
  49. swn = sw / 48 '                        adjustment that works with sww to keep stars away from left and top of screen
  50. nw = 1920
  51.  
  52. ratio = sw / 1920 '                    Used to adjust distances and sizes for various screen modes
  53.  
  54. shw = sh / 20
  55. shn = sh / 40
  56. nh = 1080
  57.  
  58. tt = 0
  59. cx = sw
  60. cp = 100
  61. h = 100
  62. ar = 0
  63. rng = 200
  64.  
  65. SCREEN _NEWIMAGE(sw, sh, 256) '        creates a screen the resolution of the users native system
  66.  
  67.  
  68. ps = _NEWIMAGE(400 * ratio, 540 * ratio, 256)
  69.  
  70. StarNames '                            Routine to load star names into string array stars(200)
  71.  
  72. NewGame
  73.  
  74. ttf1 = _LOADFONT("cyberbit.ttf", 14, "BOLD")
  75. ttf2 = _LOADFONT("cyberbit.ttf", 72, "BOLD")
  76.  
  77. repeat = 1
  78.  
  79. WHILE repeat
  80.  
  81.     _LIMIT 60 '                        Set to 60 frames per second
  82.  
  83.     CLS
  84.  
  85.     PaintBackground
  86.  
  87.     PaintStars
  88.  
  89.     PaintFleet
  90.  
  91.     GetInput
  92.  
  93.     Identify x, y '                    Identify star mouse is over if any
  94.  
  95.     computer
  96.  
  97.     _DISPLAY
  98.  
  99.  
  100.  
  101. SUB PaintFleet
  102.     count = fltcnt
  103.     i = 0
  104.     WHILE count
  105.         IF fleet(i).o <> 0 THEN
  106.             CIRCLE (fleet(i).x1, fleet(i).y1), 3, fleet(i).o + 8
  107.             count = count - 1
  108.         END IF
  109.         i = i + 1
  110.     WEND
  111.  
  112. SUB SendFleet (org, dst)
  113.     FOR i = 0 TO 999
  114.         IF fleet(i).o = 0 THEN
  115.             fleet(i).o = star(org).o
  116.             fleet(i).d = dst
  117.             fleet(i).x1 = star(org).x
  118.             fleet(i).y1 = star(org).y
  119.             fleet(i).x2 = star(dst).x
  120.             fleet(i).y2 = star(dst).y
  121.             fleet(i).n = star(org).t / 2
  122.             star(org).t = star(org).t / 2
  123.             fltcnt = fltcnt + 1
  124.             IF rng < 4000 THEN rng = rng + 4
  125.             EXIT FOR
  126.         END IF
  127.     NEXT
  128.     LL = LL + 1
  129.  
  130. SUB computer