You should be able to waste many hours of your life watching this.
A star has just exploded
Windows only
edit: 8.16.2018 made a small change, WaitWindowEvent(1) instead of WindowEvent().
edit: 8.17.2018 improved collision detection, added more comments in code, streamlined some code.
edit: 8.18.2018 improved gravity interaction of smaller objects, added more comments.
edit: 8.26.2018 improved collision detection so drawing circles on invisible screen is not required.
this made a significant reduction in CPU usage.
edit: 1.28.2019 added secondary ejections from collision events.
Code: Select all
; MatterEvolution.pb
; Accretion and evolution of matter, graphic animation
; Author: BasicallyPure
; License: free
; Compiler: PureBasic 5.62
; tested on windows 7
; Date: 1.28.2019
; Version: 1.8
; Forum topic: https://www.purebasic.fr/english/viewtopic.php?f=12&t=71235
EnableExplicit
#ScreenColor = $000000 ; screen background color
#NovaMass = 70 ; do not change this!!!
#Tau = #PI * 2
#Gravity = 0.45 ; gravitational constant
#GravRange = 450 ; max range for gravity calculations
#imgBackground = 0
Structure objectParameters
x.d ; x location
y.d ; y location
xVel.d ; x velocity
yVel.d ; y velocity
mass.i
EndStructure
If ExamineDesktops()
Global DH = DesktopHeight(0)
Global DW = DesktopWidth(0)
Global mid_X = DW/2 - 1
Global mid_Y = DH/2 - 1
Global ObjectCount = DW*DH / 8000 ; determine ammount of matter in universe
Global Dim MidC.i(70) ; array for midpoint color of stars
Global Dim Object.objectParameters(ObjectCount)
Else
End
EndIf
Declare INIT_GUI()
Declare MAIN_LOOP()
Declare MAKE_STAR(sprNum, mass)
Declare NOVA(index,strikeForce)
Declare STAR_COLOR(mass)
Declare START_EXPANSION()
Declare VERIFY(result, message$)
Macro RndFloat
; produce a random float number (0 < number < 1)
((Random(2147483645)+1) / 2147483647)
EndMacro
Macro Distance(x1,x2,y1,y2)
; distance between two points
Sqr((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1))
EndMacro
INIT_GUI()
START_EXPANSION()
MAIN_LOOP()
End
;{ ---------------------- procedures --------------------------
Procedure INIT_GUI()
Protected s, x, y,yp, event
VERIFY(InitSprite(),"InitSprite()")
VERIFY(InitKeyboard(),"InitKeyboard()")
VERIFY(UsePNGImageDecoder(),"UsePNGImageDecoder")
VERIFY(OpenWindow(0,0,0,DW,DH,"Matter Evolution",#PB_Window_BorderLess),"OpenWindow()")
VERIFY(OpenWindowedScreen(WindowID(0),0,0,DW,DH),"OpenWindowedScreen()")
VERIFY(CreatePopupMenu(0),"CreatePopupMenu()")
MenuItem(1,"pause/resume")
MenuItem(2,"restart")
MenuItem(3,"quit")
;{ ------- sprites for non-stellar objects -------
CreateSprite(1,3,3)
TransparentSpriteColor(1, #ScreenColor)
midC(1) = $FF4040
StartDrawing(SpriteOutput(1))
Box(0,0,3,3,#ScreenColor)
Circle(1,1,1,midC(1))
Plot(1,1,#ScreenColor)
StopDrawing()
CreateSprite(2,5,5)
TransparentSpriteColor(2, #ScreenColor)
midC(2) = $FF7050
StartDrawing(SpriteOutput(2))
Box(0,0,5,5,#ScreenColor)
Circle(2,2,2,midC(2))
Plot(2,2,#ScreenColor)
StopDrawing()
CreateSprite(3,7,7)
TransparentSpriteColor(3, #ScreenColor)
midC(3) = $FFA060
StartDrawing(SpriteOutput(3))
Box(0,0,7,7,#ScreenColor)
Circle(3,3,3,midC(3))
Plot(3,3,#ScreenColor)
StopDrawing()
;} -----------------------------------------------
For s = 4 To 70 : MAKE_STAR(s, s) : Next s ; create all star sprites
LoadFont(1, "Arial", 24)
LoadFont(2, "Arial", 18)
LoadImage(#imgBackground,"background.png")
ClearScreen(#ScreenColor)
StartDrawing(ScreenOutput())
If IsImage(#imgBackground) : DrawImage(ImageID(#imgBackground),0,0) : EndIf
DrawingFont(FontID(1))
FrontColor($FFF6A2)
y = 10
DrawText(10,y,"Accretion and Evolution of matter in a 2D universe.",$A2FDFF)
y + TextHeight("A") + 10
DrawingFont(FontID(2))
DrawText(10,y,"Keyboard: 'Esc' = quit")
y = y + TextHeight("A") + 5
DrawText(10,y,"Keyboard: 'Space' = pause / unpause")
y = y + TextHeight("A") + 5
DrawText(10,y,"Keyboard: 'Enter' = restart the simulation")
y = y + TextHeight("A") + 5
y = y + TextHeight("A") + 5
DrawText(10,y,"Mouse: 'Right click' = menu")
y = y + TextHeight("A") + 5
y = y + TextHeight("A") + 5
DrawText(10,y,"Press any key or click mouse to continue...",$BEA2FF)
yp = y +TextHeight("A") + 15
StopDrawing()
x = 20
For s = 1 To 28
y = yp + (SpriteHeight(28) - SpriteHeight(s))/2
DisplayTransparentSprite(s,x,y)
x + SpriteWidth(s) + 10
Next s
x = 20 : yp = y + SpriteHeight(29)
For s = 29 To 42
y = yp + (SpriteHeight(42) - SpriteHeight(s))/2
DisplayTransparentSprite(s,x,y)
x + SpriteWidth(s) + 5
Next s
x = 20 : yp = y + SpriteHeight(43)
For s = 43 To 53
y = yp + (SpriteHeight(53) - SpriteHeight(s))/2
DisplayTransparentSprite(s,x,y)
x + SpriteWidth(s) + 5
Next s
x = 20 : yp = y + SpriteHeight(54)
For s = 54 To 62
y = yp + (SpriteHeight(62) - SpriteHeight(s))/2
DisplayTransparentSprite(s,x,y)
x + SpriteWidth(s) + 5
Next s
x = 20 : yp = y + SpriteHeight(63)
For s = 63 To 70
y = yp + (SpriteHeight(70) - SpriteHeight(s))/2
DisplayTransparentSprite(s,x,y)
x + SpriteWidth(s) + 5
Next s
FlipBuffers()
Repeat
Repeat
event = WaitWindowEvent(1)
If event = #WM_LBUTTONUP
Break 2
EndIf
Until event = 0
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_All)
FreeFont(1) : FreeFont(2)
EndProcedure
Procedure MAIN_LOOP()
Protected Event, Quit, pause = #False, hCursor, timerActive = #False
Protected d.d, f.d, dir.d, cdf.d, sdf.d, m, n, r, StrikeMass
Protected SFX.d, SFY.d, SF.d
Protected lim_X = DW - 1, lim_Y = DH - 1
Protected blinkMass = #NovaMass * 0.9
Protected holdoff = ObjectCount * 90
Macro StartCursorCountdown()
AddWindowTimer(0,0,4000) : timerActive = #True
EndMacro
StartCursorCountdown()
Repeat
;{ window event loop
Repeat
Event = WindowEvent()
Select Event
Case #WM_MOUSEMOVE
If timerActive = #False
StartCursorCountdown()
EndIf
Case #PB_Event_Timer
hCursor = SetCursor_(#Null)
RemoveWindowTimer(0,0)
timerActive = #False
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_RightClick
DisplayPopupMenu(0, WindowID(0))
Case #PB_Event_LeftClick
StartCursorCountdown()
Case #PB_Event_Menu
Select EventMenu()
Case 1 ; pause
pause ! 1
StartCursorCountdown()
Case 2 ; restart the simulation
holdoff = ObjectCount * 120
START_EXPANSION()
pause = #False
StartCursorCountdown()
Case 3
Quit = #True
EndSelect
EndSelect
Until Not Event : ;}
If pause = #False
With Object(n)
ClearScreen(#ScreenColor)
For n = 0 To ObjectCount ; draw active sprites
If \mass ; ignore massless objects
If \mass > blinkMass ; indicates a star is unstable
m = Random(70, 60)
DisplayTransparentSprite(m,\x-m,\y-m)
Else
DisplayTransparentSprite(\mass,\x-\mass,\y-\mass)
EndIf
EndIf
Next n
StartDrawing(ScreenOutput())
For n = 0 To ObjectCount ; collision detection loop
If \mass
If holdoff ; delay collision detection on startup
holdoff - 1
ElseIf Point(\x,\y) <> #ScreenColor ; a possible collision
For m = 0 To ObjectCount ; find the object of collision
If Object(m)\mass ; objects with mass 0 are ignored
r = (\mass + Object(m)\mass) ; sum of objects radii
d = Distance(\x, Object(m)\x, \y, Object(m)\y)
If r > d And d > 0 ; process collision
If Object(m)\mass > \mass ;locate to the object With largest mass
\x = Object(m)\x
\y = Object(m)\y
StrikeMass = \mass
Else
StrikeMass = Object(m)\mass
EndIf
; calculate strike force
SFX = (StrikeMass * Pow(Object(n)\xVel - Object(m)\xVel,2)) / 2
SFY = (StrikeMass * Pow(Object(n)\yVel - Object(m)\yVel,2)) / 2
SF = Sqr(SFX*SFX + SFY*SFY)
If SF > StrikeMass : SF = StrikeMass : EndIf
; momentum is conserved during collisions
\xVel = \xVel*(\mass/r) + Object(m)\xVel*(Object(m)\mass/r)
\yVel = \yVel*(\mass/r) + Object(m)\yVel*(Object(m)\mass/r)
\mass = \mass + Object(m)\mass ; mass is conserved during collisions
Object(m)\mass = 0 ; merged object becomes invisible ghost particle
If \mass >= #NovaMass ; the star explodes
NOVA(n, 0)
ElseIf SF >= 0.5 ; partial fragmentation
NOVA(n, SF)
EndIf
Break ; finished with collision event
EndIf
EndIf
Next m
EndIf
EndIf
Next n
For n = 0 To ObjectCount
If \mass
Plot(\x, \y, MidC(\mass)) ; color correction for midpoint of sprite
\x + \xVel : \y + \yVel ; update object positions
; handle screen boundary crossings
If \x > lim_X : \x = lim_X - Int(\x) : EndIf
If \x < 0 : \x = lim_X + Int(\x) : EndIf
If \y > lim_Y : \y = lim_Y - Int(\y) : EndIf
If \y < 0 : \y = lim_Y + Int(\y) : EndIf
If \mass > 3 ; do gravity calculation
For m = 0 To ObjectCount
If m <> n And Object(m)\mass <> 0
d = Distance(\x, Object(m)\x, \y, Object(m)\y)
If d < #GravRange ; no calculations beyond this distance
f = (#Gravity * \mass * Object(m)\mass) / (d*d) ; force between objects
If Object(m)\mass < 4 : f * 2 : EndIf
dir = ATan2(\x - Object(m)\x, \y - Object(m)\y) ; force direction
cdf = Cos(dir) * f ; cosine direction * force
sdf = Sin(dir) * f ; sine direction * force
; adjust velocity of object 1
\xVel - (cdf / \mass)
\yVel - (sdf / \mass)
; adjust velocity of object 2
Object(m)\xVel + (cdf / Object(m)\mass)
Object(m)\yVel + (sdf / Object(m)\mass)
EndIf
EndIf
Next m
EndIf ; end gravity calculation
EndIf
Next n
StopDrawing()
EndWith
EndIf
FlipBuffers()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Space) : pause ! 1 : EndIf ; toggle pause
If KeyboardPushed(#PB_Key_Escape) : Quit = #True : EndIf
If KeyboardReleased(#PB_Key_Return): PostEvent(#PB_Event_Menu,0,2) : EndIf
Until Quit = #True
EndProcedure
Procedure MAKE_STAR(sprNum, mass)
Protected c, centerColor, starColor, radius = mass
c = STAR_COLOR(mass)
centerColor = (c >> 24)
centerColor = centerColor | centerColor<<8 | centerColor<<16
starColor = c & $FFFFFF
MidC(sprNum) = centerColor
CreateSprite(sprNum,radius*2+1,radius*2+1)
TransparentSpriteColor(sprNum, #ScreenColor)
StartDrawing(SpriteOutput(sprNum))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,SpriteWidth(sprNum),SpriteWidth(sprNum),#ScreenColor)
FrontColor(#ScreenColor)
BackColor(centerColor) ;center of star
DrawingMode(#PB_2DDrawing_Gradient)
CircularGradient(mass, mass, radius)
GradientColor(0.6,starColor) ; main star color
Circle(mass,mass,radius,#ScreenColor) ; color has no effect
DrawingMode(#PB_2DDrawing_Default)
Plot(mass,mass,#ScreenColor)
StopDrawing()
EndProcedure
Procedure NOVA(index, strikeForce)
; do nova explosion or collision ejections
Protected mass = Object(index)\mass, speedFactor.d = 0.5, rMltp.d = 30, cRadius.i
Protected x = Object(index)\x
Protected y = Object(index)\y
Protected lim_X = DW-1, lim_Y = DH-1
Protected d.d, s.d, n.i = 0
If strikeForce <> 0 ; collision ejections
cRadius = mass
mass = strikeForce
speedFactor = 0.30
Object(index)\mass - mass
If Object(index)\mass < 0 : Object(index)\mass = 0 : EndIf
Else ; full nova explosion
Object(index)\mass = 0
EndIf
While mass > 0
With Object(n)
If \mass = 0
\x = x
\y = y
d = RndFloat * #Tau ; initial direction
s = speedFactor + RndFloat ; initial speed
\xVel = s * Sin(d)
\yVel = s * Cos(d)
\mass = 1
If strikeForce <> 0
rMltp = cRadius
EndIf
\x + \xVel * rMltp
If \x > lim_X : \x = Int(\x) - lim_X : EndIf
If \x < 0 : \x = lim_X + Int(\x) : EndIf
\y + \yVel * rMltp
If \y > lim_Y : \y = Int(\y) - lim_Y : EndIf
If \y < 0 : \y = lim_Y + Int(\y) : EndIf
mass - 1
EndIf
n + 1
EndWith
Wend
EndProcedure
Procedure STAR_COLOR(mass)
; produces 70 possible star colors
; 7 classes of stars with 10 sub-classes each
; mass should range from 1 to #NovaMass
Protected color, cv = $FF - 70
Protected value.d
Protected RefMass.d = #NovaMass / 70
mass = mass / RefMass
value.d = mass * (RefMass / #NovaMass)
If mass > $FF : mass = $FF : EndIf
If cv < 0 : cv = 0 : EndIf
If value <= 1/7 ; type M
color = $0000AE + ($000709 * (Round(value * 70, #PB_Round_Nearest) -1))
ElseIf value <= 2/7 ; type K
color = $003FFF + ($000B00 * Round((value - 1/7) * 70, #PB_Round_Nearest))
ElseIf value <= 3/7 ; type G
color = $00ADFF + ($000800 * Round((value - 2/7) * 70, #PB_Round_Nearest))
ElseIf value <= 4/7 ; type F
color = $00FDFF + ($0C0000 * Round((value - 3/7) * 70, #PB_Round_Nearest))
ElseIf value <= 5/7 ; type A
color = $78FDFF + ($0C0000 * Round((value - 4.0/7) * 70, #PB_Round_Nearest))
ElseIf value <= 6/7 ; type B
color = $FFFFFF - ($000404 * (Round((value - 5/7) * 70, #PB_Round_Nearest) -1))
Else ; type O
color = $FFDBDB - ($000A0A * Round((value - 6/7) * 70, #PB_Round_Nearest))
EndIf
cv = cv + (70 * value)
ProcedureReturn color | (cv << 24)
EndProcedure
Procedure START_EXPANSION()
; set all objects in motion
Protected n, d.d, s.d
For n = 0 To ObjectCount
Object(n)\x = mid_X
Object(n)\y = mid_Y
d = RndFloat * #Tau ; initial direction
s = 0.1 + RndFloat * 1.4 ; initial speed
Object(n)\xVel = s * Sin(d)
Object(n)\yVel = s * Cos(d)
Object(n)\mass = 1
Object(n)\x + Object(n)\xVel * 25
Object(n)\y + Object(n)\yVel * 25
Next
EndProcedure
Procedure VERIFY(result, message$)
If result = 0
MessageRequester("Error!", message$ + " has failed.")
End
Else
ProcedureReturn result
EndIf
EndProcedure : ;}
couldnt be bothered to change to windows :0 so here it is for linux 
