Res_X = 1280: Res_Y = 720
'[ ] [ ] [ ] [ ] [ ] [ ] [ ]
'[ ] [ ] [ ] [ ] [ ] [ ] [ ]
Gal_X = Res_X / 2: Gal_Y = Res_Y / 2:: H_Mod = 1
::: BasClr~&
= _RGB(255, 233, 144) '!!! NOTE: This BASIC Galaxy colour must match one in "SELECT CASE BasClr~&" near LOOP's bottom !!!
MaxRad = 400:: AngInc = 1:: SpCnt = 24 'How many arms
' MaxRad.........Half the Galaxy's full width SpCnt.........Number of spiral arms in Galaxy
' H_Mod..........Height modifier (Galaxy; 1 = circle) AngInc........Angle increment (along each arm)
DO UNTIL INKEY$ = CHR$(27) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'GOSUB Stars_Far 'Stars for lookin' at
'GOSUB Stars_Near
FOR Arm
= 1 TO SpCnt
'for each SPIRAL/arm of Galaxy
CA! = (Arm / SpCnt) * 360 'Each spiral Arm's "angle" (position in degrees)
Ang = 0:: SpRad = 10:: Inter = 0:: EVEN = 0 'Starting angle, dist. fr. ctr. + "inbetween" or not
IF Arm
/ 2 = INT(Arm
/ 2) THEN EVEN
= -1 'Intermittent (every other, even) arm
IF Inter
THEN 'the "inbetween", maybe lesser arms MaxLen
= RND * 30 + 300:: Max_W
= 140 ELSE 'the "main", boldest arms MaxLen
= RND * 50 + 300:: Max_W
= 110 'Likely longer & more dense
::: Arm_W = Max_W 'Arm width that dwindles from ctr. outward
FOR A
= 1 TO MaxLen
'each step along arm's length... **********************************************
'::: _LIMIT 70
Ang
= Ang
+ AngInc::
IF Ang
> 359 THEN Ang
= Ang
- 360 'AngInc = Angle increment (1, 2, etc.)
PX
= Gal_X
+ SIN(_D2R(CA!
+ Ang
)) * SpRad
'/ 3 'Divisor here makes a VERTICAL E L L I P S E PY
= Gal_Y
+ COS(_D2R(CA!
+ Ang
)) * SpRad
/ H_Mod
'...horizontal
':::: CIRCLE (PX, PY), 2, _RGB(6, 205, 0) '_RGB(255 - A, 255 - A, 255 - A)
':::: GOTO NexRadAng '* * * * TESTING ONLY * * * *
'IF Inter THEN ParCnt = MaxLen / 2 - A / 6 ELSE ParCnt = MaxLen * .7 - A
IF Inter
THEN ParCnt
= MaxLen
/ 1.5 - A
/ 1.02 ELSE ParCnt
= MaxLen
- A
'Inbetween' arms thin out quicker
IF ParCnt
< 9 THEN ParCnt
= 9 'Don't let cluster thin out too much
PC = 0
FOR P
= 1 TO ParCnt
'Was: TO MaxLen - A Create clusters of pixels (stars) to hide the Get_PPXY:: PC
= PC
+ 1::
IF PC
> 400 GOTO NexP
' gaps between points (PX, PY) along the spiral.
PPX
= PX
+ RND * Arm_W
- Arm_W
/ 2 '40 - 20 PPY
= PY
+ RND * Arm_W
- Arm_W
/ 2 ' Arm_W - Arm_W / 2 '14 - 7 'Same thickness X/Y 'PPY = PY + RND * Arm_W / 2.5 - Arm_W / 5 ' Arm_W - Arm_W / 2 '14 - 7 'Narrower vertically
'IF ((PPX - PX) ^ 2) + ((PPY - PY) ^ 2) > 20 ^ 2 GOTO Get_PXY 'Stay within a circle/elipse
IF ((PPX
- PX
) ^ 2) + ((PPY
- PY
) ^ 2) > Arm_W
^ 2 GOTO Get_PPXY
'Stay within a circle/elipse
NexP:
'Every few thin (non-dense) arms, enhance arm w/ a broken string of bright stars or mini-clusters...
NexRadAng::
'SpRad = SpRad - 3 ' .64 '.67 'Inward from edge * * * * Likely OBSOLETE * * * *
SpRad = SpRad + 1 '.67 '1 'Outward from center
Arm_W = Arm_W - Max_W / MaxLen
'Arm_W = Arm_W - MaxLen / (MaxLen - Arm_W)
'Arm_W = Arm_W - (MaxLen - Arm_W) / MaxLen
'::: _PRINTSTRING (PX, PY), STR$(Ang) '+ " " + STR$(PX) + STR$(PY)
NEXT 'Angle (step along arm/spiral) ****************************************************************
NexArm: '::: SLEEP
'* ** *** Now, ENHANCE/thicken our Galaxy's CENTER area with larger, multi-coloured particles *** ** *
FOR C
= 1 TO 2 'Clusters of Particles (LARGER first, then smaller/denser @ centre)
Radius = SpRad / 3 / C * 1.7 ' 1.3
FOR P
= 1 TO 2400 / C
'No. of particles to enhance/intensify Galaxy's center
Get_PP2:
PPX
= Gal_X
+ RND * Radius
* 2 - Radius
'/ 2 'Particle's X pos. PPY
= Gal_Y
+ RND * Radius
* 2 - Radius
'Particle's Y 'PPY = Gal_Y + RND * Radius * 2 / H_Mod - Radius / H_Mod 'Particle's Y (narrower vertically)
PDist
= SQR((PPX
- Gal_X
) ^ 2 + (PPY
- Gal_Y
) ^ 2) 'This particle's distance to Galaxy ctr.
IF Radius
/ (4 - C
) - (PDist
- RND * Radius
) < PDist
GOTO Get_PP2
'Thin out the edge/boundary 'ABOVE: The closer to center, the less likely it'll be rejected ----------
IF (PPX
- Gal_X
) ^ 2 + (PPY
- Gal_Y
) ^ 2 > Radius
^ 2 GOTO Get_PP2
'Stay within the circle/ellipse '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
'!!! Line above, based on Pythagoras-type equation below, SHOULD work....but does NOT !!!
'****** (x-h) ^ 2 / a^2 + (y-k) ^ 2 / b^2 <= 1 a...Ellipse's width b...height h,k...its center ******
'::: : PRINT P, ((PPX - Gal_X) ^ 2) / (SpRad * 2) ^ 2 + ((PPY - Gal_Y) ^ 2) / (SpRad * 2 / H_Mod) ^ 2
'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) '
'ABOVE: Mostly [near-] WHITE particles, and much denser white nearest center;
' also, some black/dark spots for effect (imperfections, blemishes)
':::: IF C = 2 THEN COLOR _RGB(0, 211, 0):::: '* * * * TEST COLOR for CENTER cluster * * * *
IF C
= 1 THEN Rad
= 2 ELSE Rad
= 3 'Smaller ctr. cluster is of larger solid dots
'_AUTODISPLAY
MR = MR - 5: MG = MG - 5: MB = MB - 5 'Screen-res text FADES away
'MR = MR - Res_X / 170: MG = MG - Res_X / 170: MB = MB - Res_X / 170 'Screen-res text FADES away
'IF MR > 39 THEN 'Show SHADOW until text is very dark
' 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 --
' IF M2$ > "" THEN:::: _PRINTSTRING (Res_X / 2 - 3 - _PRINTWIDTH(M2$) / 2, Res_Y / 2 + 37), M2$ 'Shadow, line 2 (maybe)
'END IF
':::: BEEP
K$
= INKEY$ 'WHILE INKEY$ > "": WEND INKEY$
CASE "+", "=", "-", "_"::
SOUND 5555, .5 'Change how many spiral Arms in Galaxy
IF SpCnt
> 1 AND K$
= "-" OR K$
= "_" THEN SpCnt
= SpCnt
- 2: _
IF SpCnt
<= 2 THEN SpCnt
= 2 ::
SOUND 3333, 1 'Reduce #
IF SpCnt
< 49 AND K$
= "+" OR K$
= "=" THEN SpCnt
= SpCnt
+ 2: _
IF SpCnt
>= 48 THEN SpCnt
= 48::
SOUND 3333, 1 'Increase
Msg_Time
= TIMER: Msg_Dur
= 7: MR
= 255: MG
= 255: MB
= 255 Message$
= "How Many Arms:" + STR$(SpCnt
):: M2$
= "" '
FMsg&
= _LOADFONT("LiberationSans-Bold.ttf", 30)
CASE _RGB(255, 233, 144): BasClr~&
= _RGB(122, 233, 0) ' Yellow ---> Green CASE _RGB(122, 233, 0)::: BasClr~&
= _RGB(0, 128, 255) ' Green ----> Blue CASE _RGB(0, 128, 255)::: BasClr~&
= _RGB(100, 83, 255) ' Blue -----> Purple CASE _RGB(100, 83, 255):: BasClr~&
= _RGB(255, 105, 89) ' Purple ---> Red CASE _RGB(255, 105, 89):: BasClr~&
= _RGB(255, 161, 44) ' Red ------> Orange/Amber CASE _RGB(255, 161, 44):: BasClr~&
= _RGB(255, 233, 144) 'Orange ---> Yellow
'_DISPLAY:: SLEEP::
'K$ = INKEY$ 'WHILE INKEY$ > "": WEND INKEY$
Stars_Far:
'------------------------ R A N D O M S T A R S (FARTHER) -------------------------
FOR I
= 1 TO 6500 'How Many Stars
XX
= RND(1) * 1280 'Random location in UL quarter of Large BG YY
= RND(1) * 720 ' (to be MIRRORED below)
Clr~&
= _RGB(255, 255, 255) 'Default to brightest white
'Grey = RND * 100 + 100 'Random grey shade, but not too dim
Grey
= RND * 150 + 50 'Random grey shade, but not too dim
Clr~&
= _RGB32(Grey
, Grey
, Grey
) 'Random intensities of GREY only
Put_Star:
PSET (XX
, YY
), Clr~&
': PSET (XX + 1280, YY), Clr~& 'Mirrored horizontally 'PSET (XX, YY + 720), Clr~&: PSET (XX + 1280, YY + 720), Clr~& 'Mirrored vertically & then both H & V
NEXT '-------------------------------------------------------------------------------
Stars_Near:
'------------------------- R A N D O M S T A R S (CLOSER) -------------------------
FOR I
= 1 TO 150 'How Many Stars
XX
= RND(1) * 1280 'Random location in UL quarter of Large BG YY
= RND(1) * 720 ' (to be MIRRORED below)
Clr~&
= _RGB(255, 255, 255) 'Default to brightest white
IF RND < .4 THEN Grey
= 255:
GOTO Put_CIRC:
GOTO Put_Star2
'Largest, closest, BRIGHTEST stars IF RND < .4 THEN Grey
= 255:
GOTO Put_Star2
'Max BRIGHT for this star
Grey
= RND * 100 + 150 'Mid to Full Brightness
Clr~&
= _RGB(Grey
, Grey
, Grey
) 'Random intensities of GREY only
Put_Star2:
PSET (XX
, YY
), Clr~&:
PSET (XX
+ 1280, YY
), Clr~&
'Mirrored horizontally PSET (XX
, YY
+ 720), Clr~&:
PSET (XX
+ 1280, YY
+ 720), Clr~&
'Mirrored vertically & then both H & V
Put_CIRC:
CIRCLE (XX
, YY
), 1, Clr~&
': CIRCLE (XX + 1280, YY), 1, Clr~& 'Mirrored horizontally 'CIRCLE (XX, YY + 720), 1, Clr~&: CIRCLE (XX + 1280, YY + 720), 1, Clr~& 'Mirrored vertically & then both H & V
NexStar:
NEXT '-------------------------------------------------------------------------------
