Fireworks v0.60 build 2020-07-13 beta

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Fireworks v0.60 build 2020-07-13 beta

Post by UEZ »

A little bit late but happy new year! ¯\_(ツ)_/¯

Fireworks.bas

Code: Select all

'Fireworks v0.50 build 2020-07-13 beta coded by UEZ
'Credits To:
'               D.J.Peters aka Joshy For the SimplexNoise2D() Function
'               dodicat For the Regulate() Function

#Include "fbgfx.bi"
#Include "String.bi"

Using FB

Dim As String sTitle = "Simple Fireworks v0.50 build 2020-07-13 beta coded by UEZ"

Declare Function RandomRange(fStart As Single, fEnd As Single) As Single
Declare Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long

Dim Shared As Integer iDW, iDH, scrw, scrh
Screencontrol GET_DESKTOP_SIZE, iDW, iDH
scrw = iDW * 0.95
scrh = iDH * 0.85

Const iParticlesTail = 6, fGravity = 0.75, fRad = Acos(-1) / 180

Randomize Timer, 2

'--------------------------------------------------------------------------------------------------
Type float As Single 'Double 
 
Dim Shared As Integer perm(512) = { _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180, _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180} 

Function SimplexNoise2D(xin As float, yin As float, scale As float = 20.0) As float 'by D.J.Peters aka Joshy
  Const As float F2 = 0.5*(Sqr(3.0)-1.0) 
  Const As float G2 = (3.0-Sqr(3.0))/6.0 
  Const As float G22 = G2 + G2
  Static As Integer grad2(11,1) = {{ 1, 1},{-1, 1},{1,-1},{-1,-1}, _
                                   { 1, 0},{-1, 0},{1, 0},{-1, 0}, _
                                   { 0, 1},{ 0,-1},{0, 1},{ 0,-1}} 
  Dim As float s = (xin+yin)*F2
  Dim As Integer i = Int(xin+s)
  Dim As Integer j = Int(yin+s)
  Dim As float t = (i+j)*G2 
  Dim As float x  = i-t  , y = j-t 
  Dim As float x0 = xin-x, y0 = yin-y 
  Dim As Integer i1=Any, j1=Any
  i And=255
  j And=255
  
  If (x0>y0) Then
    i1=1: j1=0
  Else
    i1=0: j1=1
  End If         

  Dim As float x1 = x0 - i1 + G2 
  Dim As float y1 = y0 - j1 + G2 
  Dim As float x2 = x0 - 1.0 + G22 
  Dim As float y2 = y0 - 1.0 + G22 
  Dim As Integer ii = i 'And 255 
  Dim As Integer jj = j 'And 255 
  Dim As Integer ind = Any
  Dim As float n=Any
  t = 0.5 - x0*x0-y0*y0 
  If (t<0) Then
    n=0
  Else 
    ind = perm(i+perm(j)) Mod 12 
    n = t*t*t*t  * (grad2(ind,0)*x0 + grad2(ind,1)*y0)
  End If 
  t = 0.5 - x1*x1-y1*y1 
  If (t<0) Then
  Else 
    ind = perm(i+i1+perm(j+j1)) Mod 12 
    n+= t*t*t*t  * (grad2(ind,0)*x1 + grad2(ind,1)*y1)
  End If 
  t = 0.5 - x2*x2-y2*y2 
  If(t<0) Then 
  Else
    i+=1:j+=1  
    ind= perm(i+perm(j)) Mod 12 
    n+= t*t*t*t  * (grad2(ind,0)*x2 + grad2(ind,1)*y2)
  End If 
  ' scaled in the interval [-1,1]. 
  Return scale * n
End Function 

'--------------------------------------------------------------------------------------------------
Type tagBoom
	As Single	power
	As Single 	x
	As Single 	y
	As Single 	vx
	As Single 	vy
	As Ubyte  	r
	As Ubyte  	g
	As Ubyte  	b
	As Ubyte  	a
	As Single  	size
	As Ubyte	flag1
End Type

Type Kaboom
	Public:
		Declare Constructor()
		Declare Destructor()
		Declare Sub init()
		Declare Sub update()
		As Boolean detonate, set
		As Single rocketx, rockety, rocketvx, rocketvy, radius, life, heigh, power
		As tagBoom Boom(5000)
		As Ubyte r, g, b, a, rr, gg, bb, aa, c1, c2
		As Ulong particles
		As Ubyte KType, flimmer
End Type

Constructor Kaboom()
	This.Init()
End Constructor

Destructor Kaboom()
End Destructor

Sub Kaboom.init()
	This.detonate = False
	This.set = False
	This.rocketx = scrw / 2 + RandomRange(-scrw / 10, scrw / 10)
	This.rockety = scrh
	This.rocketvx = RandomRange(-5, 5)
	This.rocketvy = -(5 + Rnd() * 5)
	This.heigh = scrh * 0.15 + Rnd() * (scrh * 0.30)
	This.life = 255
	This.power = 0.99 - Rnd() * 0.03
	This.r = &hA0
	This.g = &hA0
	This.b = &hA0
	This.a = &hFF
	This.rr = &h40 + Rnd() * &h6F
	This.gg = &h40 + Rnd() * &h6F
	This.bb = &h40 + Rnd() * &h6F
	This.c1 = 0
	This.flimmer = 0
	If Rnd() > 0.75 Then This.flimmer = 1
	This.particles = 100 + Rnd() * 600
	Dim As Single RndRGBColor = Rnd()
    
    This.ktype = Cubyte(RandomRange(1, 3))
	Select Case This.ktype
		Case 3
			Dim As Single h, g = 360 / (This.particles - 1), r
			For i As Ulong = 0 To This.particles - 1
				This.Boom(i).power = 0.5 + Rnd() * 7
				This.Boom(i).vx = Sin(h * fRad) * This.Boom(i).power
				This.Boom(i).vy = Cos(h * fRad) * This.Boom(i).power
				If This.Boom(i).power > 6 - Rnd() * 2 Then
					This.Boom(i).size = 2
					Select Case RndRGBColor
						Case 0 To 0.33
							This.Boom(i).r = 250
							This.Boom(i).g = Rnd() * &h7F
							This.Boom(i).b = Rnd() * &h7F
						Case 0.34 To 0.66
							This.Boom(i).r = Rnd() * &h7F
							This.Boom(i).g = 250
							This.Boom(i).b = Rnd() * &h7F
						Case Else
							This.Boom(i).r = Rnd() * &h7F
							This.Boom(i).g = Rnd() * &h7F
							This.Boom(i).b = 250
					End Select
					This.Boom(i).a = This.a
				Else
					This.Boom(i).size = 1.333
					This.Boom(i).r = This.rr
					This.Boom(i).g = This.gg
					This.Boom(i).b = This.bb
					This.Boom(i).a = This.aa
				End If
				h += g
			Next
		Case 2
			For i As Ulong = 0 To This.particles - 1
				This.Boom(i).size = 1.333
				This.Boom(i).vx = RandomRange(-1.0, 1.0) * (0.5 + Rnd() * 5)
				This.Boom(i).vy = RandomRange(-1.0, 1.0) * (0.5 + Rnd() * 5)
				This.Boom(i).r = This.r + Rnd() * &h5F
				This.Boom(i).g = This.g + Rnd() * &h4F
				This.Boom(i).b = This.b + Rnd() * &h4F
				This.Boom(i).a = This.a
			Next			
		Case 1
			Dim As Single h, g = 360 / (This.particles - 1), r
			For i As Ulong = 0 To This.particles - 1
				This.Boom(i).power = 0.5 + Rnd() * 7
				This.Boom(i).vx = Sin(h * fRad) * This.Boom(i).power
				This.Boom(i).vy = Cos(h * fRad) * This.Boom(i).power
				If This.Boom(i).power > 6 - Rnd() * 2 Then
					This.Boom(i).size = 2
					This.Boom(i).r = This.r + Rnd() * &h5F
					This.Boom(i).g = This.g + Rnd() * &h5F
					This.Boom(i).b = This.b + Rnd() * &h5F
					This.Boom(i).a = This.a
				Else
					This.Boom(i).size = 1.333
					This.Boom(i).r = This.rr
					This.Boom(i).g = This.gg
					This.Boom(i).b = This.bb
					This.Boom(i).a = This.aa
				End If
				h += g
			Next
	End Select

End Sub

Sub Kaboom.Update()
	If This.rockety > This.heigh Then
		This.rocketx += This.rocketvx
		This.rockety += This.rocketvy
	Else
		If This.set = False Then
			For i As Ulong = 0 To This.particles - 1				
				This.Boom(i).x = This.rocketx
				This.Boom(i).y = This.rockety
				This.set = TRUE
			Next
			This.detonate = TRUE
		End If
		Dim As Ubyte aGlimmer(0 To 127) '= {255}
		aGlimmer(Int(Rnd * Ubound(aGlimmer))) = 255
		
		For i As Ulong = 0 To This.particles - 1
			This.Boom(i).x += This.Boom(i).vx
			This.Boom(i).y += This.Boom(i).vy + fGravity
			This.Boom(i).vx *= This.power
			This.Boom(i).vy *= This.power
			This.Boom(i).a = This.life
			If This.Boom(i).a < &h7F And This.flimmer = 1 Then 
				This.Boom(i).r = aGlimmer(This.c1)
				This.Boom(i).g = aGlimmer(This.c1)
				This.Boom(i).b = aGlimmer(This.c1)
				This.Boom(i).a = &hFF - This.life
				This.c1 += 1
				If This.c1 = Ubound(aGlimmer) Then This.c1 = 0
			Endif
		Next
		
		This.life -= 1
		'This.a = This.life * This.power
		If This.life = 0 Then This.init()
	EndIf
End Sub

'--------------------------------------------------------------------------------------------------
Type tagParticleTail
	As Single	x
	As Single	y
	As Single	vx
	As Single	vy
	As Ubyte	r
	As Ubyte	g
	As Ubyte	b
	As Ubyte	a
End Type

Type ParticleTail
	Declare Constructor()	
	Declare Destructor()
	Declare Sub Add(x As Single, y As Single, iLife As Ushort = 35, vx As Single = 0, vy As Single = 0) 
	As tagParticleTail ParticleTail(iParticlesTail - 1)
	As Ushort count
	As UShort life
End Type

Constructor ParticleTail()
	This.count = 0
End Constructor

Destructor ParticleTail()
End Destructor

Sub ParticleTail.Add(x As Single, y As Single, iLife As Ushort = 35, vx As Single = 0, vy As Single = 0)
	For i As Ubyte = 0 To iParticlesTail - 1	
		ParticleTail(i).x = x
		ParticleTail(i).y = y
		ParticleTail(i).vx = Iif(vx = 0, RandomRange(-0.25, 0.25), vx)
		ParticleTail(i).vy = Iif(vy = 0, Rnd() * 1, vy)
		ParticleTail(i).r = &hFF
		ParticleTail(i).g = &hB0
		ParticleTail(i).b = &h60
		ParticleTail(i).a = &hB0
	Next
	This.life = iLife
	This.count += 1
End Sub

'--------------------------------------------------------------------------------------------------
Type _Stack
	Public:
		As ParticleTail aStack(Any)
		As UInteger iPos = 1
		Declare Constructor()
		Declare Destructor()
		Declare Sub Push(Byref oPT As ParticleTail)
		Declare Function Get(iPos As UInteger) As ParticleTail
End Type

Constructor _Stack()
	Redim This.aStack(0 To 10000) As ParticleTail
End Constructor

Destructor _Stack()
	Redim This.aStack(0)
End Destructor

Sub _Stack.Push(Byref oPT As ParticleTail)
	If This.iPos > Ubound(This.aStack) Then
		Redim Preserve This.aStack(0 To This.iPos Shl 1)
	End If
	This.aStack(iPos) = oPT
	This.iPos += 1
End Sub

Function _Stack.Get(iPos As UInteger) As ParticleTail
	If iPos > 0 And iPos <= Ubound(This.aStack) Then Return This.aStack(iPos)
End Function

'--------------------------------------------------------------------------------------------------

Dim Shared As _Stack Stack1, Stack2

Type Fireworks
	Declare Constructor(iAmountRockets As Ubyte = 1)
	Declare Destructor()
	Declare Sub Update()
	Declare Sub Plot()
	Private:  
		As Ushort AmountRockets
		As Kaboom Ptr pBuffer
		As ParticleTail Ptr pBuffer2
		As Image Ptr Img_Empty, Img_Fireworks, Img_Blur 
End Type

Constructor Fireworks(iAmountRockets As Ubyte)
	Img_Empty = Imagecreate(scrw, scrh, &h28000000, 32)
	Img_Fireworks = Imagecreate(scrw, scrh, , 32)
	This.AmountRockets = iAmountRockets
	pBuffer = New Kaboom[This.AmountRockets]
	pBuffer2 = New ParticleTail[1]
End Constructor

Destructor Fireworks()
	Delete[] pBuffer
	Delete[] pBuffer2
	pBuffer = 0
	pBuffer2 = 0
	Imagedestroy This.Img_Empty
	Imagedestroy This.Img_Fireworks
End Destructor


Sub Fireworks.Plot()
	Dim As Uinteger iParticleSum = 0
	Put This.Img_Fireworks, (0, 0), This.Img_Empty, Pset
	For y As Ushort = 0 To This.AmountRockets - 1
		Select Case pBuffer[y].detonate
			Case False
				If Rnd() > 0.666667 Then 
					pBuffer[y].rocketx += SimplexNoise2D(pBuffer[y].rocketx, pBuffer[y].rockety, 10) + Sin((pBuffer[y].rocketx - pBuffer[y].rockety) / 10) * 1.25
					'pBuffer[y].rockety += SimplexNoise2D(pBuffer[y].rockety, pBuffer[y].rocketx, 15) + Cos(pBuffer[y].rocketx / 17) * 5.5
				End If
				Circle This.Img_Fireworks, (pBuffer[y].rocketx, pBuffer[y].rockety), 1.5 + SimplexNoise2D(pBuffer[y].rocketx, pBuffer[y].rockety, 150), Rgba(&hFF, &hFF, &hF0, &hE0),,, 1.5,F
				pBuffer2[0].Add(pBuffer[y].rocketx, pBuffer[y].rockety, 7.5 + Rnd() * (20 * pBuffer[y].power))
				Stack1.Push(pBuffer2[0])
				iParticleSum += 1
			Case Else
				Dim as Single r, r2, cy, cyy, cx
				For i As Ulong = 0 To pBuffer[y].particles - 1
					r = pBuffer[y].Boom(i).size - 1
					r2 = r * r
					For cy = -r to r
						cx = Sqr(r2 - cy * cy)
						cyy = cy + pBuffer[y].Boom(i).y
						Line This.Img_Fireworks, (pBuffer[y].Boom(i).x - cx, cyy)-(pBuffer[y].Boom(i).x + cx, cyy), _
							 Rgba(pBuffer[y].Boom(i).r, pBuffer[y].Boom(i).g, pBuffer[y].Boom(i).b, pBuffer[y].Boom(i).a)
					Next

					'Circle This.Img_Fireworks, (pBuffer[y].Boom(i).x, pBuffer[y].Boom(i).y), pBuffer[y].Boom(i).size, _
					'		Rgba(pBuffer[y].Boom(i).r, pBuffer[y].Boom(i).g, pBuffer[y].Boom(i).b, pBuffer[y].Boom(i).a),,,,F
					iParticleSum += 1
				Next
		End Select
		pBuffer[y].update
	Next
	
	Stack2.iPos = 1
	For y As Ulong = 1 To Stack1.iPos - 1
		Dim As ParticleTail oPT = Stack1.Get(y)
		If oPT.life > 0 Then
			For i As Ubyte = 0 To iParticlesTail - 1
				Circle This.Img_Fireworks, (oPT.ParticleTail(i).x, oPT.ParticleTail(i).y), 0.1, Rgba(oPT.ParticleTail(i).r, oPT.ParticleTail(i).g, oPT.ParticleTail(i).b, oPT.ParticleTail(i).a),,,,F
				oPT.ParticleTail(i).x += oPT.ParticleTail(i).vx
				oPT.ParticleTail(i).y += oPT.ParticleTail(i).vy
				If oPT.ParticleTail(i).a - 5 > 0 Then oPT.ParticleTail(i).a -= 5
				iParticleSum += 1
			Next
		End If
		oPT.life -= 1
		If oPt.life > 0 Then Stack2.Push(oPT)
	Next
	
	'clean-up stack
	For y As ULong = 1 To Stack2.iPos - 1
		Stack1.aStack(y) = Stack2.aStack(y)
	Next
	Stack1.iPos = Stack2.iPos
		
	Draw String (1, scrh - 10), "Particles:"  & iParticleSum, Rgb(&hFF, &h00, &h00)
	Put (0, 0), This.Img_Fireworks, Alpha
	
End Sub
'--------------------------------------------------------------------------------------------------


#Ifdef __Fb_win32__
	#Include "windows.bi"
	Enum PROCESS_DPI_AWARENESS
		DPI_AWARENESS_INVALID = -1, PROCESS_DPI_UNAWARE = 0, PROCESS_SYSTEM_DPI_AWARE = 1, PROCESS_PER_MONITOR_DPI_AWARE = 2
	End Enum

	Function _WinAPI_GetDpiForWindow(hWnd As HWND) As Ubyte 'requires Win10 v1607+ / no server support
		Dim As Any Ptr pLib = Dylibload("User32.dll")
		If pLib = NULL Then Exit Function
		Dim pGetDpiForWindow As Function (Byval hWND As HWND) As UINT
		pGetDpiForWindow = Dylibsymbol(pLib, "GetDpiForWindow")
		If pGetDpiForWindow Then Function = pGetDpiForWindow(hWnd)
		Dylibfree(pLib)
	End Function

	Function _WinAPI_SetProcessDpiAwareness(DPIAware As Integer) As Ubyte 'requires Windows 8.1+ / no server support
		Dim As Any Ptr pLib = Dylibload("Shcore.dll")
		If pLib = NULL Then Exit Function	
		Dim pSetProcessDpiAwareness As Function (Byval DPIAware As Integer) As HRESULT
		pSetProcessDpiAwareness = Dylibsymbol(pLib, "SetProcessDpiAwareness")
		If pSetProcessDpiAwareness Then Function = pSetProcessDpiAwareness(DPIAware)
		Dylibfree(pLib)
	End Function
	
	_WinAPI_SetProcessDpiAwareness(PROCESS_PER_MONITOR_DPI_AWARE)
	
	Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP)
	
	Dim tWorkingArea As RECT
	SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
	Screencontrol SET_WINDOW_POS, (iDW - scrw) \ 2, ((tWorkingArea.Bottom - scrh) - (iDH - tWorkingArea.Bottom)) \ 2
#Else
	 Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP)
#Endif

Windowtitle(sTitle)
                              
Dim As Fireworks Firework = Fireworks(20)

Dim As Ulong i, iFPS = 0, iFPS_current = 0
Dim As Double fTimer = Timer


Do
	Screenlock
	Firework.Plot()
	
	Draw String(1, 1), iFPS_current & " fps", Rgba(&hFF, &h00, &h00, &hE0)
	Screenunlock
	If Timer - fTimer > 0.99 Then
		iFPS_current = iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	Endif
	Sleep(Regulate(60), 1)
Loop Until Inkey = Chr(27)

'--------------------------------------------------------------------------------------------------
Function RandomRange(fStart As Single, fEnd As Single) As Single
	Return Rnd() * (fEnd - fStart) + fStart
End Function

'--------------------------------------------------------------------------------------------------
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function
Windows only: Fireworks with some sound effects (source + compiled exe): FB Fireworks v0.60 build 2020-07-13 beta.zip

This is my 2nd attempt using classes to get a better understanding... ^^
Last edited by UEZ on Jul 13, 2020 14:40, edited 13 times in total.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by grindstone »

Great work, but moving a little bit too fast, IMO!
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by UEZ »

grindstone wrote:Great work, but moving a little bit too fast, IMO!
Thanks for your feedback. I changed the sleep to Sleep(10, 1).
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by grindstone »

That should have no effect, for the program sleeps at least ~15ms, independent from the value. Here a value of 25 works fine.
St_W
Posts: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Fireworks v0.5 build 2019-01-01 beta

Post by St_W »

Ideally the animation speed should be independent from the framerate. For example on my Ubuntu system I just get 18fps and the sleep (1,1) is just fine.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by UEZ »

grindstone wrote:That should have no effect, for the program sleeps at least ~15ms, independent from the value. Here a value of 25 works fine.
The CPU from my notebook is from <2013 and thus no very fast. Sleep(10) is for my system a little bit too slow.

So it's up to everyone to adjust the sleep accordingly or I will add dodicat's FPS regulator...

Edit: added FPS regulator. See 1st post.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Fireworks v0.5 build 2019-01-01 beta

Post by badidea »

Nice, but when I compile with -exx the program freezes after a few seconds. Without -exx, I can launch 100 fireworks at once.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by UEZ »

badidea wrote:Nice, but when I compile with -exx the program freezes after a few seconds. Without -exx, I can launch 100 fireworks at once.
I never worked with -exx and I can confirm the crash because on my system the program closes. What does this mean now?

Btw, the sound is really missing.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Fireworks v0.5 build 2019-01-01 beta

Post by badidea »

UEZ wrote:I never worked with -exx and I can confirm the crash because on my system the program closes. What does this mean now?
Additional error checking. Code will be a bit slower but very useful to find bugs quicker. Often an error message is displayed, but not in this case.
More info: https://freebasic.net/wiki/wikka.php?wa ... ilerOptexx
UEZ wrote:Btw, the sound is really missing.
I have heard enough yesterday.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Fireworks v0.5 build 2019-01-01 beta

Post by UEZ »

badidea wrote: I have heard enough yesterday.
LOL

Thanks for the link. I will investigate this feature for debugging.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Fireworks v0.5 build 2019-01-01 beta

Post by dodicat »

Nice UEZ.
You should make
Dim As Ubyte aFlash(0 To 253) = {255, 0}
(line 256)
because this.c1 ranges 0 to 253 and you need aFlash(this.c1)
Every day I run this I see more rocket launchers, if you employ any more ground crew you might need more than 253 aflashes.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Fireworks v0.60 build 2020-07-09 beta

Post by UEZ »

Small update to v0.60. Now with some sound effects on explosion (Windows only).

Download can be found in the 1st post.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Fireworks v0.60 build 2020-07-09 beta

Post by deltarho[1859] »

I had already given it 10 out of 10 - now what do I do? Image
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Fireworks v0.60 build 2020-07-09 beta

Post by dodicat »

Some Irish examining boards I believe award up to 110 percent.
The extra ten percent is earned if you spell your name correctly at the top.
So more than 10 out of 10 is acceptable.
Thanks UEZ.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Fireworks v0.60 build 2020-07-09 beta

Post by deltarho[1859] »

I am not sure what is worse, dodicat's remarks or someone saying that Scottish examining boards never give more than 9 out of 10 because they are too tight-fisted. Image

I am not saying that, of course, but I met an old Scottish friend last year and I said: "Go on then, get them in - it's your round if I remember correctly." He opened his wallet and a ten shilling note fell out.
Post Reply