Fireworks v0.60 build 2020-07-13 beta

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

Fireworks v0.60 build 2020-07-13 beta

Postby UEZ » Jan 01, 2019 21:11

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: 737
Joined: May 05, 2015 5:35
Location: Germany

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

Postby grindstone » Jan 01, 2019 21:14

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

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

Postby UEZ » Jan 01, 2019 21:28

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: 737
Joined: May 05, 2015 5:35
Location: Germany

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

Postby grindstone » Jan 01, 2019 21:38

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: 1494
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

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

Postby St_W » Jan 01, 2019 21:49

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: 586
Joined: May 05, 2017 19:59
Location: Germany

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

Postby UEZ » Jan 01, 2019 21:51

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: 2079
Joined: May 24, 2007 22:10
Location: The Netherlands

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

Postby badidea » Jan 01, 2019 22:16

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: 586
Joined: May 05, 2017 19:59
Location: Germany

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

Postby UEZ » Jan 01, 2019 23:08

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: 2079
Joined: May 24, 2007 22:10
Location: The Netherlands

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

Postby badidea » Jan 01, 2019 23:25

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: 586
Joined: May 05, 2017 19:59
Location: Germany

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

Postby UEZ » Jan 01, 2019 23:29

badidea wrote:I have heard enough yesterday.

LOL

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

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

Postby dodicat » Jan 02, 2019 13:26

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: 586
Joined: May 05, 2017 19:59
Location: Germany

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

Postby UEZ » Jul 09, 2020 20:38

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: 2530
Joined: Jan 02, 2017 0:34
Location: UK

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

Postby deltarho[1859] » Jul 10, 2020 7:58

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

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

Postby dodicat » Jul 10, 2020 12:18

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: 2530
Joined: Jan 02, 2017 0:34
Location: UK

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

Postby deltarho[1859] » Jul 10, 2020 15:20

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.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 5 guests