Author Topic: GALAXY Generator  (Read 5091 times)

0 Members and 1 Guest are viewing this topic.

Offline SirCrow

  • Forum Regular
  • Posts: 144
    • View Profile
GALAXY Generator
« on: September 04, 2019, 12:21:48 am »
Well, I wanted to improve the galaxy simulator/approximator for my Space Trip program, and I've done just that.
The end result from this code still requires touching up in a graphics app, such as blurring and flattening, if desired.
As usual, you should not use my sloppy code to learn how to write code neatly or professionally, but if you care to run it:

Use F5 to change the galaxy's basic colour.
Use + and - to change the number of spirals (2 to 48; default is 24) or arms in the galaxy.
Press Esc to exit or any other key to generate a new galaxy which you may like better.

Code: QB64: [Select]
  1.  
  2.  
  3. DEFINT A-Z: OPTION BASE 1: RANDOMIZE TIMER ': ON ERROR GOTO Errors
  4. DIM SpRad AS SINGLE, Arm_W AS SINGLE, Ang AS SINGLE '* * * * Ang likely needn't be SINGLE * * * *
  5.  
  6. Res_X = 1280: Res_Y = 720
  7.  
  8. '[ ]  [ ]  [ ]  [ ]  [ ]  [ ]  [ ]
  9. Scr& = _NEWIMAGE(Res_X, Res_Y, 32)
  10. SCREEN Scr&
  11. '[ ]  [ ]  [ ]  [ ]  [ ]  [ ]  [ ]
  12.  
  13. Gal_X = Res_X / 2: Gal_Y = Res_Y / 2:: H_Mod = 1
  14.  
  15. ::: BasClr~& = _RGB(255, 233, 144) '!!! NOTE: This BASIC Galaxy colour must match one in "SELECT CASE BasClr~&" near LOOP's bottom !!!
  16.  
  17. MaxRad = 400:: AngInc = 1:: SpCnt = 24 'How many arms
  18.  
  19. '   MaxRad.........Half the Galaxy's full width               SpCnt.........Number of spiral arms in Galaxy
  20. '   H_Mod..........Height modifier (Galaxy; 1 = circle)       AngInc........Angle increment (along each arm)
  21.  
  22.  
  23. DO UNTIL INKEY$ = CHR$(27) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  24.  
  25.     CLS
  26.  
  27.     'GOSUB Stars_Far 'Stars for lookin' at
  28.     'GOSUB Stars_Near
  29.  
  30.     FOR Arm = 1 TO SpCnt 'for each SPIRAL/arm of Galaxy
  31.  
  32.         CA! = (Arm / SpCnt) * 360 'Each spiral Arm's "angle" (position in degrees)
  33.  
  34.         Ang = 0:: SpRad = 10:: Inter = 0:: EVEN = 0 'Starting angle, dist. fr. ctr. + "inbetween" or not
  35.  
  36.         IF Arm / 2 = INT(Arm / 2) THEN EVEN = -1 'Intermittent (every other, even) arm
  37.         IF RND < .5 THEN Inter = -1
  38.  
  39.         IF Inter THEN 'the "inbetween", maybe lesser arms
  40.             MaxLen = RND * 30 + 300:: Max_W = 140
  41.         ELSE 'the "main", boldest arms
  42.             MaxLen = RND * 50 + 300:: Max_W = 110 'Likely longer & more dense
  43.         END IF
  44.  
  45.         ::: Arm_W = Max_W 'Arm width that dwindles from ctr. outward
  46.  
  47.  
  48.         FOR A = 1 TO MaxLen 'each step along arm's length...  **********************************************
  49.  
  50.             '::: _LIMIT 70
  51.  
  52.             Ang = Ang + AngInc:: IF Ang > 359 THEN Ang = Ang - 360 'AngInc  =  Angle increment (1, 2, etc.)
  53.  
  54.             PX = Gal_X + SIN(_D2R(CA! + Ang)) * SpRad '/ 3   'Divisor here makes a VERTICAL  E L L I P S E
  55.             PY = Gal_Y + COS(_D2R(CA! + Ang)) * SpRad / H_Mod '...horizontal
  56.  
  57.  
  58.             ':::: CIRCLE (PX, PY), 2, _RGB(6, 205, 0) '_RGB(255 - A, 255 - A, 255 - A)
  59.             ':::: GOTO NexRadAng '* * * * TESTING ONLY * * * *
  60.  
  61.             'IF Inter THEN ParCnt = MaxLen / 2 - A / 6 ELSE ParCnt = MaxLen * .7 - A
  62.             IF Inter THEN ParCnt = MaxLen / 1.5 - A / 1.02 ELSE ParCnt = MaxLen - A 'Inbetween' arms thin out quicker
  63.  
  64.             IF ParCnt < 9 THEN ParCnt = 9 'Don't let cluster thin out too much
  65.             IF RND < .8 THEN ParCnt = ParCnt / 3 ELSE IF A > MaxLen - RND * (MaxLen * .05) GOTO NexArm
  66.  
  67.             PC = 0
  68.  
  69.             FOR P = 1 TO ParCnt 'Was: TO MaxLen - A                  Create clusters of pixels (stars) to hide the
  70.                 Get_PPXY:: PC = PC + 1:: IF PC > 400 GOTO NexP '     gaps between points (PX, PY) along the spiral.
  71.  
  72.                 PPX = PX + RND * Arm_W - Arm_W / 2 '40 - 20
  73.                 PPY = PY + RND * Arm_W - Arm_W / 2 ' Arm_W - Arm_W / 2 '14 - 7 'Same thickness X/Y
  74.                 'PPY = PY + RND * Arm_W / 2.5 - Arm_W / 5 ' Arm_W - Arm_W / 2 '14 - 7 'Narrower vertically
  75.  
  76.                 'IF ((PPX - PX) ^ 2) + ((PPY - PY) ^ 2) > 20 ^ 2 GOTO Get_PXY 'Stay within a circle/elipse
  77.                 IF ((PPX - PX) ^ 2) + ((PPY - PY) ^ 2) > Arm_W ^ 2 GOTO Get_PPXY 'Stay within a circle/elipse
  78.  
  79.                 RN! = RND
  80.                 IF RN! > .6 THEN COLOR _RGB(255, 255, 255) ELSE IF RN! > .3 THEN COLOR _RGB(255, 238, 200) ELSE COLOR BasClr~& ' _RGB(255, 150, 0) '
  81.                 PSET (PPX, PPY)
  82.                 NexP:
  83.             NEXT
  84.  
  85.             'Every few thin (non-dense) arms, enhance arm w/ a broken string of bright stars or mini-clusters...
  86.  
  87.             IF Inter AND EVEN AND RND < .3 THEN COLOR _RGB(255, 249, 233):: CIRCLE (PX, PY), 1:: PAINT (PX, PY)
  88.  
  89.             NexRadAng::
  90.  
  91.             'SpRad = SpRad - 3 ' .64 '.67   'Inward from edge  * * * * Likely OBSOLETE * * * *
  92.             SpRad = SpRad + 1 '.67 '1 'Outward from center
  93.  
  94.             Arm_W = Arm_W - Max_W / MaxLen
  95.             'Arm_W = Arm_W - MaxLen / (MaxLen - Arm_W)
  96.             'Arm_W = Arm_W - (MaxLen - Arm_W) / MaxLen
  97.             IF Arm_W < 0 THEN Arm_W = 0
  98.  
  99.             '::: _PRINTSTRING (PX, PY), STR$(Ang) '+ "  " + STR$(PX) + STR$(PY)
  100.         NEXT 'Angle (step along arm/spiral) ****************************************************************
  101.  
  102.         NexArm: '::: SLEEP
  103.  
  104.     NEXT Arm '
  105.  
  106.  
  107.     '* ** ***  Now, ENHANCE/thicken our Galaxy's CENTER area with larger, multi-coloured particles  *** ** *
  108.  
  109.  
  110.     FOR C = 1 TO 2 'Clusters of Particles (LARGER first, then smaller/denser @ centre)
  111.  
  112.         Radius = SpRad / 3 / C * 1.7 ' 1.3
  113.  
  114.         FOR P = 1 TO 2400 / C 'No. of particles to enhance/intensify Galaxy's center
  115.  
  116.             Get_PP2:
  117.             PPX = Gal_X + RND * Radius * 2 - Radius '/ 2 'Particle's X pos.
  118.             PPY = Gal_Y + RND * Radius * 2 - Radius 'Particle's Y
  119.             'PPY = Gal_Y + RND * Radius * 2 / H_Mod - Radius / H_Mod 'Particle's Y (narrower vertically)
  120.  
  121.             PDist = SQR((PPX - Gal_X) ^ 2 + (PPY - Gal_Y) ^ 2) 'This particle's distance to Galaxy ctr.
  122.  
  123.             IF Radius / (4 - C) - (PDist - RND * Radius) < PDist GOTO Get_PP2 'Thin out the edge/boundary
  124.             'ABOVE: The closer to center, the less likely it'll be rejected ----------
  125.  
  126.  
  127.             IF (PPX - Gal_X) ^ 2 + (PPY - Gal_Y) ^ 2 > Radius ^ 2 GOTO Get_PP2 'Stay within the circle/ellipse
  128.             'IF ((PPX - Gal_X) ^ 2) / (SpRad * 2) ^ 2 + ((PPY - Gal_Y) ^ 2) / (SpRad * 2 / H_Mod) ^ 2 >= 1 GOTO Get_PP2 'Stay within the ellipse
  129.             '!!!  Line above, based on Pythagoras-type equation below, SHOULD work....but does NOT  !!!
  130.  
  131.             '******  (x-h) ^ 2 / a^2 + (y-k) ^ 2 / b^2 <= 1       a...Ellipse's width    b...height      h,k...its center  ******
  132.  
  133.             '::: : PRINT P, ((PPX - Gal_X) ^ 2) / (SpRad * 2) ^ 2 + ((PPY - Gal_Y) ^ 2) / (SpRad * 2 / H_Mod) ^ 2
  134.  
  135.             RN! = RND
  136.             'IF RN! < C / 3 + .3 THEN COLOR _RGB(255, 255, 238) ELSE IF RN! < .95 THEN COLOR _RGB(255, 177, 44) ELSE COLOR _RGB(94, 55, 0) '
  137.             IF RN! < C / 3 + .3 THEN COLOR _RGB(255, 255, 238) ELSE IF RN! < .95 THEN COLOR BasClr~& ELSE COLOR _RGB(94, 55, 0) '
  138.             'ABOVE: Mostly [near-] WHITE particles, and much denser white nearest center;
  139.             '       also, some black/dark spots for effect (imperfections, blemishes)
  140.  
  141.             ':::: IF C = 2 THEN COLOR _RGB(0, 211, 0):::: '* * * * TEST COLOR for CENTER cluster * * * *
  142.  
  143.             IF C = 1 THEN Rad = 2 ELSE Rad = 3 'Smaller ctr. cluster is of larger solid dots
  144.             CIRCLE (PPX, PPY), Rad:: PAINT (PPX, PPY)
  145.  
  146.         NEXT 'Particle
  147.  
  148.     NEXT 'Cluster
  149.  
  150.  
  151.     IF Msg_Dur > 0 THEN
  152.         '_AUTODISPLAY
  153.  
  154.         DO UNTIL TIMER - Msg_Time > Msg_Dur 'MR < 1
  155.             MR = MR - 5: MG = MG - 5: MB = MB - 5 'Screen-res text FADES away
  156.             'MR = MR - Res_X / 170: MG = MG - Res_X / 170: MB = MB - Res_X / 170 'Screen-res text FADES away
  157.  
  158.             COLOR , _RGBA(0, 0, 0, 0) 'Text BG is transparent
  159.  
  160.             'IF MR > 39 THEN 'Show SHADOW until text is very dark
  161.             '    COLOR _RGB(0, 0, 0): _PRINTSTRING (Res_X / 2 - 3 - _PRINTWIDTH(Message$) / 2, Res_Y / 2 + 4), Message$ 'Shadow, line 1                      -- M E S S A G E --
  162.             '    IF M2$ > "" THEN:::: _PRINTSTRING (Res_X / 2 - 3 - _PRINTWIDTH(M2$) / 2, Res_Y / 2 + 37), M2$ 'Shadow, line 2 (maybe)
  163.             'END IF
  164.  
  165.             _AUTODISPLAY
  166.  
  167.             COLOR _RGB32(MR, MG, MB)
  168.             _PRINTSTRING (Res_X / 2 - _PRINTWIDTH(Message$) / 2, Res_Y * .8), Message$ '1st line
  169.             IF M2$ > "" THEN::::::: _PRINTSTRING (Res_X / 2 - _PRINTWIDTH(M2$) / 2, Res_Y * .8 + 33), M2$ 'Second msg. line  (33 pixels lower)
  170.             ':::: BEEP
  171.  
  172.             _DISPLAY
  173.         LOOP:: Msg_Dur = 0
  174.     END IF
  175.  
  176.     _DISPLAY:: SLEEP::
  177.     K$ = INKEY$ 'WHILE INKEY$ > "": WEND     INKEY$
  178.  
  179.     SELECT CASE K$
  180.  
  181.         CASE CHR$(27):: END
  182.  
  183.         CASE "+", "=", "-", "_":: SOUND 5555, .5 'Change how many spiral Arms in Galaxy
  184.  
  185.             IF SpCnt > 1 AND K$ = "-" OR K$ = "_" THEN SpCnt = SpCnt - 2: _
  186.               IF SpCnt <= 2 THEN SpCnt = 2 :: SOUND 3333, 1  'Reduce #
  187.  
  188.             IF SpCnt < 49 AND K$ = "+" OR K$ = "=" THEN SpCnt = SpCnt + 2: _
  189.               IF SpCnt >= 48 THEN SpCnt = 48:: SOUND 3333, 1 'Increase
  190.  
  191.             Msg_Time = TIMER: Msg_Dur = 7: MR = 255: MG = 255: MB = 255
  192.             Message$ = "How Many Arms:" + STR$(SpCnt):: M2$ = "" '
  193.  
  194.             FMsg& = _LOADFONT("LiberationSans-Bold.ttf", 30)
  195.  
  196.             IF FMsg& > 0 THEN _FONT FMsg& ELSE _FONT 14:: BEEP
  197.             COLOR , _RGBA(0, 0, 0, 0) 'Text BG is transparent
  198.  
  199.         CASE CHR$(0) + CHR$(63) 'F5 = Change Galaxy's colour
  200.  
  201.             SELECT CASE BasClr~&
  202.                 CASE _RGB(255, 233, 144): BasClr~& = _RGB(122, 233, 0) '  Yellow ---> Green
  203.                 CASE _RGB(122, 233, 0)::: BasClr~& = _RGB(0, 128, 255) '  Green ----> Blue
  204.                 CASE _RGB(0, 128, 255)::: BasClr~& = _RGB(100, 83, 255) ' Blue -----> Purple
  205.                 CASE _RGB(100, 83, 255):: BasClr~& = _RGB(255, 105, 89) ' Purple ---> Red
  206.                 CASE _RGB(255, 105, 89):: BasClr~& = _RGB(255, 161, 44) ' Red ------> Orange/Amber
  207.                 CASE _RGB(255, 161, 44):: BasClr~& = _RGB(255, 233, 144) 'Orange ---> Yellow
  208.             END SELECT
  209.  
  210.     END SELECT:: K$ = ""
  211.  
  212.     '_DISPLAY:: SLEEP::
  213.     'K$ = INKEY$ 'WHILE INKEY$ > "": WEND     INKEY$
  214.  
  215.  
  216.  
  217.  
  218.  
  219. Stars_Far:
  220.  
  221. '------------------------ R A N D O M  S T A R S  (FARTHER) -------------------------
  222. FOR I = 1 TO 6500 'How Many Stars
  223.  
  224.     XX = RND(1) * 1280 'Random location in UL quarter of Large BG
  225.     YY = RND(1) * 720 ' (to be MIRRORED below)
  226.  
  227.     Clr~& = _RGB(255, 255, 255) 'Default to brightest white
  228.     IF RND < .4 THEN Grey = 255: GOTO Put_Star 'More BRIGHT stars
  229.  
  230.     'Grey = RND * 100 + 100 'Random grey shade, but not too dim
  231.     Grey = RND * 150 + 50 'Random grey shade, but not too dim
  232.  
  233.     Clr~& = _RGB32(Grey, Grey, Grey) 'Random intensities of GREY only
  234.  
  235.     Put_Star:
  236.     PSET (XX, YY), Clr~& ': PSET (XX + 1280, YY), Clr~& 'Mirrored horizontally
  237.     'PSET (XX, YY + 720), Clr~&: PSET (XX + 1280, YY + 720), Clr~& 'Mirrored vertically & then both H & V
  238. NEXT '-------------------------------------------------------------------------------
  239.  
  240.  
  241.  
  242. Stars_Near:
  243.  
  244. '------------------------- R A N D O M  S T A R S  (CLOSER) -------------------------
  245. FOR I = 1 TO 150 'How Many Stars
  246.  
  247.     XX = RND(1) * 1280 'Random location in UL quarter of Large BG
  248.     YY = RND(1) * 720 ' (to be MIRRORED below)
  249.  
  250.     Clr~& = _RGB(255, 255, 255) 'Default to brightest white
  251.  
  252.     IF RND < .4 THEN Grey = 255: GOTO Put_CIRC: GOTO Put_Star2 'Largest, closest, BRIGHTEST stars
  253.     IF RND < .4 THEN Grey = 255: GOTO Put_Star2 'Max BRIGHT for this star
  254.  
  255.     Grey = RND * 100 + 150 'Mid to Full Brightness
  256.  
  257.     Clr~& = _RGB(Grey, Grey, Grey) 'Random intensities of GREY only
  258.     IF RND < .015 THEN Clr~& = _RGB(RND * 56 + 200, 50, 30) ELSE IF RND > .97 THEN Clr~& = _RGB(20, 60, RND * 56 + 200) 'Red or Blue star this time?
  259.  
  260.     Put_Star2:
  261.     PSET (XX, YY), Clr~&: PSET (XX + 1280, YY), Clr~& 'Mirrored horizontally
  262.     PSET (XX, YY + 720), Clr~&: PSET (XX + 1280, YY + 720), Clr~& 'Mirrored vertically & then both H & V
  263.     GOTO NexStar
  264.  
  265.     Put_CIRC:
  266.     CIRCLE (XX, YY), 1, Clr~& ': CIRCLE (XX + 1280, YY), 1, Clr~& 'Mirrored horizontally
  267.     'CIRCLE (XX, YY + 720), 1, Clr~&: CIRCLE (XX + 1280, YY + 720), 1, Clr~& 'Mirrored vertically & then both H & V
  268.  
  269.     NexStar:
  270. NEXT '-------------------------------------------------------------------------------
  271.  
  272.  
  273.  
  274.  


The attached images show the raw, untouched galaxy (TOP) as outputted by the program, as well an example of how it can look after touching up in a free app such as IrfanView.I prefer to blur the galaxy because the individual pixels appear much too large to be actual stars in a typical galaxy.  So, better that they represent clusters of stars.  I guess.
Galaxy_RAW_CIRCULAR_Spiral_01.gif
* Galaxy_RAW_CIRCULAR_Spiral_01.gif (Filesize: 430.17 KB, Dimensions: 845x823, Views: 170)
Galaxy_PROCESSED_ELLIPTICAL_Spiral_01.gif
* Galaxy_PROCESSED_ELLIPTICAL_Spiral_01.gif (Filesize: 137.87 KB, Dimensions: 845x206, Views: 176)
« Last Edit: September 04, 2019, 12:43:34 am by SirCrow »
I may not always finish what I've started....

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: GALAXY Generator
« Reply #1 on: September 04, 2019, 12:50:58 am »
Great graphic!

Offline SirCrow

  • Forum Regular
  • Posts: 144
    • View Profile
Re: GALAXY Generator
« Reply #2 on: September 04, 2019, 12:54:59 am »
I may not always finish what I've started....

Offline Qwerkey

  • Forum Resident
  • Posts: 755
    • View Profile
Re: GALAXY Generator
« Reply #3 on: September 04, 2019, 07:48:54 am »
Hmm.  Whilst SirCrow is working on a Galaxy Generator, I'm working on a Crossword Generator.  I'm rather at the lower end of the spectrum.  From the cosmologically sublime to the terrestrially ridiculous.
« Last Edit: September 07, 2019, 06:36:16 am by Qwerkey »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: GALAXY Generator
« Reply #4 on: September 04, 2019, 09:58:28 am »
Hmm.  Whilst SirCrow is working on a Galaxy Generator, I'm working on a Crosswrod Generator.  I'm rather at the lower end of the spectrum.  From the cosmologically sublime to the terrestrially ridiculous.

Well I am done with maze generator and just amazed! by all of us :)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: GALAXY Generator
« Reply #5 on: September 04, 2019, 02:54:26 pm »
Pretty awesome! I like how you can make a totally different one by pressing Enter.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: GALAXY Generator
« Reply #6 on: September 05, 2019, 07:53:13 am »
Cool, nothing less than cool!
Programming isn't difficult, only it's  consuming time and coffee

Offline SirCrow

  • Forum Regular
  • Posts: 144
    • View Profile
Re: GALAXY Generator
« Reply #7 on: September 05, 2019, 07:23:50 pm »
Cool, nothing less than cool!

Thank you, nothing less than thank you!
I may not always finish what I've started....

Offline SirCrow

  • Forum Regular
  • Posts: 144
    • View Profile
Re: GALAXY Generator
« Reply #8 on: September 05, 2019, 09:51:03 pm »
Pretty awesome! I like how you can make a totally different one by pressing Enter.

Thanks.  If I continue working on it for a while, it'll probably have more variety than it has now.  It's already improved since I uploaded it.
I may not always finish what I've started....

Offline SirCrow

  • Forum Regular
  • Posts: 144
    • View Profile
Re: GALAXY Generator
« Reply #9 on: September 05, 2019, 09:55:28 pm »
Hmm.  Whilst SirCrow is working on a Galaxy Generator, I'm working on a Crosswrod Generator.  I'm rather at the lower end of the spectrum.  From the cosmologically sublime to the terrestrially ridiculous.

I'll check out your crossword maker when I have the chance.  I'm sure it'll turn out to be more impressive than my galaxy simulator.
I may not always finish what I've started....