"Lite regulation" function ('regulateLite()') to be integrated into user loop for FPS control

[fxm]

Preamble

• The main objective of this regulation function is to minimize the CPU load which is added to that of the user's own code.
  Therefore, all dead times used by this function to control the user FPS (Frames per second) are generated using exclusively the SLEEP keyword (no CPU consuming waiting loops).
  
  But the exclusive use of the SLEEP keyword induces a limitation on the maximum accessible FPS value because the delay generated by SLEEP cannot drop below a limit value depending on the OS cycle period.
  A workaround is integrated into this regulation function to provide from values greater than this FPS limit value no longer a true FPS but an apparent FPS which seems to match the requested FPS.
  
  In addition, as the SLEEP keyword does not have a good accuracy on the generated delay, the FPS obtained fluctuates around the requested value.
  SLEEP also produces a temporal bias which varies over time, but whose average is corrected by the regulation function.
  
  For a fine and accurate regulation but consuming much more CPU load, see:
  Fine-grain procedure for waiting and in-loop procedure for fine-regulating FPS topic of the "Programmer's Guide".

1. Principles to overcome the penalizing behavior of SLEEP keyword

• To implement the best regulation but based only on the SLEEP keyword, some bad behaviors as described above must be overcome or minimized.
  
  Principle for measuring the minimum delay accessible with SLEEP
  • To evaluate the minimum delay 'tos' accessible with SLEEP, the duration of a sequence of ten 'Sleep 1, 1' is measured using the keyword TIMER and the time found is divided by ten.
    But this minimum value 'tos' is not directly usable because a margin must be added to it to preserve an almost linear regulation operation.
    The minimum usable value is thus fixed at '3 * tos / 2'.
    
    This calibration phase is executed automatically on the first call to the regulation function, or if the time measured is much different than the time ordered, or on request from the user thanks to an optional parameter of the function, or on opportunity measurements when the high limit of regulation is reached (when a heel value of delay with 'Sleep tos / 2, 1' is used).
  Principle for accessing an apparent FPS higher than the maximum true FPS accessible with SLEEP
  • When for a required FPS value, the 't' value to be applied in 'Sleep t, 1' becomes less than '3 * tos / 2', an 'image skipping' feature is started to provide an apparent FPS which matches to the required FPS.
    
    The basic principle of 'image skipping' is to remove all delays between these images (the regulation function returns immediately) so that the persistence of these images is low compared to that which is followed by a true delay.
    The smaller the image tracing time, the less these skipped images are visible.
    
    The temporal principle for skipping 'n - 1' images over 'n' images is to generate only one delay after viewing the last image, with a value such that the total period of the sequence (of 'n' images) is equal to 'n' times the period corresponding to the required FPS.
    The number of images to skip is stopped as soon as the only delay to generate for the sequence becomes greater than or equal to '3 * tos / 2'.
    When 'n - 1' images are skipped over 'n' images, the apparent FPS is equal to the inverse of the full display period of the 'n' images but multiplied by 'n'.
    
    This functionality of scrolling skipped images can be inhibited by the user thanks to an optional parameter of the function.
    
    Conversely, the user can reinforce this functionality by downright removing the skipped images by testing an optional parameter of the function which marks these skipped images.
    For this to work, the user code must very well separate the part of the code that concerns only the graphical drawing (the only part that should not be executed when the 'skipped image' tag is true) from the part of the code that concerns only the progress of the movement (which must always be executed). Otherwise, if these two parts of code are skipped at the same time (or even only a small portion of the progress of the movement), the graphical drawing will on the contrary be slowed down (although the returned FPS value says otherwise).
    
    This operating configuration ('image skipping' +'skipped image' user removing) is therefore the most efficient (from the point of view of apparent FPS) but imposes complete separation rules between two tasks (tracing only and calculating only) in the user animation code loop.
    
    On the other hand, the 'image skipping' configuration alone (with 'skipped image' scrolled by default) does not require any coding rules for the user.
    
    In case of too high requested FPS and to avoid having an image that is too jerky in the case of image skipping applied, the actual refresh rate of the screen cannot go below 10 Hz in case of skipped images (the apparent FPS can be very much higher), and the number of consecutive skipped images cannot exceed 20.
    These two limits when 'image skipping' is active induce an apparent displacement quasi-fluid for an initial image moving by 1 pixel every time (a displacement of 20 pixels at a frequency of 10 Hz appears to the user as a fairly smooth movement, not too jerky).
  Principle for compensating for the average temporal bias produced by SLEEP
  • The principle is to measure (using the TIMER keyword) the real delay provided by 'Sleep t, 1' in relation with 't'.
    
    If the time measured is much different than the time ordered, this probably means that there is an error compared to the resolution measured on initialization, and the function then will automatically restart at the next call a new calibration phase (with ten 'Sleep 1, 1').
    Example: requested time = 4 µs, but measured time = 16 µs, probably because the resolution was changed (lowered) while program running.
    
    If the time measured is only a little different from the time ordered, the differences are averaged to try to correct the average bias of the SLEEP keyword.

2. Description of the function body to include

• The 'regulateLite()' function is described here.
  
  The code is not thread safe because it uses 'Static' variables.
  
  The function is well suited to regulate the FPS of an image refresh by inserting a delay into the loop, without adding a notable CPU load to that of the user's own code.
  
  Note: Like any waiting feature, it is strongly discouraged to use 'regulateLite()' when the screen is locked, so no call from inside a [ScreenLock...ScreenUnlock] block.
  
  The function has a mandatory first parameter 'MyFps' through which the user passes their required FPS.
  
  For debugging purposes, the function returns the FPS (true or apparent) value it applied. If the user does not wish to use this debug data, then they can call the function as a Sub quite simply.
  If this returned FPS value is much lower than that required, this means that it becomes difficult to reach the FPS setpoint. Otherwise, the fluctuation of the FPS returned is mainly due the use of the only SLEEP keyword to generate the delay in the loop.
  
  Otherwise, the function proposes 3 optional parameters:
  • - 'Restart' ('False' by default):
    • This input parameter allows the user to force a new calibration phase, because for example he knows that the resolution of the OS cycle has just changed.
      Set this parameter to 'True' in the call, then to 'False' on the next call.
    - 'SkipImage' ('True' by default):
    • This input parameter allows the user to inhibit the automatic 'image skipping' feature. Whatever happens, there will be no skipped images, but perhaps to the detriment of the FPS obtained which may not follow the requested FPS.
      Set this parameter to 'False' to disable the 'image skipping' feature (can be reset to 'True' later).
    - 'ImageSkipped' ('False' by default bur default value irrelevant):
    • This output parameter is set to 'True' at each image skipped by the function (if the 'image skipping' feature is activated).
      The user can test it to know if the image is skipped or not ("image skipping" feature working in scrolling mode).
      He can also use this parameter to downright not draw this skipped image at all, allowing for example even higher FPS ("image skipping" feature working in removing mode).
  File to be included: "regulateLite.bi"

  Code: Select all

  ' regulateLite.bi
  
  Function regulateLite(ByVal MyFps As Ulong, ByVal SkipImage As Boolean = True, ByVal Restart As Boolean = False, ByRef ImageSkipped As Boolean = False) As Ulong
      '' 'MyFps' : requested FPS value, in frames per second
      '' 'SkipImage' : optional parameter to activate the image skipping (True by default)
      '' 'Restart' : optional parameter to force the resolution acquisition, to reset to False on the next call (False by default)
      '' 'ImageSkipped' : optional parameter to inform the user that the image has been skipped (if image skipping is activated)
      '' function return : applied FPS value (true or apparent), in frames per second
      Static As Single tos
      Static As Single bias
      Static As Long count
      Static As Single sum
      ' initialization calibration
      If tos = 0 Or Restart = True Then
          Dim As Double t = Timer
          For I As Integer = 1 To 10
              Sleep 1, 1
          Next I
          Dim As Double tt = Timer
          #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
          If tt < t Then t -= 24 * 60 * 60
          #endif
          tos = (tt - t) / 10 * 1000
          bias = 0
          count = 0
          sum = 0
      End If
      Static As Double t1
      Static As Long N = 1
      Static As Ulong fps
      Static As Single tf
      ' delay generation
      Dim As Double t2 = Timer
      #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
      If t2 < t1 Then t1 -= 24 * 60 * 60
      #endif
      Dim As Double t3 = t2
      Dim As Single dt = (N * tf - (t2 - t1)) * 1000 - bias
      If (dt >= 3 * tos / 2) Or (SkipImage = False) Or (N >= 20) Or (fps / N <= 10) Then
          If dt <= tos Then dt = tos / 2
          Sleep dt, 1
          t2 = Timer
          #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
          If t2 < t1 Then t1 -= 24 * 60 * 60 : t3 -= 24 * 60 * 60
          #endif
          fps = N / (t2 - t1)
          tf = 1 / MyFps
          t1 = t2
          ' automatic test and regulation
          Dim As Single delta = (t2 - t3) * 1000 - (dt + bias)
          If Abs(delta) > 3 * tos Then
              tos = 0
          Else
              bias += 0.1 * Sgn(delta)
          End If
          ' automatic calibation
          If dt < tos Then
              If count = 100 Then
                  tos = sum / 100 * 1000
                  bias = 0
                  sum = 0
                  count = 0
              Else
                  sum += (t2 - t3)
                  count += 1
              End If
          End If
          ImageSkipped = False
          N = 1
      Else
          ImageSkipped = True
          N += 1
      End If
      Return fps
  End Function
  

  
  Maximum performance estimation
  • See below in the Maximum performance estimation and emulation of it with 'regulateLite()' post

3. Examples of test code

• Test code for simple use of 'regulateLite()'
  • The 'regulateLite()' function is called as a sub (ignoring the return value) and only the mandatory parameter ('MyFps') is used.
    => "image skipping" feature working in scrolling mode.
    
    The dynamic part of the display consists of the value of the requested FPS and a graphic progress bar to judge the quality of the regulation.
    
    The static part of the display is the list of available commands:
    - <+/-> for increase/decrease FPS
    - <escape> to Quit
    
    Test1:

    Code: Select all

    #include "regulateLite.bi"
    
    Screen 12
    Dim As Ulong FPS = 100
    Do
        Static As ULongInt l
        ScreenLock
        Cls
        Color 15
        Print Using "Requested FPS : ###"; FPS
        Print
        Print
        Print
        Color 14
        Print "<+>      : Increase FPS"
        Print "<->      : Decrease FPS"
        Print
        Print "<Escape> : Quit"
        Line (0, 32)-(639, 48), 7, B
        Line (0, 32)-(l, 48), 7, BF
        ScreenUnlock
        l = (l + 1) Mod 640
        Dim As String s = Inkey
        Select Case s
        Case "+"
            If FPS < 200 Then FPS += 1
        Case "-"
            If FPS > 10 Then FPS -= 1
        Case Chr(27)
            Exit Do
        End Select
        regulateLite(FPS)
    Loop
    

  Test code for improved use of 'regulateLite()'
  • Compared to 'Code for simple test', this code calls 'regulateLite()' as a function and displays the applied FPS (return value).
    Additionally, this code uses the optional 'ImageSkipped' parameter to not display images tagged 'ImageSkipped=True' at all, and also specify the quantum of images displayed.
    => "image skipping" feature working in removing mode.
    
    Test2:

    Code: Select all

    #include "regulateLite.bi"
    
    Screen 12
    Dim As Ulong FPS = 100
    Do
        Static As ULongInt l
        Static As Ulong MyFPS
        Static As Boolean ImageSkipped
        Static As Long nis
        Static As Long tnis
        If ImageSkipped = False Then
            ScreenLock
            Cls
            Color 15
            Print Using "Requested FPS   : ###"; FPS
            Print
            Color 11
            Print Using "Applied FPS        : ###"; MyFPS
            Print "   Image displayed : 1/" & tnis + 1
            Print
            Print
            Print
            Color 14
            Print "<+>      : Increase FPS"
            Print "<->      : Decrease FPS"
            Print
            Print "<Escape> : Quit"
            Line (0, 80)-(639, 96), 7, B
            Line (0, 80)-(l, 96), 7, BF
            ScreenUnlock
        End If
        l = (l + 1) Mod 640
        Dim As String s = Inkey
        Select Case s
        Case "+"
            If FPS < 200 Then FPS += 1
        Case "-"
            If FPS > 10 Then FPS -= 1
        Case Chr(27)
            Exit Do
        End Select
        MyFPS = regulateLite(FPS, , , ImageSkipped)
        If ImageSkipped = True Then
            nis += 1
        Else
            tnis = nis
            nis = 0
        End If
    Loop
    

  Test code for intensive use of 'regulateLite()'
  • Compared to 'Code for improved test', this code additionally uses the other two optional parameters 'SkipImage' and 'Restart'.
    This code is used to test all the combinations of the parameters of the function as well as the type of display of the skipped images (either scrolling of the skipped images, or removing of the skipped images).
    ("image skipping" feature activated and pre-selected in scrolling mode)
    
    For the Windows platform only, this code allows to change the OS cycle resolution (normal or high) and commands a new calibration phase at each change of resolution.
    
    Added commands:
    - <T/F> for True/False for image skipping
    - <S/R> for Scroll/Remove image skipped
    - <C> for Calibration phase
    - <N/H> for Normal/High resolution (for Windows platform only)
    
    Test3:

    Code: Select all

    #include "regulateLite.bi"
    
    #if defined(__FB_WIN32__)
    Declare Function _setTimer Lib "winmm" Alias "timeBeginPeriod"(ByVal As Ulong = 1) As Long
    Declare Function _resetTimer Lib "winmm" Alias "timeEndPeriod"(ByVal As Ulong = 1) As Long
    #endif
    
    Screen 12, , 2
    Screenset 1, 0
    
    Dim As Ulongint MyFps = 100
        
    Dim As String res = "N"
    Dim As Boolean SkipImage = True
    Dim As Boolean Restart = False
    Dim As Boolean RemoveImageSkipped = False
    
    Do
        Static As Ulongint l
        Static As Double dt
        Static As Ulong fps
        Static As Double t
        Static As Ulong averageFps
        Static As Double sumFps
        Static As Double averageDelay
        Static As Double sumDelay
        Static As Long N
        Static As Boolean ImageSkipped
        Static As Long ist = 0
        Static As Long mist = 0
        Dim As Double t1
        Dim As Double t2
        If (RemoveImageSkipped = False) OR (ImageSkipped = False) Then
            t = Timer
            Cls
            Print
            Color 15
            Select Case res
            Case "N"
                Print "                      NORMAL RESOLUTION"
            Case "H"
                Print "                      HIGH RESOLUTION (for Windows only)"
            End Select
            Print
            Print " Procedure : regulateLite( "; MyFPS & " [, " & SkipImage & " ])";
            If SkipImage = True Then
                Select Case RemoveImageSkipped
                Case True
                    Print "      Images skipped : Removing"
                Case False
                    Print "      Images skipped : Scrolling"
                End Select
            Else
                    Print "     No image skipping"
            End If
            Print
            Color 11
            If mist = 0 Then
                Print Using " Applied true FPS     : ###         (average : ###)"; fps; averageFps
                Print Using "    Applied delay     : ###.### ms  (average : ###.### ms)"; dt; averageDelay;
            Else
                Print Using " Applied apparent FPS : ###         (average : ###)"; fps; averageFps
                Print Using "    Applied delay     : ###.### ms  (average : ###.### ms)"; dt; averageDelay;
            End If
            If SkipImage = True Then
                Print "  (not skipped image)"
            Else
                Print
            End If
            If SkipImage = True Then
                Select Case RemoveImageSkipped
                Case True
                    Print "    Images removed    :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
                Case False
                    Print "    Images scrolled   :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
                End Select
            Else
                    Print "    No image skipped"
            End If
            Print
            Print
            Print
            Color 14
            #if defined(__FB_WIN32__)
            Print " <n> or <N> : Normal resolution"
            Print " <h> or <H> : High resolutiion"
            Print
            #endif
            Print " <+>        : Increase FPS"
            Print " <->        : Decrease FPS"
            Print
            Print " Optional parameter :"
            Print "    <t> or <T> : True for image skipping"
            If SkipImage = True Then
                Print "        <r> or <R> : Remove image skipped"
                Print "        <s> or <S> : Scroll image skipped"
            End If
            Print "    <f> or <F> : False for image skipping"
            Print "    <c> or <C> : Calibration phase"
            Print
            Print " <escape>   : Quit"
            Line (8, 144)-(631, 160), 7, B
            Line (8, 144)-(8 + l, 160), 7, BF
            Do
            #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
                t2 = Timer
                If t2 < t Then t -= 24 * 60 * 60
            Loop Until t2 >= t + 0.002
            #else
            Loop Until Timer >= t + 0.002
            #endif
            Screencopy
        End If
        l = (l + 1) Mod 624
        Dim As String s = Ucase(Inkey)
        Select Case s
        Case "+"
            If MyFPS < 500 Then MyFPS += 1
        Case "-"
            If MyFPS > 10 Then MyFPS -= 1
        Case "T"
            SkipImage = True
        Case "F"
            SkipImage = False
        #if defined(__FB_WIN32__)
        Case "N"
            If res = "H" Then
                Restart = True
                res = "N"
            End If
        Case "H"
            If res = "N" Then
                Restart = True
                res = "H"
            End If
        #endif
        Case "C"
            Restart = True
        Case "R"
            If SkipImage = True Then RemoveImageSkipped = True
        Case "S"
            If SkipImage = True Then RemoveImageSkipped = False
        Case Chr(27)
            Exit Do
        End Select
        sumFps += fps
        sumDelay += dt
        N += 1
        If N >= fps / 2 Then
            averageFps = sumFps / N
            averageDelay = sumDelay / N
            N = 0
            sumFps = 0
            sumDelay = 0
        End If
        #if defined(__FB_WIN32__)
        If res = "H" Then
            _setTimer()
        End If
        #endif
        t1 = Timer
        fps = regulateLite(MyFPS, SkipImage, Restart, ImageSkipped)
        If ImageSkipped = False Then
            t2 = Timer
            #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
            If t2 < t1 Then t1 -= 24 * 60 * 60
            #endif
            dt = (t2 - t1) * 1000
        End If
        #if defined(__FB_WIN32__)
        If res = "H" Then
            _resetTimer()
        End If
        #endif
        Restart = False
        If ImageSkipped = True Then
            ist += 1
        Else
            mist = ist
            ist = 0
        End If
    Loop
    

  Test code for maximum performance emulation of 'regulateLite()'
  • See below in the Maximum performance estimation and emulation of it with 'regulateLite()' post

4. Examples of graphic animation code

• See for example below the tenth graphic animation and the twelfth graphic animation, both highlighting the interest of the image skipping feature of 'regulateLite()', with scrolling and above all removing of skipped images.

[fxm]

Comparison between:
- 'Lite regulation' function from forum here: "Lite regulation" function ('regulateLite()') to be integrated into user loop for FPS control
- 'Enhanced regulation' function from the wiki: Fine-grain procedure for waiting and in-loop procedure for fine-regulating FPS

The last code in the above post ('Code for extensive test') has been extended to also test the 'Enhanced regulation' function from the wiki and to be able to compare the two with each other.

Common commands to the both regulation types:
- <N/H> for Normal/High resolution (for Windows platform only)
- <+/> for Increase/Decrease FPS
- <escape> for Quit

Specific commands for the 'Lite regulation':
- <L> for Lite regulation
- <T/F> for True/False for image skipping
- <S/R> for Scroll/Remove image skipped
- <C> for Calibration phase

Specific commands for 'Enhanced regulation':
- <E> for Enhanced regulation
- <I/D> for Increase/Decrease threshold

Test4:

Code: Select all

#include "delay_regulate_framerate.bi"  '' defined in https://www.freebasic.net/wiki/ProPgDelayRegulate
#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Screen 12, , 2
Screenset 1, 0

Dim As Ulongint MyFps = 100
    
Dim As String reg = "L"
Dim As String res = "N"
Dim As Boolean SkipImage = True
Dim As Boolean Restart = False
Dim As Ulong thresholdNR = 32
Dim As Ulong thresholdHR = 2
Dim As Boolean RemoveImageSkipped = False

Do
    Static As Ulongint l
    Static As Double dt
    Static As Ulong fps
    Static As Double t
    Static As Ulong averageFps
    Static As Double sumFps
    Static As Double averageDelay
    Static As Double sumDelay
    Static As Long N
    Static As Ulong fpsE
    Static As Boolean ImageSkipped
    Static As Long ist = 0
    Static As Long mist = 0
    Dim As Double t1
    Dim As Double t2
    If (reg = "E") Or ((RemoveImageSkipped = False) OR (ImageSkipped = False)) Then
        t = Timer
        Cls
        Print
        Color 15
        Select Case res
        Case "N"
            Print "                      NORMAL RESOLUTION"
        Case "H"
            Print "                      HIGH RESOLUTION (for Windows only)"
        End Select
        Print
        Select Case reg
        Case "E"
            Select Case res
            Case "N"
                Print " Enhanced procedure : regulate( " & MyFPS & " [, " & thresholdNR & " ])"
            Case "H"
                Print " Enhanced procedure : regulateHR( " & MyFPS & " [, " & thresholdHR & " ])"
            End Select
            Print
            Color 11
            Print Using " Measured FPS     : ###          (average : ###)"; fpsE; averageFps
            Print Using "    Applied delay : ###.### ms   (average : ###.### ms)"; dt; averageDelay
            Print "    (no image skipped)"
        Case "L"
            Print " Lite procedure : regulateLite( "; MyFPS & " [, " & SkipImage & " ])";
            If SkipImage = True Then
                Select Case RemoveImageSkipped
                Case True
                    Print "      Images skipped : Removing"
                Case False
                    Print "      Images skipped : Scrolling"
                End Select
            Else
                    Print "     No image skipping"
            End If
            Print
            Color 11
            If mist = 0 Then
                Print Using " Applied true FPS     : ###         (average : ###)"; fps; averageFps
                Print Using "    Applied delay     : ###.### ms  (average : ###.### ms)"; dt; averageDelay;
            Else
                Print Using " Applied apparent FPS : ###         (average : ###)"; fps; averageFps
                Print Using "    Applied delay     : ###.### ms  (average : ###.### ms)"; dt; averageDelay;
            End If
            If SkipImage = True Then
                Print "  (not skipped image)"
            Else
                Print
            End If
            If SkipImage = True Then
                Select Case RemoveImageSkipped
                Case True
                    Print "    Images removed    :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
                Case False
                    Print "    Images scrolled   :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
                End Select
            Else
                    Print "    No image skipped"
            End If
        End Select
        Print
        Print
        Print
        Color 14
        #if defined(__FB_WIN32__)
        Print " <n> or <N> : Normal resolution"
        Print " <h> or <H> : High resolutiion"
        Print
        #endif
        Print " <+>        : Increase FPS"
        Print " <->        : Decrease FPS"
        Print
        Select Case reg
        Case "E"
            Print " Enhanced regulating - Optional parameter :"
            Select Case res
            Case "N"
                Print "    <i> or <I> : Increase NR threshold"
                Print "    <d> or <D> : Decrease NR threasold"
                Draw String (320, 280), "(optimal value : 32)"
            Case "H"
                Print "    <i> or <I> : Increase HR threshold"
                Print "    <d> or <D> : Decrease HR threasold"
                Draw String (320, 280), "(optimal value : 2)"
            End Select
            Print
            Print " <l> or <L> : Lite regulating"
        Case "L"
            Print " Lite regulating - Optional parameter :"
            Print "    <t> or <T> : True for image skipping"
            If SkipImage = True Then
                Print "        <r> or <R> : Remove image skipped"
                Print "        <s> or <S> : Scroll image skipped"
            End If
            Print "    <f> or <F> : False for image skipping"
            Print "    <c> or <C> : Calibration phase"
            Print
            Print " <e> or <E> : Enhanced regulating"
        End Select
        Print
        Print " <escape>   : Quit"
        Line (8, 144)-(631, 160), 7, B
        Line (8, 144)-(8 + l, 160), 7, BF
        Do
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
            t2 = Timer
            If t2 < t Then t -= 24 * 60 * 60
        Loop Until t2 >= t + 0.002
        #else
        Loop Until Timer >= t + 0.002
        #endif
        Screencopy
    End If
    l = (l + 1) Mod 624
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If MyFPS < 500 Then MyFPS += 1
    Case "-"
        If MyFPS > 10 Then MyFPS -= 1
    Case "E"
        reg = "E"
    Case "L"
        reg = "L"
    Case "T"
        If reg = "L" Then
            SkipImage = True
        End If
    Case "F"
        If reg = "L" Then
            SkipImage = False
        End If
    #if defined(__FB_WIN32__)
    Case "N"
        If res = "H" Then
            Restart = True
            res = "N"
        End If
    Case "H"
        If res = "N" Then
            Restart = True
            res = "H"
        End If
    #endif
    Case "I"
        If reg = "E" Then
            Select Case res
            Case "N"
                If thresholdNR < 64 Then thresholdNR += 16
            Case "H"
                If thresholdHR < 4 Then thresholdHR += 1
            End Select
        End If
    Case "D"
        If reg = "E" Then
            Select Case res
            Case "N"
                If thresholdNR > 0 Then thresholdNR -= 16
            Case "H"
                If thresholdHR > 0 Then thresholdHR -= 1
            End Select
        End If
    Case "C"
        Restart = True
    Case "R"
        If (Reg = "L") And (SkipImage = True) Then RemoveImageSkipped = True
    Case "S"
        If (Reg = "L") And (SkipImage = True) Then RemoveImageSkipped = False
    Case Chr(27)
        Exit Do
    End Select
    Select Case reg
    Case "E"
        sumFps += fpsE
        sumDelay += dt
    Case "L"
        sumFps += fps
        sumDelay += dt
    End Select
    N += 1
    If N >= iif(reg = "E", fpsE, fps) / 2 Then
        averageFps = sumFps / N
        averageDelay = sumDelay / N
        N = 0
        sumFps = 0
        sumDelay = 0
    End If
    Select Case reg
    Case "E"
        Select Case res
        Case "N"
            dt = regulate(MyFps, thresholdNR) 
        #if defined(__FB_WIN32__)
        Case "H"
            dt = regulateHR(MyFps, thresholdHR)
        #endif
        End Select
        fpsE = framerate()
        If Restart = True Then
            dt = 0
            fpsE = 0
            N -= 1
            Restart = False
        End If
    Case "L"
        #if defined(__FB_WIN32__)
        If res = "H" Then
            _setTimer()
        End If
        #endif
        t1 = Timer
        fps = regulateLite(MyFPS, SkipImage, Restart, ImageSkipped)
        If ImageSkipped = False Then
            t2 = Timer
            #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
            If t2 < t1 Then t1 -= 24 * 60 * 60
            #endif
            dt = (t2 - t1) * 1000
        End If
        #if defined(__FB_WIN32__)
        If res = "H" Then
            _resetTimer()
        End If
        #endif
        Restart = False
        If ImageSkipped = True Then
            ist += 1
        Else
            mist = ist
            ist = 0
        End If
    End Select
Loop

[fxm]

A first graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : 3D rotate an image.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 50 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 15, CPU load = 8.3 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 20, CPU load = 9.9 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 50, CPU load = 8.5 %
(maximum accessible applied FPS in this third configuration: about 70)

From requested FPS = 100, I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 32, CPU load = 3.2 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 60, CPU load = 9.5 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 100, CPU load = 7.5 %
(maximum accessible applied FPS in this third configuration: about 140)

Code

Test5:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=294131#p294131)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type V3
    As Single x,y,z
    As Ulong col
End Type
Type _float As v3


sub RotateArray(wa() As V3,result() As V3,byref angle As _float,byref centre As V3,byval flag As Long=0,byref eyepoint As V3=(400,300,900))
    Dim As Single dx,dy,dz,w
    Dim As Single SinAX=Sin(angle.x)
    Dim As Single SinAY=Sin(angle.y)
    Dim As Single SinAZ=Sin(angle.z)
    Dim As Single CosAX=Cos(angle.x)
    Dim As Single CosAY=Cos(angle.y)
    Dim As Single CosAZ=Cos(angle.z)
    Redim result(Lbound(wa) To Ubound(wa))
    For z As Long=Lbound(wa) To Ubound(wa)
        dx=wa(z).x-centre.x
        dy=wa(z).y-centre.y
        dz=wa(z).z-centre.z
        Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
        result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
        result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
        #macro perspective()
        w = 1 + (result(z).z/eyepoint.z)
        result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x 
        result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y 
        result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
        #endmacro
        If flag Then: perspective():End If
        result(z).col=wa(z).col
    Next z
End sub

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
Dim As Long counter
Redim As v3 a(1 to 300*300*2)
Dim As Any Ptr i=Imagecreate(1024,768,Rgb(0,0,50))
For y As Long=0 To 299
    For x As Long=0 To 299
        counter+=1
        a(counter)=Type(x,y,0,Rgb(x*2, x*2 xor y*2,y*2))
        If counter Mod 200=0 Then  Pset i,(Rnd*1024,Rnd*768),Rgb(x, x xor y,y)
    Next
Next
Redim Preserve a(1 To counter)
Dim As v3 result(1 To counter)

Dim As _float ang
Dim As Long fps=50,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N
Do
    ang.z+=.03
    ang.y+=.02
    ang.x+=.02
    rotatearray(a(),result(),ang,Type(150,150,0),1)
    If (remove = False) Or (skipped = False) Then
        Screenlock
        Cls
        Put(0,0),i,Pset
        For n As Long=1 To counter
            Circle(result(n).x+300,result(n).y+250),1,result(n).col,,,,f
        Next n
        Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
        Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (544,608),"Graphic animation from dodicat"
        Screenunlock
    End If
    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 200 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
Loop

Imagedestroy i

[fxm]

Change in "regulateLite.bi":

In case of too high requested FPS and to avoid having an image that is too jerky in the case of image skipping applied, now the actual refresh rate of the screen cannot go below 10 Hz in case of skipped images (the apparent FPS can be very much higher), and also now the number of skipped images cannot exceed 20.

Lines 39 & 40:
If (dt >= 3 * tos / 2) Or (SkipImage = False) Or (N >= 99) Then
If (N >= 99) Or (dt < 3 * tos / 2) Then dt = tos / 2
If (dt >= 3 * tos / 2) Or (SkipImage = False) Or (N >= 20) Or (fps / N <= 10) Then
If dt <= tos Then dt = tos / 2

These two limits when 'image skipping' is active ('10' for 'fps/N' and '20' for 'N') induce an apparent displacement quasi-fluid for an initial image moving by 1 pixel every time.
A displacement of 20 pixels at a frequency of 10 Hz appears to the user as a fairly smooth movement (not too jerky).
If the initial image moving is several pixels each time, the higher values of FPS will be not usable when 'image skipping' is active (apparent displacement too jerky).

The header post has been updated accordingly.

[fxm]

A second graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Rubber duck.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 50 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 15, CPU load = 8.1 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 20, CPU load = 10.0 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 50, CPU load = 8.4 %
(maximum accessible applied FPS in this third configuration: about 100)

From requested FPS = 100, I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 20, CPU load = 5.8 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 30, CPU load = 9.8 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 100, CPU load = 7.8 %
(maximum accessible applied FPS in this third configuration: about 160)

Code

Test6:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=224700#p224700)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
Color ,Rgb(0,150,255)
Dim As Integer xres,yres
Screeninfo xres,yres
Type V3
    As Single x,y,z
    As Ulong col
    As Integer flag 'interceptor
    Declare Property length As Single
    #define vct Type<v3>
    #define dot *  'not used here
    #define cross ^
End Type

Type _float As V3

Type Line
    As v3 v1,v2
End Type

Type sphere As V3

'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,byval begin As Long,byval Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro      
        '<><><><><><><><><><><><><><><><><><><><><><>
        
        #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
        Operator + (Byref v1 As v3,Byref v2 As v3) As v3
        Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
        End Operator
        Operator -(Byref v1 As v3,Byref v2 As v3) As v3
        Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
        End Operator
        Operator * (Byval f As Single,Byref v1 As v3) As v3
        Return vct(f*v1.x,f*v1.y,f*v1.z)
        End Operator
        Operator * (Byref v1 As v3,Byref v2 As v3) As Single 'dot product (unused here)
        Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
        End Operator
        Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 'cross product
        Return vct(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
        End Operator
        
        Property v3.length As Single
        Return Sqr(x*x+y*y+z*z)
        End Property
        
        Function normalize(byref v As V3) As V3
            Return (1/v.length)*v
        End Function
        
        'GLOBALS
        Dim Shared As v3 eyepoint
        eyepoint=vct(xres/2,yres/2,900)
        
        Sub RotateArray(wa() As V3,result() As V3,byref angle As _float,byref centre As V3,byval flag As Long=0,byval s As Single=1)
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=(((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz))+centre.x
                result(z).y=(((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz))+centre.y
                result(z).z=(((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz))+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = s*(result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = s*(result(z).y-eyepoint.y)/w+eyepoint.y 
                result(z).z = s*(result(z).z-eyepoint.z)/w+eyepoint.z
                #endmacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
                result(z).flag=wa(z).flag
            Next z
        End Sub
        'create a tube element at a distance from a line     
        Function segdist(byref l As Line,byref p As v3,Byref ip As v3=vct(0,0,0)) As Single
            Dim As Single linelength=(l.v1-l.v2).length
            Dim As Single dist= ((1/linelength)*((l.v1-l.v2) cross (p-l.v1))).length
            Dim As Single lpf=(p-l.v2).length,lps=(p-l.v1).length
            If lps >= lpf Then
                Var temp=Sqr(lps*lps-dist*dist)/linelength
                'If temp>=1 Then temp=1:dist=lpf
                ip=l.v1+temp*(l.v2-l.v1)
                Return dist
            Else
                Var temp=Sqr(lpf*lpf-dist*dist)/linelength
                'If temp>=1 Then temp=1:dist=lps
                ip=l.v2+temp*(l.v1-l.v2)
                Return dist
            End If
        End Function
        
        'if a point lies on a sphere
        Function onsphere(byref S As sphere,byref P As V3,byval x As Single,byval y As Single) As Long
            Return x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.col*S.col Andalso _
            x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.col-1)*(S.col-1)
        End Function
        
        'point on surface of a box -unused here
        Function onbox(byref ctr As V3,byval l As Integer,byval h As Integer,byval d As Integer,byref p As V3) As Integer
            Dim As Integer a,b,c=0
            Dim As Integer ax,ay,az,at
            ax=(p.x>ctr.x-l And p.x<ctr.x+l)
            ay=(p.y>ctr.y-h And p.y<ctr.y+h)
            az=(p.z>ctr.z-d And p.z<ctr.z+d)
            at=(ax And ay And az)=0
            Return at
        End Function
        
        Sub AddARing(all() As V3,byval clr As Ulong,byval sz As Long,byref centre As V3,byval rad As Long,byval flipflag As Single=0,byval smoothness As Long=50)
            Redim As V3 a(0)
            Dim As Long num=smoothness
            Dim As Single pi=4*Atn(1),dd=2*pi*rad/num
            Redim As V3 temp(0)':Redim a(0)
            Dim As Line L1=Type<Line>((centre.x-dd,centre.y-rad),(centre.x+dd,centre.y-rad))   
            Dim As Long ctr
            'Dim As ulong clr
            For x As Long=L1.v1.x To L1.v2.x Step 2
                For y As Long=L1.v1.y-sz To L1.v2.y+sz Step 2
                    For z As Long=-sz To sz Step 2
                        Var v=Type<V3>(x,y,z)
                        Var sd=segdist(L1,v)
                        If sd>sz Andalso sd<sz+2 Then
                            ctr+=1
                            Var cc=Cptr(Ubyte Ptr,@clr)
                            Redim Preserve temp(1 To ctr)
                            Var mp=map(-sz,sz,z,.9,.5)
                            Var nc=Rgb(mp*cc[2],mp*cc[1],mp*cc[0])
                            temp(ctr)=vct(x,y,z,nc)
                        End If
                    Next z
                Next y
            Next x
            Dim As Long u
            #macro build(array)
            u=Ubound(a)
            Redim Preserve a(1 To u+Ubound(array))
            For n As Long=Lbound(array) To Ubound(array)
                a(u+n)=array(n)
            Next n
            #endmacro
            build(temp)
            Dim As V3 temp2(Lbound(temp) To Ubound(temp))
            'tube element created
            'now revolve it around a circle, save the points
            'to produce a torus
            For z As Long=1 To num/2 -1    
                RotateArray(temp(),temp2(),Type<_float>(0,0,z*2*pi/(num/2)),centre)      
                build(temp2) 
            Next z
            If flipflag Then 'Flip torus at an angle
                Redim  As V3 copy(Lbound(a) To Ubound(a))
                RotateArray(a(),copy(),Type<_float>(flipflag,0,0),centre) 
                For n As Long=Lbound(a) To Ubound(a)
                    a(n)=copy(n)
                Next n
            End If
            u=Ubound(all)
            Redim Preserve all(1 To u+Ubound(a))
            For n2 As Long=Lbound(a) To Ubound(a)
                all(u+n2)=a(n2)
            Next n2  
            'f+=1
        End Sub
        
        Sub addasphere(a() As V3,byref pt As V3,byval rad As Long,byval col As Ulong=0,byval x1 As Single,byval y1 As Single=1,byval flag As Integer=0)
            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter=Ubound(a)-1
            Dim As sphere sp=Type<sphere>(xx,yy,zz,r)
            For x As Long= xx-r-1 To xx+r+1 Step 2
                For y As Long=yy-r-1 To yy+r+1 Step 2
                    For z As Long=zz-r-1 To zz+r+1 Step 2
                        If onsphere(sp,Type<V3>(x,y,z),x1,y1) Then
                            counter+=1
                            Redim Preserve a(Lbound(a) To counter)
                            If flag=0 Then
                                a(counter)=Type<V3>(x,y,z,Rgb(Rnd*255,Rnd*255,Rnd*255),1)
                            Else
                                Var sz1=zz-r-1,sz2=zz+r+1
                                Var mp=map(sz1,sz2,z,1,.4)
                                Var cc=Cptr(Ubyte Ptr,@col)
                                Var nc=Rgb(mp*cc[2],mp*cc[1],mp*cc[0])
                                a(counter)=Type<V3>(x,y,z,nc)
                            End If
                        End If
                    Next z
                Next y
            Next x
        End Sub
        
        Sub AddABox(a() As V3,byref bx As V3,byval l As Integer,byval h As Integer,byval d As Integer,byval col As Ulong)
            Dim As Integer counter=Ubound(a),c'=1'-1
            For x As Integer=bx.x-l-c To bx.x +l +c Step 2
                For y As Integer=bx.y-h-c To bx.y +h +c Step 2
                    For z As Integer=bx.z-d-c To bx.z +d +c Step 2
                        If onbox(bx,l,h,d,Type<V3>(x,y,z)) Then
                            counter+=1
                            Redim Preserve a(Lbound(a) To counter)
                            Var cc=Cptr(Ubyte Ptr,@col)
                            Var sz1=bx.z-d-c,sz2=bx.z +d +c
                            Var mp=map(sz1,sz2,z,1,.4)
                            Var nc=Rgb(mp*cc[2],mp*cc[1],mp*cc[0])
                            a(counter)=Type<V3>(x,y,z,nc)
                        End If
                    Next z
                Next y
            Next x
        End Sub
        
        Redim  As V3 a(0) 'main  array
        
        'smoothing=30
        Dim As Single pi=4*Atn(1)
        AddAsphere(a(),Type<V3>(xres/2,yres/2,-10),90,Rgb(255,255,0),1,1,1)
        AddAsphere(a(),Type<V3>(xres/2,yres/2,0),150,Rgb(255,255,0),1.2,3,1)
        AddAsphere(a(),Type<V3>(xres/2,yres/2-100,100),70,Rgb(255,255,0),1,1,1)
        AddAsphere(a(),Type<V3>(xres/2-40,yres/2-120,150),10,Rgb(0,0,0),1,1,1)
        AddAsphere(a(),Type<V3>(xres/2+40,yres/2-120,150),10,Rgb(0,0,0),1,1,1)
        AddARing(a(),Rgb(255,0,0),9,Type(xres/2,yres/2-230,150),35,pi/2,30)
        AddARing(a(),Rgb(250,0,0),9,Type(xres/2,yres/2-230,150),30,pi/2,30)
        AddARing(a(),Rgb(250,0,0),9,Type(xres/2,yres/2-270,190),10,pi/2,30)
        AddARing(a(),Rgb(255,255,0),10,Type(xres/2,yres/2+190,-220),65,1,30)
        AddARing(a(),Rgb(255,255,0),10,Type(xres/2,yres/2+290,-410),15,.9,30)
        AddARing(a(),Rgb(255,255,0),5,Type(xres/2-120,yres/2,0),20,pi/2,30)
        AddARing(a(),Rgb(255,255,0),5,Type(xres/2+120,yres/2,0),20,pi/2,30)
        
        '        udt  name  dirn field
        SetQsort(V3,QsortZ,down,.z) 'Set Up the quicksort for UDT V3, on z
        
        Redim As V3 b(Lbound(a) To Ubound(a)) 'feeder array
        Dim As Single ang=0,rad,sz=1,k=1
        Dim As Long fps=50,rfps
        Dim As Ulong nc
        Dim As Boolean skipping=False,remove=False,skipped
        Dim As Long ist,mist
        Dim As Ulong averageFps
        Dim As Double sumFps
        Dim As Long N
        
        Do
            ang+=.025
            sz+=.005*k*sz
            If sz>1.8 Or sz<.2 Then k=-k
            RotateArray(a(),b(),Type<_float>(ang,ang+pi,ang),vct(xres/2,yres/2,0),1,sz)
            If (remove = False) Or (skipped = False) Then
                Screenlock
                Cls
                Qsortz(b(),Lbound(b),Ubound(b))
                For n As Long=Lbound(b) To Ubound(b)
                    If b(n).flag=1 Then
                        rad=1 'the coloured sphere points, if any
                    Else
                        rad=map(-400,400,b(n).z,5,2) 'the ring points (a little fuller)
                    End If
                    Circle(b(n).x,b(n).y),rad,b(n).col,,,,f
                Next n
                Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
                Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
                Draw String (16,48),"Status : " & _
                    iif(skipping = True, "Image skipping activation = true, with " & _
                    iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
                    "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
                    "Image skipping activation = false")
                Draw String (16,80),"<+> : Increase FPS"
                Draw String (16,96),"<-> : Decrease FPS"
                Draw String (16,128),"<t> or <T> : True for image skipping activation"
                If Skipping = True Then
                    Draw String (16,144),"   <s> or <S> : Scroll image skipped"
                    Draw String (16,160),"   <r> or <R> : Remove image skipped"
                    Draw String (16,176),"<f> or <F> : False for image skipping activation"
                    Draw String (16,208),"<escape> : Quit"
                Else
                    Draw String (16,144),"<f> or <F> : False for image skipping activation"
                    Draw String (16,176),"<escape> : Quit"
                End If
                Draw String (544,608),"Graphic animation from dodicat"
                Screenunlock
            End If
            rfps = regulateLite(fps,skipping, ,skipped)
            If skipped = True Then
                ist += 1
            Else
                mist = ist
                ist = 0
            End If
            sumFps += rfps
            N += 1
            If N >= rfps / 2 Then
                averageFps = sumFps / N
                N = 0
                sumFps = 0
            End If
            Dim As String s = Ucase(Inkey)
            Select Case s
            Case "+"
                If fps < 200 Then fps += 1
            Case "-"
                If fps > 10 Then fps -= 1
            Case "T"
                skipping = True
            Case "F"
                skipping = False
            Case "S"
                If skipping = True Then remove = False
            Case "R"
                If skipping = True Then remove = True
            Case Chr(27)
                Exit do
            End Select
        Loop

[fxm]

Note about 'regulateLite()':

We can notice that for these graphic animations, the mode of operation with 'image skipping' activated plus 'skipped image' removed by the user makes it possible to reach higher FPS, because in these two cases the user code has well separated the drawing part of the new image (the only part that should not be executed when the 'skipped image' tag is true) from the calculation part of the parameters for the new image (which must always be executed).
Otherwise, if these two parts of code are skipped at the same time (or even only a small portion of the progress of the movement), the graphical drawing will on the contrary be slowed down (although the returned FPS value says otherwise).

This operating configuration ('image skipping' +'skipped image' user removing) is therefore the most efficient (from the point of view of apparent FPS) but imposes complete separation rules between two tasks (tracing only and calculating only) in the user animation code loop.

On the other hand, the 'image skipping' configuration alone (with 'skipped image' scrolled by default) does not require any coding rules for the user.

[fxm]

Maximum performance estimation and emulation of it with 'regulateLite()'

Maximum performance estimation

Simple modeling of the user loop and its environment:
- tt : execution time of the tracing task
- tc : execution time of the calculation task (+ other process)
- tm : time of the minimum delay generated by 'regulateLite()' (depending on the OS cycle period) = 16 ms (for Windows in normal resolution)
- fm = minimum frequency of the true FPS authorized by 'regulateLite()' in case of 'image skipping' = 10 Hz (fixed in the code)
- siM = maximum number of skipped images + 1 = 20 (fixed in the code)

This estimate neglects the execution time of 'regulateLite()' except obviously the delay (tm) it generates.

- Without 'image skipping':
FPSmax = 1 / (tt + tc + tm)

- With 'image skipping' alone (skipped images scrolled):
k = Int((1 / fm - tm) / (tt + tc))
k = Iif(k < siM, k, siM)
apparent FPSmax = Cint(1 / (k * (tt + tc) + tm) * k)
('k' value corresponds to the number of 'skipped images' + 1 : 'k - 1' skipped images over 'k')

- With 'image skipping' + skipped images removed by user:
k = Int((1 / fm - tm - tt) / tc)
k = Iif(k < siM, k, siM)
apparent FPSmax = Cint(1 / (k * tc + tt + tm) * k)
('k' value corresponds to the number of 'skipped images' + 1 : 'k - 1' skipped images over 'k')

FPS max estimation code (with also the quota of number of 'skipped images' returned):

TestSimulationMaxPerf:

Code: Select all

Const As Double tm = 0.016  ' time of the minimum delay generated by 'regulateLite()' (depending on the OS cycle period)
Const As Double fm = 10     ' minimum frequence of the true FPS authorized by 'regulateLite()' in case of 'image skipping'
Const As Integer siM = 20   ' maximum number of skipped images + 1

Type FPS
    Dim As Integer fps1  '' FPS without 'image skipping'
        Dim As Integer si1   '' number of 'kipped images' (always 0)
    Dim As Integer fps2  '' apparent FPS with 'image skipping' alone ('skipped images' scrolled)
        Dim As Integer si2   '' number of 'kipped images' (scrolled)
    Dim As Integer fps3  '' apparent FPS with 'image skipping' + 'skipped images' removed by user
        Dim As Integer si3   '' number of 'skipped images' (removed)
End Type

Function FpsMax(Byval tt As Double, Byval tc As Double) As FPS
    ' tt : execution time of the tracing task
    ' tc : execution time of the calculation task (+ other process)
    
    Dim As Integer k = 1
    Dim As FPS myFPS
    myFPS.fps1 = Cint(1 / (tt + tc + tm))
    myFPS.si1 = k - 1
    K = Int((1 / fm - tm) / (tt + tc))
    k = Iif(k < siM, k, siM)
    myFPS.fps2 = Cint(1 / (k * (tt + tc) + tm) * k)
    myFPS.si2 = k - 1
    k = Int((1 / fm - tm - tt) / tc)
    k = Iif(k < siM, k, siM)
    myFPS.fps3 = Cint(1 / (k * tc + tt + tm) * k)
    myFPS.si3 = k - 1
    Return myFPS
End Function

Sub printFpsMax(Byval tt As Double, Byval tc As Double)
    ' tt : execution time of the tracing task
    ' tc : execution time of the calculation task (+ other process)
    
    Dim As FPS myFPS = FpsMax(tt, tc)
    Print "tt = " & 1000 * tt & " ms, tc = " & 1000 * tc & " ms, tm = " & 1000 * tm & " ms, fm = " & fm & " Hz, siM = " & siM
    Print "FPS without 'image skipping'                                  = " & myFPS.fps1 & "  " & myFPS.si1
    Print "apparent FPS with 'skipped images' only (these just scrolled) = " & myFPS.fps2 & "  " & myFPS.si2 & "/" & myFPS.si2 + 1
    Print "apparent FPS with 'skipped images' plus these removed by user = " & myFPS.fps3 & "  " & myFPS.si3 & "/" & myFPS.si3 + 1
    Print
End Sub

printFpsMax(0.005, 0.010)
printFpsMax(0.0075, 0.0075)
printFpsMax(0.010, 0.005)

Sleep

Results with 3 combinations of tt and tc all so that tt + tc = 15 ms, and on Windows in normal resolution:
('FPS' value followed with the quota of number of 'skipped images')

Code: Select all

tt = 5 ms, tc = 10 ms, tm = 16 ms, fm = 10 Hz, siM = 20
FPS without 'image skipping'                                  = 32  0
apparent FPS with 'skipped images' only (these just scrolled) = 55  4/5
apparent FPS with 'skipped images' plus these removed by user = 77  6/7

tt = 7.5 ms, tc = 7.5 ms, tm = 16 ms, fm = 10 Hz, siM = 20
FPS without 'image skipping'                                  = 32  0
apparent FPS with 'skipped images' only (these just scrolled) = 55  4/5
apparent FPS with 'skipped images' plus these removed by user = 102  9/10

tt = 10 ms, tc = 5 ms, tm = 16 ms, fm = 10 Hz, siM = 20
FPS without 'image skipping'                                  = 32  0
apparent FPS with 'skipped images' only (these just scrolled) = 55  4/5
apparent FPS with 'skipped images' plus these removed by user = 146  13/14

To better highlight the maximum accessible FPS values with 'regulateLite()', depending on the duration of the 2 tasks in the user loop (tracing task and calculation task (+ other process)), a complete table of estimated values (by the code above) is below provided (duration of the 2 tasks ranging from 1 ms to 9 ms each in steps of 1 ms):

Code: Select all

Constant tm = 0.016 : time of the minimum delay generated by 'regulateLite()' (depending on the OS cycle period)
Constant fm = 10    : minimum frequence of the true FPS authorized by 'regulateLite()' in case of 'image skipping'
Constant siM = 20   : maximum number of skipped images + 1

Variable tt : execution time of the tracing task
Variable tc : execution time of the calculation task (+ other process)

For each couple (tt,tc) of values, 3 FPS max are estimated, and for each the quota of 'skipped images':
   - FPS without 'image skipping'                                         , number of 'skipped images' (always '0')
   - Apparent FPS with 'image skipping' ('skipped images' only scrolled)  , quota of 'skipped images' (only scrolled)
   - Apparent FPS with 'image skipping' + 'skipped images' removed by user, quota of 'skipped images' removed by user

          | tt = 1 ms | tt = 2 ms | tt = 3 ms | tt = 4 ms | tt = 5 ms | tt = 6 ms | tt = 7 ms | tt = 8 ms | tt = 9 ms |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  56 0     |  53 0     |  50 0     |  48 0     |  45 0     |  43 0     |  42 0     |  40 0     |  38 0     |
tc = 1 ms | 357 19/20 | 263 19/20 | 208 19/20 | 167 15/16 | 140 13/14 | 120 11/12 | 104 9/10  |  93 8/9   |  83 7/8   |
          | 541 19/20 | 526 19/20 | 513 19/20 | 500 19/20 | 488 19/20 | 476 19/20 | 465 19/20 | 455 19/20 | 444 19/20 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  53 0     |  50 0     |  48 0     |  45 0     |  43 0     |  42 0     |  40 0     |  38 0     |  37 0     |
tc = 2 ms | 263 19/20 | 208 19/20 | 167 15/16 | 140 13/14 | 120 11/12 | 104 9/10  |  93 8/9   |  83 7/8   |  75 6/7   |
          | 351 19/20 | 345 19/20 | 339 19/20 | 333 19/20 | 328 19/20 | 323 19/20 | 317 19/20 | 312 19/20 | 308 19/20 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  50 0     |  48 0     |  45 0     |  43 0     |  42 0     |  40 0     |  38 0     |  37 0     |  36 0     |
tc = 3 ms | 208 19/20 | 167 15/16 | 140 13/14 | 120 11/12 | 104 9/10  |  93 8/9   |  83 6/7   |  75 6/7   |  70 6/7   |
          | 260 19/20 | 256 19/20 | 253 19/20 | 250 19/20 | 247 19/20 | 244 19/20 | 241 19/20 | 238 19/20 | 235 19/20 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  48 0     |  45 0     |  43 0     |  42 0     |  40 0     |  38 0     |  37 0     |  36 0     |  34 0     |
tc = 4 ms | 167 15/16 | 140 13/14 | 120 11/12 | 104 9/10  |  93 8/9   |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |
          | 206 19/20 | 204 19/20 | 202 19/20 | 200 19/20 | 196 18/19 | 194 18/19 | 192 18/19 | 190 18/19 | 186 17/18 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  45 0     |  43 0     |  42 0     |  40 0     |  38 0     |  37 0     |  36 0     |  34 0     |  33 0     |
tc = 5 ms | 140 13/14 | 120 11/12 | 104 9/10  |  93 8/9   |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |  60 5/6   |
          | 165 15/16 | 163 15/16 | 162 15/16 | 160 15/16 | 156 14/15 | 155 14/15 | 153 14/15 | 152 14/15 | 150 14/15 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  43 0     |  42 0     |  40 0     |  38 0     |  37 0     |  36 0     |  34 0     |  33 0     |  32 0     |
tc = 6 ms | 120 11/12 | 104 9/10  |  93 8/9   |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |  60 5/6   |  55 4/5   |
          | 137 12/13 | 135 12/13 | 134 12/13 | 133 12/13 | 131 12/13 | 130 12/13 | 126 11/12 | 125 11/12 | 124 11/12 |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  42 0     |  40 0     |  38 0     |  37 0     |  36 0     |  34 0     |  33 0     |  32 0     |  31 0     |
tc = 7 ms | 104 9/10  |  98 8/9   |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |  60 5/6   |  55 4/5   |  52 4/5   |
          | 117 10/11 | 116 10/11 | 115 10/11 | 113 10/11 | 112 10/11 | 111 10/11 | 110 10/11 | 106 9/10  | 105 9/10  |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  40 0     |  38 0     |  37 0     |  36 0     |  34 0     |  33 0     |  32 0     |  31 0     |  30 0     |
tc = 8 ms |  93 8/9   |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |  60 5/6   |  55 4/5   |  52 4/5   |  48 3/4   |
          | 103 9/10  | 102 9/10  | 101 9/10  | 100 9/10  |  97 8/9   |  96 8/9   |  95 8/9   |  94 8/9   |  93 8/9   |
----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|-----------|
          |  38 0     |  37 0     |  36 0     |  34 0     |  33 0     |  32 0     |  31 0     |  30 0     |  29 0     |
tc = 9 ms |  83 7/8   |  75 6/7   |  70 6/7   |  64 5/6   |  55 5/6   |  55 4/5   |  52 4/5   |  48 3/4   |  45 3/4   |
          |  92 8/9   |  91 8/9   |  90 8/9   |  87 7/8   |  86 7/8   |  85 7/8   |  84 7/8   |  83 7/8   |  82 7/8   |
-----------------------------------------------------------------------------------------------------------------------

Maximum performance emulation

I wrote an emulation code with two TIMER waiting loops (for tt and tc), and calling the real 'regulateLite()', which allows to validate the order of magnitude of the results above.
Use the runtime commands to adjust the tt and tc values and test the 3 configurations using the optional parameters.
This test code works with the resolution from the OS cycle.

TestEmulationMaxPerf:

Code: Select all

Dim As Integer tt = 10  ' (in milliseconds)
Dim As Integer tc =  5  ' (in milliseconds)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Screen 12, , 2
Screenset 1, 0

Dim As Ulongint MyFps = 9999
    
Dim As String res = "N"
Dim As Boolean SkipImage = False
Dim As Boolean RemoveImageSkipped = False

Do
    Static As Ulong fps
    Static As Ulong averageFps
    Static As Double sumFps
    Static As Long N
    Static As Boolean ImageSkipped
    Static As Long ist = 0
    Static As Long mist = 0
    Static As ULongInt l
    Dim As Double t1
    Dim As Double t2
    If (RemoveImageSkipped = False) OR (ImageSkipped = False) Then
        t1 = Timer
        Cls
        Print
        Color 15
        Print "          MAXIMUM PERFORMANCE EMULATION of 'regulateLite()' regulation"
        Print
        Print
        Print Using " tt = ## ms   (execution time of the tracing task)"; tt
        Print Using " tc = ## ms   (execution time of the calculation task + other process)"; tc
        Print
        Print " Procedure : regulateLite( "; MyFPS & " [, " & SkipImage & " ])";
        If SkipImage = True Then
            Select Case RemoveImageSkipped
            Case True
                Print "      Images skipped : Removing"
            Case False
                Print "      Images skipped : Scrolling"
            End Select
        Else
                Print "     No image skipping"
        End If
        Print
        Print
        Color 11
        If mist = 0 Then
            Print Using " Applied true FPS max     :####         (average :####)"; fps; averageFps
        Else
            Print Using " Applied apparent FPS max :####         (average :####)"; fps; averageFps
        End If
        If SkipImage = True Then
            Select Case RemoveImageSkipped
            Case True
                Print "    Images removed        :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
            Case False
                Print "    Images scrolled       :  " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")
            End Select
        Else
                Print "    No image skipped"
        End If
        Print
        Print
        Color 14
        Print " <+>        : Increment tt"
        Print " <->        : Decrement tt"
        Print
        Print " <i> or <I> : Increment tc"
        Print " <d> or <D> : Decrement tc"
        Print
        Print " Optional parameter :"
        Print "    <t> or <T> : True for image skipping"
        If SkipImage = True Then
            Print "        <r> or <R> : Remove image skipped"
            Print "        <s> or <S> : Scroll image skipped"
        End If
        Print "    <f> or <F> : False for image skipping"
        Print
        Print " <escape>   : Quit"
        Line (0, 197)-(639, 199), 3, B
        Line (0, 198)-(l, 198), 11
        Do
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
            t2 = Timer
            If t2 < t Then t -= 24 * 60 * 60
        Loop Until t2 >= t1 + tt / 1000
        #else
        Loop Until Timer >= t1 + tt / 1000
        #endif
        Screencopy
    End If
    t1 = Timer
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If tt < 30 Then tt += 1
    Case "-"
        If tt > 1 Then tt -= 1
    Case "I"
        If tc < 30 Then tc += 1
    Case "D"
        If tc > 1 Then tc -= 1
    Case "T"
        SkipImage = True
    Case "F"
        SkipImage = False
    Case "R"
        If SkipImage = True Then RemoveImageSkipped = True
    Case "S"
        If SkipImage = True Then RemoveImageSkipped = False
    Case Chr(27)
        Exit Do
    End Select
    sumFps += fps
    N += 1
    If N >= fps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    If ImageSkipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    l = (l + 1) Mod 640
    Do
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        t2 = Timer
        If t2 < t Then t -= 24 * 60 * 60
    Loop Until t2 >= t1 + tc / 1000
    #else
    Loop Until Timer >= t1 + tc / 1000
    #endif
    fps = regulateLite(MyFPS, SkipImage, , ImageSkipped)
Loop

Note: As the applied FPS is at maximum limit, 'regulateLite()' periodically refreshes the value of tm (calibration at runtime), so the FPS values found can shift at each new calibration (slow rate).

[fxm]

A third graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Paper star.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 75 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 27, CPU load = 5.6 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 56, CPU load = 10.4 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 75, CPU load = 5.4 %
(maximum accessible applied FPS in this third configuration: about 210, at limit of N=20)

From requested FPS = 150, I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 32, CPU load = 5.7 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 56, CPU load = 10.6 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 150, CPU load = 7.5 %
(maximum accessible applied FPS in this third configuration: about 210, at limit of N=20)

Code

Test7:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=275513#p275513)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type pt
    As Single x,y,z
End Type

Type angle
    As Single a(1 To 6)
    Declare Sub set(Byref p As pt)
End Type

Sub angle.set(Byref p As pt) 
    This= Type<angle>({Sin(p.x),Sin(p.y),Sin(p.z),Cos(p.x),Cos(p.y),Cos(p.z)}) 
End Sub

Type PaperStar
    As pt p(Any)
    As angle a
    As pt ctr
    As Ulong col
    As pt da
    As pt b
    Declare Constructor
    Declare Constructor(Byval As Long,Byval As Long,Byval As Long,Byval As Single,Byref As pt,Byval As Ulong,Byval num As Long)
    Declare Sub fill(Byval im As Any Ptr=0)
    Declare Function rotate() As PaperStar
End Type

#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,Byval begin As Long,Byval Finish As Long)
    Dim As Long i=begin,j=finish
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro  
        
        #define range(f,l) Rnd*((l)-(f))+(f)
        #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
        Function Rotate(Byref c As pt,Byref p As pt,Byref a As angle,Byref scale As pt=Type<pt>(1,1,1)) As pt
            Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
            Return Type<pt>((scale.x)*((a.a(5)*a.a(6))*dx+(-a.a(4)*a.a(3)+a.a(1)*a.a(2)*a.a(6))*dy+(a.a(1)*a.a(3)+a.a(4)*a.a(2)*a.a(6))*dz)+c.x,_
            (scale.y)*((a.a(5)*a.a(3))*dx+(a.a(4)*a.a(6)+a.a(1)*a.a(2)*a.a(3))*dy+(-a.a(1)*a.a(6)+a.a(4)*a.a(2)*a.a(3))*dz)+c.y,_
            (scale.z)*((-a.a(2))*dx+(a.a(1)*a.a(5))*dy+(a.a(4)*a.a(5))*dz)+c.z)',p.col)
        End Function
        
        Function perspective(Byref p As pt,Byref eyepoint As pt) As pt
            Dim As Single   w=1+(p.z/eyepoint.z)
            Return Type<pt>((p.x-eyepoint.x)/w+eyepoint.x,_
            (p.y-eyepoint.y)/w+eyepoint.y,_
            (p.z-eyepoint.z)/w+eyepoint.z)',p.col)
        End Function 
        
        Sub star(Byval starX As Single,Byval starY As Single,Byval size As Single,Byval num As Long=5,Byval cut As Single=.4,s() As pt)
            Redim s(2*num)
            Var count=0,rad=0.0,_px=0.0,_py=0.0,pi=4*Atn(1)
            Var rot=0
            For z As Single=0+.28 +rot To 2*pi+.1+.28 +rot Step 2*pi/(2*num)
                count=count+1
                If count Mod 2=0 Then rad=size Else rad=cut*size
                _px=starx+rad*Cos(z)
                _py=stary+rad*Sin(z)
                s(count-1).x=_px
                s(count-1).y=_py
            Next z
        End Sub
        
        Function getctr(Byref s As PaperStar) As pt
            Dim As Single cx,cy,cz
            Dim As Long sz=Ubound(s.p)+1
            For n As Long=Lbound(s.p) To Ubound(s.p)
                cx+=s.p(n).x
                cy+=s.p(n).y
                cz+=s.p(n).z
            Next
            Return Type(cx/sz,cy/sz,cz/sz)
        End Function
        
        
        Constructor PaperStar
        End Constructor
        
        Constructor PaperStar(Byval x As Long,Byval y As Long,Byval z As Long,Byval sz As Single,Byref a As pt,Byval colour As Ulong,Byval n As Long)
        star(x,y,sz,n,range(.2,.6),p())
        ctr=getctr(This)
        For n As Long=Lbound(p) To Ubound(p)
            p(n).z=z
        Next
        da=a
        col=colour
        End Constructor
        
        Sub PaperStar.fill(Byval im As Any Ptr=0)
            #define ub Ubound
            Dim As Long Sy=1e6,By=-1e6,i,j,y,k
            Dim As Single a(Ub(p)+1,1),dx,dy
            For i =0 To Ub(p)
                a(i,0)=p(i).x
                a(i,1)=p(i).y
                If Sy>p(i).y Then Sy=p(i).y
                If By<p(i).y Then By=p(i).y
            Next i
            Dim As Single xi(Ub(a,1)),S(Ub(a,1))
            a(Ub(a,1),0) = a(0,0)
            a(Ub(a,1),1) = a(0,1)
            For i=0 To Ub(a,1)-1
                dy=a(i+1,1)-a(i,1)
                dx=a(i+1,0)-a(i,0)
                If dy=0 Then S(i)=1
                If dx=0 Then S(i)=0
                If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
            Next i
            For y=Sy-1 To By+1
                k=0
                For i=0 To Ub(a,1)-1
                    If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
                    (a(i,1)>y Andalso a(i+1,1)<=y) Then
                    xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
                    k+=1
                End If
            Next i
            For j=0 To k-2
                For i=0 To k-2
                    If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
                Next i
            Next j
            For i = 0 To k - 2 Step 2
                Line im,(xi(i),y)-(xi(i+1)+1,y),col
            Next i
        Next y
    End Sub
    
    Function PaperStar.rotate() As PaperStar
        b.x+=da.x
        b.y+=da.y
        b.z+=da.z 
        a.set(b)
        Dim As PaperStar s=This
        ctr= getctr(s)
        For n As Long=Lbound(p) To Ubound(p)
            s.p(n)= ..Rotate(ctr,this.p(n),a)
            s.p(n)= perspective(s.p(n),Type(512,768\2,1500))
        Next
        Return s
    End Function
    
    #define rcolour Rgb(100+Rnd*155,100+Rnd*155,100+Rnd*155)
    Screenres 800, 640, 32
    Width 800 \ 8, 640 \ 16
    Dim As PaperStar s(1 To 1000)
    For n As Long=1 To Ubound(s)
        Dim As pt tmp=Type((Rnd-Rnd)/20,(Rnd-Rnd)/20,(Rnd-Rnd)/20)
        s(n)=PaperStar(range(-100,1100),range(-100,800),Rnd*2400,15,tmp,rcolour,irange(3,9))
    Next
    
    SetQsort(PaperStar,QsortZ,down,.ctr.z)
    
    Dim As PaperStar z(1 To Ubound(s))
    Dim As Long fps=75,rfps
    Dim As Boolean skipping=False,remove=False,skipped
    Dim As Long ist,mist
    Dim As Ulong averageFps
    Dim As Double sumFps
    Dim As Long N
    #define onscreen(Q) Q.ctr.x>0 And Q.ctr.x<1024 And Q.ctr.y>0 And Q.ctr.y<768 'and Q.ctr.z <1800
    Do
        
        For n As Long=1 To Ubound(s)
            For m As Long=Lbound (s(n).p) To Ubound (s(n).p)
                s(n).p(m).z-=15
            Next m
            z(n)=s(n).rotate
            If s(n).ctr.z<-1480+40 Or  onscreen(s(n))=0 Then
                Dim As pt tmp=Type((Rnd-Rnd)/20,(Rnd-Rnd)/20,(Rnd-Rnd)/20)
                s(n)=PaperStar(range(-400,1400),range(-400,1200),900+Rnd*(2700),15,tmp,rcolour,irange(3,9))
            End If
        Next n
        If (remove = False) Or (skipped = False) Then
            Screenlock
            Cls
            QsortZ(z(),1,Ubound(z))
            For n As Long=1 To Ubound(z)
                If onscreen(z(n)) Then
                    z(n).fill()
                End If
            Next n
            Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
            Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
            Draw String (16,48),"Status : " & _
                iif(skipping = True, "Image skipping activation = true, with " & _
                iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
                "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
                "Image skipping activation = false")
            Draw String (16,80),"<+> : Increase FPS"
            Draw String (16,96),"<-> : Decrease FPS"
            Draw String (16,128),"<t> or <T> : True for image skipping activation"
            If Skipping = True Then
                Draw String (16,144),"   <s> or <S> : Scroll image skipped"
                Draw String (16,160),"   <r> or <R> : Remove image skipped"
                Draw String (16,176),"<f> or <F> : False for image skipping activation"
                Draw String (16,208),"<escape> : Quit"
            Else
                Draw String (16,144),"<f> or <F> : False for image skipping activation"
                Draw String (16,176),"<escape> : Quit"
            End If
            Draw String (544,608),"Graphic animation from dodicat"
            Screenunlock
        End If
        rfps = regulateLite(fps,skipping, ,skipped)
        If skipped = True Then
            ist += 1
        Else
            mist = ist
            ist = 0
        End If
        sumFps += rfps
        N += 1
        If N >= rfps / 2 Then
            averageFps = sumFps / N
            N = 0
            sumFps = 0
        End If
        Dim As String s = Ucase(Inkey)
        Select Case s
        Case "+"
            If fps < 250 Then fps += 1
        Case "-"
            If fps > 10 Then fps -= 1
        Case "T"
            skipping = True
        Case "F"
            skipping = False
        Case "S"
            If skipping = True Then remove = False
        Case "R"
            If skipping = True Then remove = True
        Case Chr(27)
            Exit do
        End Select
    Loop

[fxm]

A forth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Orb clamping chain.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 75 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 25, CPU load = 5.3 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 39, CPU load = 10.0 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 75, CPU load = 5.6 %
(maximum accessible applied FPS in this third configuration: about 165, at limit of N=20)

From requested FPS = 150, I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 32, CPU load = 5.0 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 55, CPU load = 9.2 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 150, CPU load = 5.3 %
(maximum accessible applied FPS in this third configuration: about 250, at limit of N=20)

Code

Test8:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=206462#p206462)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type V3
    As Single x,y,z
    As ulong col
    As Integer flag 'interceptor
    Declare Property length As Single
    #define vct Type<v3>
    #define dot *  'not used here
    #define cross ^
End Type

Type _float
    As Single x,y,z
    End Type

Type Line
    As v3 v1,v2
End Type

Type sphere As V3

'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
    Sub fname(array() As datatype,Byval begin As Long,Byval Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
        While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J > begin Then fname(array(),begin,J)
    If I < Finish Then fname(array(),I,Finish)
    End Sub
#endmacro      
'<><><><><><><><><><><><><><><><><><><><><><>

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Operator + (Byref v1 As v3,Byref v2 As v3) As v3
Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(Byref v1 As v3,Byref v2 As v3) As v3
Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (Byval f As Single,Byref v1 As v3) As v3
Return vct(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * (Byref v1 As v3,Byref v2 As v3) As Single 'dot product (unused here)
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 'cross product
Return vct(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator

Property v3.length As Single
Return Sqr(x*x+y*y+z*z)
End Property

'GLOBALS
Dim Shared As v3 eyepoint=vct(400,300,900)

Sub RotateArray(wa() As V3,result() As V3,Byref angle As _float,Byref centre As V3,Byval flag As Long=0)
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
                result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
                result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y 
                result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
                #endmacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
                result(z).flag=wa(z).flag
            Next z
        End Sub
   'create a tube element at a distance from a line     
Function segdist(Byref l As Line,Byref p As v3,Byref ip As v3=vct(0,0,0)) As Single
    Dim As Single linelength=(l.v1-l.v2).length
    Dim As Single dist= ((1/linelength)*((l.v1-l.v2) cross (p-l.v1))).length
    Dim As Single lpf=(p-l.v2).length,lps=(p-l.v1).length
    If lps >= lpf Then
        Var temp=Sqr(lps*lps-dist*dist)/linelength
        'If temp>=1 Then temp=1:dist=lpf
        ip=l.v1+temp*(l.v2-l.v1)
        Return dist
    Else
        Var temp=Sqr(lpf*lpf-dist*dist)/linelength
        'If temp>=1 Then temp=1:dist=lps
        ip=l.v2+temp*(l.v1-l.v2)
        Return dist
    End If
End Function

'if a point lies on a sphere
Function onsphere(Byref S As sphere,Byref P As V3) As Long
 Return (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.col*S.col Andalso _
        (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.col-1)*(S.col-1)
End Function

Sub AddARing(b() As V3,Byval id as long,Byval clr as ulong=rgb(200,0,0),Byval sz As Long,Byref centre As V3,Byval rad As Long,Byval flipflag As Long=0,Byval smoothness as long=50)
    redim as V3 a(0)'(lbound(b,2) to ubound(b,2))
    'for n as integer=lbound(a) to ubound(a)
        'a(n)=b(id,n)
       ' next n
    Dim As Long num=smoothness
    Dim As Single pi=4*Atn(1),dd=2*pi*rad/num
    Redim As V3 temp(0)':Redim a(0)
 Dim As Line L1=Type<Line>((centre.x-dd,centre.y-rad),(centre.x+dd,centre.y-rad))   
Dim As Long ctr
'Dim As ulong clr
For x As Long=L1.v1.x To L1.v2.x Step 2
    For y As Long=L1.v1.y-sz To L1.v2.y+sz Step 2
        For z As Long=-sz To sz Step 2
            var v=Type<V3>(x,y,z)
            var sd=segdist(L1,v)
            If sd>sz andalso sd<sz+2 Then
                ctr+=1
                  var cc=Cptr(Ubyte Ptr,@clr)
                Redim Preserve temp(1 To ctr)
                var mp=map(-sz,sz,z,.9,.3)
                var nc=Rgb(mp*cc[2],mp*cc[0],mp*cc[1])
                temp(ctr)=vct(x,y,z,nc)
            End If
        Next z
    Next y
Next x
Dim As Long u
           #macro build(array)
            u=Ubound(a)
            Redim Preserve a(1 To u+Ubound(array))
            For n As Long=Lbound(array) To Ubound(array)
                a(u+n)=array(n)
            Next n
            #endmacro
            build(temp)
            Dim As V3 temp2(Lbound(temp) To Ubound(temp))
            'tube element created
            'now revolve it around a circle, save the points
            'to produce a torus
       For z As Long=1 To num/2     
      RotateArray(temp(),temp2(),Type<_float>(0,0,z*2*pi/(num/2)),centre)      
          build(temp2) 
      Next z
       If flipflag=1 Then 'Flip torus horizontal
           Redim  As V3 copy(Lbound(a) To Ubound(a))
            RotateArray(a(),copy(),Type<_float>(pi/2,0,0),centre) 
       For n As Long=Lbound(a) To Ubound(a)
              a(n)=copy(n)
          Next n
        End If
        
        redim preserve b(lbound(b,1) to ubound(b,1),lbound(a) to ubound(a))
      for n as integer=lbound(a) to ubound(a)
        b(id,n)=a(n)
        next n  
End Sub
Sub addasphere(a() As V3,Byref pt As V3,Byval rad As Long)
    Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter=Ubound(a)
        Dim As sphere sp=Type<sphere>(xx,yy,zz,r)
        For x As Long= xx-r To xx+r Step 2
            For y As Long=yy-r To yy+r Step 2
                For z As Long=zz-r To zz+r Step 2
                    If onsphere(sp,Type<V3>(x,y,z)) Then
                        counter+=1
                        Redim Preserve a(Lbound(a) To counter)
                        a(counter)=Type<V3>(x,y,z,Rgb(Rnd*255,Rnd*255,Rnd*255),1)
                    End If
                Next z
            Next y
        Next x
    End Sub
    
           'build up the main array a(), as another ring is added
           #macro buildA(array,i)
            u=Ubound(a)
            Redim Preserve a(1 To u+Ubound(array,2))
            For n2 As Long=Lbound(array,2) To Ubound(array,2)
                a(u+n2)=array(i,n2)
            Next n2
            #endmacro
Dim As Long u

Redim  As V3 a(0) 'main  array
dim as long smoothing=50
Redim As V3 r(1 to 9,0)'9 ring chain
dim as integer k=1

for n as long=1 to 9
    AddARing(r(),n,rgb(rnd*255,rnd*255,rnd*255),5,Type(80*n,300,0),50,n mod 2,smoothing)
    buildA(r,n)
    next n

AddASphere(a(),Type<V3>(550,300,0),40)
AddASphere(a(),Type<V3>(250,300,0),40)
AddASphere(a(),Type<V3>(400,300,0),40)

'        udt  name  dirn field
SetQsort(V3,QsortZ,down,.z) 'Set Up the quicksort for UDT V3, on z

Redim As V3 b(Lbound(a) To Ubound(a)) 'feeder array
Dim As Single ang,rad
Dim As Long fps=75,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N
Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
Color ,Rgb(0,150,255)
Do
    ang+=.015
    RotateArray(a(),b(),Type<_float>(ang,ang/2,ang/3),vct(400,300,0),1)
    If (remove = False) Or (skipped = False) Then
        Screenlock
        Cls
        Qsortz(b(),Lbound(b),Ubound(b))
        For n As Long=Lbound(b) To Ubound(b)
            If b(n).flag=1 Then
                rad=1 'the sphere points
            Else
                rad=map(-400,400,b(n).z,4,2) 'the ring points (a little fuller)
            End If
            Circle(b(n).x,b(n).y),rad,b(n).col,,,,f
        Next n
        Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
        Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (544,608),"Graphic animation from dodicat"
        Screenunlock
    End If
    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 300 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
Loop

[fxm]

A fifth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Here.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 30 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 15, CPU load = 7.6 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 18, CPU load = 9.8 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 30, CPU load = 9.6 %
(maximum accessible applied FPS in this third configuration: about 32)

From requested FPS = 40, I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 21, CPU load = 7.9 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 25, CPU load = 10.2 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 40, CPU load = 9.7 %
(maximum accessible applied FPS in this third configuration: about 43)

Code

Test9:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=235997#p235997)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
    Sub fname(array() As datatype,Byval begin As Long,Byval Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
        While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J > begin Then fname(array(),begin,J)
    If I < Finish Then fname(array(),I,Finish)
    End Sub
#endmacro      
'<><><><><><><><><><><><><><><><><><><><><><>

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
dim shared as long bts
screeninfo ,,bts
dim as any ptr i=imagecreate(200,200,rgb(0,200,0))

Type Point 'VECTOR POINT
    As double x,y,z
    As Ulong col
    as byte flag
End Type

SetQsort(point,QsortZ,down,.z) 'set up the quicksort 

type sincos 'FLOATS for angles
    as single sx,sy,sz
    as single cx,cy,cz
    declare static function construct(Byval as single,Byval as single,Byval as single) as sincos
end type

#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro

function sincos.construct(Byval x as single,Byval y as single,Byval z as single) as sincos
    return   type <sincos>(sin(x),sin(y),sin(z), _
                           cos(x),cos(y),cos(z))
end function
   
Function RotatePoint(Byref c As Point,Byref p As Point,Byref a as sincos,Byref scale As sincos=Type<sincos>(1,1,1)) As Point
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<Point>((scale.sx)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.sy)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.sz)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col,p.flag)
End Function 

Function perspective(Byref p As Point,Byref eyepoint As Point) As Point
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z,p.col,p.flag)
End Function

function contrast(Byval c as ulong) as ulong 'make one random colour over another different
       dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
       do
           r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
           loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120
          return rgb(r2,g2,b2) 
end function
   
Sub _line(Byval x1 As long,Byval y1 As long,Byval x2 As long,Byval y2 As long,Byval l As long,Byval col As Ulong,byref xp as long=0,byref yp as long=0)
    Dim As long diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    if ln=0 then ln=1e-6
    Dim As Single nx=diffx/ln,ny=diffy/ln 
    xp=x1+l*nx:yp=y1+l*ny
    Line(x1,y1)-(xp,yp),col
End Sub

function shade(Byval c as ulong,Byval n as single) as ulong
   if bts<16 then  return c
   if n>1 or n<0 then exit function
    return rgba(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n,Cptr(Ubyte Ptr,@c)[3])
end function

#macro anotherplate()
a2=sincos.construct(-pi/2,0,0)
ub=ubound(a)
for n as long=lbound(a) to ubound(a)/2
    var tmp=rotatepoint(type<point>(cx,cy),a(n),a2)
    redim preserve a(ub+n)
    a(ub+n)=tmp
next n 
#endmacro

'============================ set up the plates =======================
start:
randomize 3
#define IR IntRange(0,3)

for x as long=0 to 200 step 20
    for y as long=0 to 200 step 20
        dim as ulong col=rgb(rnd*255,rnd*255,rnd*255)
        line i,(x,y)-(x+20,y+20),col,bf
        draw string i,(x+8,y+4),chr(IntRange(48,57)),contrast(col)
next:next

'capture the image in an array
redim as point a()

dim as long ctr,cx,cy
for x as long=0 to 159
    for y as long=0 to 159
        ctr+=1
        redim preserve a(1 to ctr)
        a(ctr)=type(x,y,0,point(x,y,i),IR)
        cx+=x:cy+=y
    next
next
cx=cx/ctr:cy=cy/ctr'centre of plate
'Rotate the plate 90 degrees on y axis and add to the first plate
ctr=0

var ub=ubound(a)+1
dim as single pi=4*atn(1)

var a2=sincos.construct(0,-pi/2,0)
for n as long=lbound(a) to ubound(a)
    var tmp=rotatepoint(type<point>(cx,cy),a(n),a2)
    redim preserve a(ub+n)
    a(ub+n)=tmp
next n 

a2=sincos.construct(0,0,0)

dim as single sz=1.5
for n as long=lbound(a) to ubound(a)
    a(n)=rotatepoint(Type<Point>(cx,cy,0),a(n),a2,type<sincos>(sz,sz,sz))
    a(n).x+=400:a(n).y+=300
next n
cx+=400:cy+=300

'==================================

redim as point rot(lbound(a) to ubound(a))

dim as single cm,cs
dim as long finish
dim as sincos Mag
dim as single anglex,angley,anglez,minz,maxz,eye=800
Dim As Long fps=30,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N
Do
    maxz=1e-10
    minz=1e10
    Mag=type<sincos>(sz,sz,sz)'the scaler
    anglex-=.025:if anglex>2*pi then anglex=0
    angley-=.015:if angley>2*pi then anglez=0
    anglez-=.012:if anglez>2*pi then anglex=0
    
    var SC=sincos.construct(anglex,angley,anglez)
    eye=100+700*sz
    For n As long=Lbound(a) To Ubound(a)
        rot(n) =rotatepoint(Type<Point>(cx,cy,cm),a(n),SC,mag)
        rot(n) =perspective(rot(n),Type<Point>(cx,cy,eye))
        if maxz<rot(n).z then maxz=rot(n).z
        if minz>rot(n).z then minz=rot(n).z
    Next n
      
    Qsortz(rot(),Lbound(rot),Ubound(rot))
    
    If (remove = False) Or (skipped = False) Then
        Screenlock
        Cls
        For n As long=Lbound(a) To Ubound(a) 
            dim as single rad=map(maxz,minz,rot(n).z,1,2.75)
            dim as single s=map(maxz,minz,rot(n).z,.1,1) '
            circle(rot(n).x,rot(n).y),rad*sz,shade(rot(n).col,s),,,,f
        Next n
        Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
        Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (544,608),"Graphic animation from dodicat"
        Screenunlock
    End If

    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 100 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
Loop

imagedestroy i

When the drawing time is small compared to the total loop time, the contribution of 'image skipping' + 'user removes skipped image' is lower.

[fxm]

A sixth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation comes from dodicat : Fives cubes.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 450 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 61, CPU load = 0.03 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 360, CPU load = 7.0 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 450, CPU load = 0.1 %
(maximum accessible applied FPS in this third configuration: about 1100 but image too jerky, at limit of N=20)

From requested FPS = 450 (by default), I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 70, CPU load = 0.04 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 360, CPU load = 7.0 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 450, CPU load = 0.2 %
(maximum accessible applied FPS in this third configuration: about 1100 but image too jerky, at limit of N=20)

Code

Test10:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=252447#p252447)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type Point
    As Single x,y,z
    Declare Static Function rotate(Byref As Point,Byref As Point,Byref As Point,Byref As Point=Type<Point>(1,1,1)) As Point
    Declare Static Function perspective(Byref As Point,Byref As Point=Type(400,300,900)) As Point
End Type

Function dot(Byref v1 As Point,Byref v2 As Point) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y+ v1.z*v1.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)
    Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
    Return (v1x*v2x+v1y*v2y+v1z*v2z) 
End Function

Function point.Rotate(Byref c As Point,Byref p As Point,Byref angle As Point,Byref scale As Point) As Point
    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)',p.col)
End Function

Function point.perspective(Byref p As Point,Byref eyepoint As Point) As Point
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z)
End Function  

Type plane
    As Point p(1 To 4)
    Declare Sub Draw(Byval As Ulong)
    Declare Static Sub fill(() As Point,Byval As Ulong,Byval As Long,Byval As Long)
End Type

Sub plane.fill(a() As Point, Byval c As Ulong,Byval min As Long,Byval max As Long)
    'translation of a c snippet
    Static As Long i,j,k,dy,dx, x,y,temp
    Static As Long NewX (1 To Ubound(a))
    Static As Single Grad(1 To Ubound(a))
    For i=1 To Ubound(a) - 1 
        dy=a(i+1).y-a(i).y
        dx=a(i+1).x-a(i).x
        If(dy=0) Then Grad(i)=1
        If(dx=0) Then Grad(i)=0
        If ((dy <> 0) And (dx <> 0)) Then
            Grad(i) = dx/dy
        End If
    Next i
    For y=min To max
        k = 1
        For i=1 To Ubound(a) - 1
            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _
            Andalso (a(i+1).y<=y))) Then
            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))
            k +=1
        End If
    Next i
    For j = 1 To k-2
        For i = 1 To k-2
            If NewX(i) > NewX(i+1) Then
                temp = NewX(i)
                NewX(i) = NewX(i+1)
                NewX(i+1) = temp
            End If
        Next i
    Next j
    For i = 1 To k - 2 Step 2
        Line (NewX(i),y)-(NewX(i+1)+1,y), c
    Next i
Next y
End Sub

Sub plane.draw(Byval clr As Ulong)
    Static As Single miny=1e6,maxy=-1e6
    Static As Point V1(1 To  Ubound(p)+1)
    Dim As Long n
    For n =1 To Ubound(p)
        If miny>p(n).y Then miny=p(n).y
        If maxy<p(n).y Then maxy=p(n).y
        V1(n)=p(n) 
    Next
    v1(Ubound(v1))=p(Lbound(p))
    plane.fill(v1(),clr,miny,maxy)
End Sub

Type cube
    As plane f(1 To 6)
    As Point centre
    As Point norm(1 To 6) 'normals
    As Ulong clr(1 To 6)
    As Point aspect
    As Point d 'increment speed
    Declare Constructor()
    Declare Sub translate(Byref v As Point,Byval s As Double)
    Declare Sub turn(Byref As Point)
    Declare Function rotate(Byref As Point,Byref As Point) As cube
    Declare Static Sub bsort(() As cube)
    Declare Sub Draw
End Type

Constructor cube()
Dim As Double pi=4*Atn(1)
Static As Point g(1 To ...,1 To ...)={{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
                                     {(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
                                     {(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
                                     {(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
                                     {(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
                                     {(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base
For n As Long=1 To 6
    clr(n)=Rgb(Rnd*255,Rnd*255,Rnd*255) 'set a default colour
    For m As Long=1 To 4
        f(n).p(m)= g(n,m)  'set to g() 
    Next m
Next n
norm(1)=Type(0,0,-1) 'face normals
norm(2)=Type(1,0,0)
norm(3)=Type(0,0,1)
norm(4)=Type(-1,0,0)
norm(5)=Type(0,1,0)
norm(6)=Type(0,-1,0)
centre=Type(0,0,0)
'set some defaults
aspect=Type(Rnd*2*pi,Rnd*2*pi,Rnd*2*pi) 
For n As Long=1 To 6
    norm(n)=point.rotate(centre,norm(n),aspect)
    For m As Long=1 To 4
        f(n).p(m)=point.rotate(centre,f(n).p(m),aspect)
    Next
Next
d.x=(Rnd-Rnd)/50
d.y=(Rnd-Rnd)/50
d.z=(Rnd-Rnd)/50
End Constructor

Sub cube.turn(Byref p As Point)
    Dim As cube tmp=This
    For n As Long=1 To 6
        For m As Long=1 To 4
            tmp.f(n).p(m)=point.rotate(centre,this.f(n).p(m),p)
            tmp.f(n).p(m)=point.perspective(tmp.f(n).p(m))
        Next
    Next
    For n As Long=1 To 6
        tmp.norm(n)=point.rotate(centre,this.norm(n),p)'normals turn also
    Next
    tmp.draw
End Sub

Function cube.rotate(Byref c As Point,Byref ang As Point) As cube
    Dim As cube tmp=This
    For n As Long=1 To 6
        For m As Long=1 To 4
            tmp.f(n).p(m)=point.rotate(c,this.f(n).p(m),ang)
        Next
    Next
    For n As Long=1 To 6
        tmp.norm(n)=point.rotate(c,this.norm(n),ang)
    Next
    tmp.centre=point.rotate(c,this.centre,ang)
    Return tmp
End Function

Sub cube.translate(Byref v As Point,Byval s As Double)
    For n As Long=1 To 6
        norm(n).x*=s
        norm(n).y*=s
        norm(n).z*=s
        For m As Long=1 To 4
            f(n).p(m).x*=s
            f(n).p(m).y*=s
            f(n).p(m).z*=s
        Next m
    Next n
    For n As Long=1 To 6
        norm(n).x=norm(n).x+v.x
        norm(n).y=norm(n).y+v.y
        norm(n).z=norm(n).z+v.z
        For m As Long=1 To 4
            f(n).p(m).x= f(n).p(m).x+v.x 
            f(n).p(m).y= f(n).p(m).y+v.y
            f(n).p(m).z= f(n).p(m).z+v.z
        Next m
    Next n
    centre.x+=v.x
    centre.y+=v.y
    centre.z+=v.z
End Sub

Sub cube.draw
    Static As Ubyte Ptr col
    For n As Long=1 To 5
        For m As Long=n+1 To 6
            If norm(n).z<norm(m).z Then
                Swap f(n),f(m)
                Swap norm(n),norm(m)
                Swap clr(n),clr(m)
            End If
        Next m
    Next n
   #define map_(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    For n As Long=1 To 6
          col=Cptr(Ubyte Ptr,@clr(n))
      Var cx=norm(n).x-centre.x,cy=norm(n).y-centre.y,cz=norm(n).z-centre.z
      Var dt=dot(Type(cx,cy,cz),Type(0,1,0))
      dt=map_(1,-1,dt,.3,1)
        f(n).draw(Rgb(dt*col[2],dt*col[1],dt*col[0]))
    Next n
End Sub

Sub cube.bsort(c() As cube)
    For n As Long=Lbound(c) To Ubound(c)-1
        For m As Long=n+1 To Ubound(c)
            If c(n).centre.z<c(m).centre.z Then Swap c(n),c(m)
        Next
    Next
End Sub

Dim As cube c(1 To 5)
c(1).translate(Type(200,100,0),40)
c(2).translate(Type(600,100,0),40)
c(3).translate(Type(600,500,0),40)
c(4).translate(Type(200,500,0),40)
c(5).translate(Type(400,300,0),80)

Dim As Double pi2=8*Atn(1)
Dim As Double pi=4*Atn(1)
 For n As Long=Lbound(c) To Ubound(c)
         c(n)=c(n).rotate(Type(400,300,0),Type(0,pi/2,0))'flip 90 
        Next

Dim As cube tmp(Lbound(c) To Ubound(c))
Dim As Point a
'fix y and z
a.y=-pi/7
a.z=pi/2
Dim As Long fps=450,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
Color ,Rgb(0,0,100)

#define fmod(x,y) y*frac(x/y)
Do
    a.x+=.01:a.x=fmod(a.x,pi2)
    For n As Long=Lbound(c) To Ubound(c)
        tmp(n)=c(n).rotate(Type(400,300,0),a)
    Next
    cube.bsort(tmp())
    For n As Long=Lbound(tmp) To Ubound(tmp)
        c(n).aspect.x+=c(n).d.x: c(n).aspect.x=fmod(c(n).aspect.x,pi2)'turning angles
        c(n).aspect.y+=c(n).d.y: c(n).aspect.y=fmod(c(n).aspect.y,pi2)
        c(n).aspect.z+=c(n).d.z: c(n).aspect.z=fmod(c(n).aspect.z,pi2)
    Next
    For n As Long=Lbound(c) To Ubound(c)
        tmp(n)=c(n).rotate(Type(400,300,0),a)
    Next
    cube.bsort(tmp())
    If (remove = False) Or (skipped = False) Then
    Screenlock
    Cls
    For n As Long=Lbound(tmp) To Ubound(tmp)
        tmp(n).turn(Type(tmp(n).aspect.x,tmp(n).aspect.y,tmp(n).aspect.z))
    Next
        Draw String (16,16),"Requested FPS = " & Right("   " & fps, 4)
        Draw String (16,32),"Applied FPS   = " & Right("   " & rfps, 4) & "   (average = " & Right("   " & averageFps, 4) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (544,608),"Graphic animation from dodicat"
    Screenunlock
    End If
    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 1200 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
Loop

[fxm]

A seventh graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dafhi : Here.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 100 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 21, CPU load = 6.4 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 30, CPU load = 10.1 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 100, CPU load = 5.8 %
(maximum accessible applied FPS in this third configuration: about 250 but too jerky, at limit of N=20)

From requested FPS = 100 (by default), I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 21, CPU load = 5.6 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 33, CPU load = 9.4 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 47, CPU load = 9.8 %
(maximum accessible applied FPS in this third configuration: about 47)

Code

Test11:

Code: Select all

'' Graphic animation from dafhi (https://www.freebasic.net/forum/viewtopic.php?p=206413#p206413)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type V3
    As Long x,y,z
    As ulong col
    #define Tv Type<V3>
End Type

Type _float
    As Single x,y,z
    #define Tf Type<_float>
End Type

Type sphere
    as single x,y,z
    As Long r
    #define Ts Type<sphere>
End Type


Type MySortType     as V3
#Define srt_member  .z

#define _sort_switch
#ifdef _sort_switch
    #Define _greaterthan <
    #Define _lessthan >
#else
    #Define _greaterthan >
    #Define _lessthan <
#endif

dim Shared as MySortType                SwapV
dim Shared as TypeOf((SwapV)srt_member) SwapVcomp
type SortIndex As Integer

dim shared as integer                   sort_thresh_ins = 43

#Macro QS_NumCommon(QS_NAME)
    Dim As SortIndex I=(LB+UB) \ 2, J = UB
    If A(LB)srt_member _greaterthan A(J)srt_member Then Swap A(LB), A(J)
    If A(LB)srt_member _greaterthan A(I)srt_member Then Swap A(LB), A(I)
    If A(I)srt_member _greaterthan A(J)srt_member Then Swap A(I), A(J)
    SwapVcomp = A(I)srt_member
    I = LB
    Do
        I += 1
        J -= 1
        While A(I)srt_member _lessthan SwapVcomp
            I = I + 1
        Wend
        While SwapVcomp _lessthan A(J)srt_member
            J = J - 1
        Wend
        if J <= I then exit Do
        Swap A(I), A(J)
    Loop
    ' sublist can include pivot
    if a(j)srt_member = SwapVcomp Then
        i=j+1: j-=1
    elseif a(i)srt_member = SwapVcomp then
        j=i-1: i+=1
    end if
    if LB < J Then QS_NAME A(), LB, J
    if I < UB Then QS_NAME A(), I, UB  
#EndMacro

sub zInsertionSort(A() As MySortType,Byref LB As SortIndex,Byref UB As SortIndex)
    Dim As SortIndex I=LB,J
    for J = LB+1 to UB
        if A(J)srt_member _lessthan A(LB)srt_member then LB = j
    next
    Swap A(i), A(LB)
    For J = I + 1 To UB
        If A(I)srt_member _greaterthan A(J)srt_member Then
            SwapV = A(J)
            While A(I)srt_member _greaterthan (SwapV)srt_member
                A(I+1) = A(I): I -= 1
            Wend
            A(I+1) = SwapV
        End If
        I = J
    Next
End Sub

Sub QSort_Num(A() As MySortType, Byref LB As SortIndex, Byref UB As SortIndex)
    if UB - LB < sort_thresh_ins then
        zInsertionSort A(), LB, UB
    Else
        QS_NumCommon(QSort_Num)
    End If
End Sub

sub _sort(a() as MySortType, Byref LB As SortIndex=0, Byref UB As SortIndex=-1)
    '' shuffle
    if LB > UB then LB = lbound(a): UB = ubound(a)
    dim as single s = lb, delt = ub-lb
    while s < ub
        swap a(s), a(lb+rnd*delt)
        s+=6.5+rnd*54
    wend
    QSort_Num a(), lb, ub
end sub     

Type vector3d
    As double           x,y,z
End Type

Type Axis3D
    As vector3d         AxisX=(1,0,0), AxisY=(0,-1,0), AxisZ=(0,0,1)
    As double           x,y,z
    declare sub         scale(Byval sc as single=1, Byval FlipY as integer=-1)
End Type

sub Axis3D.scale(Byval sc as single, Byval FlipY as integer)
    AxisX=type<vector3d>(sc,0,0)
    AxisZ=type<vector3d>(0,0,sc): if FlipY then sc=-sc
    AxisY=type<vector3d>(0,sc,0)
end sub

dim shared as Axis3D  gAxis, gAxis2

dim as integer FlipY '= 1
gaxis.scale 1, FlipY

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16

Redim Shared As V3 a(0)
Dim Shared As v3 eyepoint=Tv(150,150,800)

function onsphere(Byref S as sphere,Byref P as V3) as long
    return (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.R*S.R Andalso _
            (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.R-1)*(S.R-1)
end function

Sub RotateArray(wa() As V3,result() As V3,Byref angle As _float,Byref centre As V3,Byval flag As Long=0)
    Dim As Single dx,dy,dz,w
    Dim As Single SinAX=Sin(angle.x)
    Dim As Single SinAY=Sin(angle.y)
    Dim As Single SinAZ=Sin(angle.z)
    Dim As Single CosAX=Cos(angle.x)
    Dim As Single CosAY=Cos(angle.y)
    Dim As Single CosAZ=Cos(angle.z)
    Redim result(Lbound(wa) To Ubound(wa))
    if 1 then
        for p as vector3d ptr = @gaxis.axisx to @gaxis.axisz ' rotate the axis
            dim as vector3d ptr pp = @gaxis2.axisx:  pp += p - @gaxis.axisx
            dx=p->x: dy=p->y: dz=p->z
            pp->x=Cosay*Cosaz*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz
            pp->y=Cosay*Sinaz*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz
            pp->z=-Sinay*dx+Sinax*Cosay*dy+Cosax*Cosay*dz
        next
        For z As Long=Lbound(wa) To Ubound(wa)
            with result(z)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                .x = dx*gaxis2.axisx.x + dy*gaxis2.axisy.x + dz*gaxis2.axisz.x + centre.x
                .y = dx*gaxis2.axisx.y + dy*gaxis2.axisy.y + dz*gaxis2.axisz.y + centre.y
                .z = dx*gaxis2.axisx.z + dy*gaxis2.axisy.z + dz*gaxis2.axisz.z + centre.z
                .col=wa(z).col
                if flag then
                    w = 1 + (.z/eyepoint.z)
                    .x = (.x-eyepoint.x)/w+eyepoint.x
                    .y = (.y-eyepoint.y)/w+eyepoint.y
                    .z = (.z-eyepoint.z)/w+eyepoint.z
                end if
            end with
        next
    else
        For z As Long=Lbound(wa) To Ubound(wa)
            dx=wa(z).x-centre.x
            dy=wa(z).y-centre.y
            dz=wa(z).z-centre.z
            Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
            result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
            result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
            #macro perspective()
            w = 1 + (result(z).z/eyepoint.z)
            result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x
            result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y
            result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
            #endmacro
            If flag Then: perspective():End If
            result(z).col=wa(z).col
        Next z
    end if
End Sub

Function DrawLine(Byref P As V3,Byval angle As Double,Byval length As Double) As V3
    angle=angle*.0174532925199433  'deg to rads
    Return Tv(p.x+length*Cos(angle),p.y-length*Sin(angle))
End Function
       
Sub DrawTriangle(Byref p As V3,Byval r As Single,Byval c As ulong,Byval i As Any Ptr=0)
    var L=2*r*Sin(60*.0174532925199433)
    var v1=DrawLine(p,90,r):var st=v1
    var v2=DrawLine(v1,240,L)
    Line i,(v1.x,v1.y)-(v2.x,v2.y),c
    v1=DrawLine(v2,0,L)
    Line i,(v1.x,v1.y)-(v2.x,v2.y),c
    Line i,(v1.x,v1.y)-(st.x,st.y),c
End Sub
       
Sub load(Byval im As Any Ptr,a() As V3)
    Dim As Ulong c=Rgb(255,0,255),tmp
    Dim As integer ddx,ddy,count
    Imageinfo im,ddx,ddy
    For x As Long=0 To ddy-1
        For y As Long=0 To ddx-1
            tmp=Point(x,y,im)
            If tmp<>c Then
                count+=1
                Redim Preserve a(1 To count)
                a(count)=Tv(x,y,0,Point(x,y,im))
            End If
        Next y
    Next x
End Sub
       
Sub setfaces(b1() As V3,Byref f1 As _float,Byref f2 As _float,Byref v1 As V3,Byref v2 As V3,Byval c As ulong)
    var pp=Cptr(Ubyte Ptr,@c)
    Redim As V3 temp(),temp2()
    Dim As Any Ptr im=imagecreate(300,300)
    For n As Single=170 To 150 Step -1
        pp[0]=.95*pp[0]:pp[1]=.95*pp[1]:pp[2]=.95*pp[2]
        DrawTriangle(Tv(150,170+45),n,c,im)
    Next n
    load(im,b1())
    Redim temp(Lbound(b1) To Ubound(b1))
    Redim temp2(Lbound(b1) To Ubound(b1))
    RotateArray(b1(),temp(),f1,v1)
    RotateArray(temp(),temp2(),f2,v2)
    var u=Ubound(a)
    Redim Preserve a(1 To u+Ubound(b1))
    For n As Long=Lbound(b1) To Ubound(b1)
        a(u+n)=temp2(n)
    Next n
    imagedestroy im
End sub

Dim As Single drop=90-54.7356 'pyramid drop angle
Redim As V3 a1(),a2(),a3(),a4()
#define dtr .0174532925199433

setfaces(a1(),Tf(0,0,0),Tf(drop*dtr,0,0),Tv(0,0,0),Tv(0,300,0),Rgb(255,0,0))
setfaces(a2(),Tf(0,90*dtr,0),Tf(0,0,drop*dtr),Tv(0,300,0),Tv(0,300,0),Rgb(0,255,0))
setfaces(a3(),Tf(0,270*dtr,0),Tf(0,0,-drop*dtr),Tv(300,300,0),Tv(300,300,0),Rgb(0,0,255))
setfaces(a4(),Tf(0,180*dtr,0),Tf(-drop*dtr,0,0),Tv(150,150,-150),Tv(00,300,-300),Rgb(255,255,255))

'add a sphere
Dim As Long xx=150,yy=250,zz=-150,r=50,counter=Ubound(a)
Dim As sphere sp=Ts(xx,yy,zz,r)
For x As Long= xx-r To xx+r Step 2
    For y As Long=yy-r To yy+r Step 2
        For z As Long=zz-r To zz+r Step 2
            If onsphere(sp,Tv(x,y,z)) Then
                counter+=1
                Redim Preserve a(Lbound(a) To counter)
                a(counter)=Tv(x,y,z,Rgb(Rnd*255,Rnd*255,Rnd*255))
            End If
        Next z
    Next y
Next x

Redim As v3 b(Lbound(a) To Ubound(a))
Dim As Single s
Dim As Long fps=100,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N
Color ,Rgb(0,150,255)
Do
    s-=.025
    RotateArray(a(),b(),Tf(0,s,0),Tv(150,200,-150),1)
    If (remove = False) Or (skipped = False) Then
        Screenlock
        Cls
        _sort b()
        For n As Long=Lbound(a) To Ubound(a)
            Circle((b(n).x-150)+400,(b(n).y-150)+200),2,b(n).col,,,,f
        Next n
        Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
        Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (552,608),"Graphic animation from dafhi"
        Screenunlock
    End If
    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 300 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
Loop

By comparing the results obtained for the third configuration, we can deduce that 'gas' is more efficient than 'gcc' for the graphic drawing part of this animation.

[fxm]

An eighth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation comes from dodicat : Icosahedron.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 450 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 60, CPU load = 0.04 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 290, CPU load = 7.8 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 450, CPU load = 0.1 %
(maximum accessible applied FPS in this third configuration: about 550 but image too jerky, at limit of N=20)

From requested FPS = 450 (by default), I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 60, CPU load = 0.03 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 350, CPU load = 7.6 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 450, CPU load = 0.1 %
(maximum accessible applied FPS in this third configuration: about 550 but image too jerky, at limit of N=20)

Code

Test12:

Code: Select all

'' Graphic animation from dodicat (https://freebasic.net/forum/viewtopic.php?p=286977#p286977)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type pt
    As Double x,y,z
End Type

Type triangle
    As pt p(0 To 2)
    As pt ctr
    As Ulong col
    As pt norm
End Type

Type angle3D             'FLOATS for angles
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(Byval As Single,Byval As Single,Byval As Single) As Angle3D
End Type

Function Angle3D.construct(Byval x As Single,Byval y As Single,Byval z As Single) As Angle3D
    Return   Type (Sin(x),Sin(y),Sin(z), _
    Cos(x),Cos(y),Cos(z))
End Function

Function Rotate(Byref c As pt,Byref p As pt,Byref a As Angle3D,Byref scale As pt=Type(1,1,1)) As pt
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<pt>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)
End Function

Function perspective(Byref p As pt,Byref eyepoint As pt) As pt
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<pt>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z)
End Function

Function dot(Byref p As pt,Byref v2 As Pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    Dim As Single d1=Sqr(p.x*p.x + p.y*p.y+ p.z*p.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)
    Dim As Single v1x=p.x/d1,v1y=p.y/d1,v1z=p.z/d1 'normalize
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
    Return (v1x*v2x+v1y*v2y+v1z*v2z)
End Function

Sub fill(p() As Pt,Byval c As Ulong,Byval im As Any Ptr=0)
    #define ub Ubound
    Dim As Long Sy=1e6,By=-1e6,i,j,y,k
    Dim As Single a(Ub(p)+1,1),dx,dy
    For i =0 To Ub(p)
        a(i,0)=p(i).x
        a(i,1)=p(i).y
        If Sy>p(i).y Then Sy=p(i).y
        If By<p(i).y Then By=p(i).y
    Next i
    Dim As Single xi(Ub(a,1)),S(Ub(a,1))
    a(Ub(a,1),0) = a(0,0)
    a(Ub(a,1),1) = a(0,1)
    For i=0 To Ub(a,1)-1
        dy=a(i+1,1)-a(i,1)
        dx=a(i+1,0)-a(i,0)
        If dy=0 Then S(i)=1
        If dx=0 Then S(i)=0
        If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
    Next i
    For y=Sy-1 To By+1
        k=0
        For i=0 To Ub(a,1)-1
            If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
            (a(i,1)>y Andalso a(i+1,1)<=y) Then
            xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
            k+=1
        End If
    Next i
    For j=0 To k-2
        For i=0 To k-2
            If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
        Next i
    Next j
    For i = 0 To k - 2 Step 2
        Line im,(xi(i)+1,y)-(xi(i+1)+1-1,y),c
    Next i
Next y
End Sub

Sub blow(d() As pt,Byref t As pt,Byval m As Double)
    For n As Long=1 To 12
        d(n).x=(d(n).x)*m+t.x
        d(n).y=(d(n).y)*m+t.y
        d(n).z=(d(n).z)*m+t.z
    Next
End Sub

Sub setup(p() As triangle,d() As pt,colours() As Ulong)
    Dim As Long i
    Dim As Double cx,cy,cz
    Dim As pt centre=Type(1024\2,768\2,0)
    For n As Long=1 To 20
        cx=0:cy=0:cz=0
        For k As Long=0 To 2
            Read i
            p(n).p(k)=d(i)
            cx+=d(i).x
            cy+=d(i).y
            cz+=d(i).z
        Next k
        p(n).ctr=Type(cx/3,cy/3,cz/3)
        p(n).norm=Type(p(n).ctr.x-centre.x,p(n).ctr.y-centre.y,p(n).ctr.z-centre.z)
        p(n).col=colours(n)
    Next n
    
End Sub

Sub shadow(p() As triangle)
    Dim As triangle tmp
    For n As Long=Lbound(p) To Ubound(p)
        tmp=p(n)
        tmp.p(0).x=p(n).p(0).x+200
        tmp.p(1).x=p(n).p(1).x+200
        tmp.p(2).x=p(n).p(2).x+200
        fill(tmp.p(),Rgba(0,0,0,100))
    Next n
End Sub

Sub show(p() As triangle)
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    Dim As pt lightsource
    lightsource=Type(.5,0,.5)
    For n As Long=Lbound(p)+9 To Ubound(p)
        
        Var col=Cptr(Ubyte Ptr,@p(n).col)
        Dim As Single dt=dot(p(n).norm,lightsource)
        Var dtt=map(1,-1,dt,.1,1)
        Dim As Ulong clr=Rgb(dtt*col[2],dtt*col[1],dtt*col[0])
        fill(p(n).p(),clr)
    Next n
End Sub

Sub sort(p() As triangle)
    For n1 As Long =Lbound(p) To Ubound(p)-1
        For n2 As Long=n1+1 To Ubound(p)
            If p(n1).ctr.z<p(n2).ctr.z Then Swap p(n1),p(n2)
        Next n2
    Next n1
End Sub

Sub setcolours(colours() As Ulong,Byval colour As Ulong=Rgb(100,255,0))
    For n As Long=1 To 20
        colours(n)=Rgb(0,255,0)
    Next n
End Sub

Function rainbow(Byval x As Single) As Ulong 'idea from bluatigro
    Static As Double pi=4*Atn(1)
    #define rad(n) (pi/180)*(n)
    Dim As Ulong r , g , b
    r = Sin( rad( x ) ) * 127 + 128
    g = Sin( rad( x - 120 ) ) * 127 + 128
    b = Sin( rad( x + 120 ) ) * 127 + 128
    Return Rgb( r And 255 , g And 255 , b And 255 )
End Function

'===============================================================================
Dim As pt d(1 To 12)={ _
(0.000000,-0.525731,0.850651), _
(0.850651,0.000000,0.525731), _
(0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,0.525731), _
(-0.525731,0.850651,0.000000), _
(0.525731,0.850651,0.000000), _
(0.525731,-0.850651,0.000000), _
(-0.525731,-0.850651,0.000000), _
(0.000000,-0.525731,-0.850651), _
(0.000000,0.525731,-0.850651), _
(0.000000,0.525731,0.850651)}


Dim As Ulong colours(1 To 20)
Dim As triangle p(1 To 20),rot(1 To 20),shade(1 To 20)
blow(d(),Type(1024\2,768\2,0),200)
setcolours(colours())
setup(p(),d(),colours())

Dim  As Angle3D A3d
Dim As pt ang
Dim As pt c=Type(1024\2,768\2,0)
Dim As Long flag,mx,my,btn
Dim As Long fps=450,rfps
Dim As Boolean skipping=False,remove=False,skipped
Dim As Long ist,mist
Dim As Ulong averageFps
Dim As Double sumFps
Dim As Long N
Screenres 800, 640, 32, , 64
Width 800 \ 8, 640 \ 16
Dim As Any Ptr i=Imagecreate(1024,768)
For x As Long=0 To 1023
    For y As Long=0 To 767
        Pset i,(x,y),rainbow(Sqr((x+50)^2+(y+50)^2))
    Next
Next
Do
    ang.x+=.03/2  'the orbiting speed
    ang.y+=.02/2
    ang.z+=.01/2
    
    A3D=Angle3D.construct(ang.x,ang.y,ang.z)
    For n As Long=1 To 20
        For m As Long=0 To 2
            shade(n).p(m)=Rotate(c,p(n).p(m),A3D,Type(.8,.8,.8))
            rot(n).p(m)=Rotate(c,p(n).p(m),A3D)
            shade(n).p(m)=perspective(shade(n).p(m),Type(1024\2,768\2,2000))
            rot(n).p(m)=perspective(rot(n).p(m),Type(1024\2,768\2,2000))
        Next m
        shade(n).ctr=Rotate(c,p(n).ctr,A3D,Type(.8,.8,.8))
        rot(n).ctr=Rotate(c,p(n).ctr,A3D)
        rot(n).norm=Type(rot(n).ctr.x-c.x,rot(n).ctr.y-c.y,rot(n).ctr.z)
        rot(n).col=p(n).col
    Next n
    
    sort(rot())
    
    If (remove = False) Or (skipped = False) Then
        Screenlock
        Cls
        Circle(200,100),20,Rgb(100,255,0),,,,f
        Circle(500,100),20,Rgb(255,100,0),,,,f
        Circle(800,100),20,Rgb(0,100,255),,,,f
        Put(0,0),i,Pset
        shadow(shade())
        show(rot())
        Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
        Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
        Draw String (16,48),"Status : " & _
            iif(skipping = True, "Image skipping activation = true, with " & _
            iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
            "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
            "Image skipping activation = false")
        Draw String (16,80),"<+> : Increase FPS"
        Draw String (16,96),"<-> : Decrease FPS"
        Draw String (16,128),"<t> or <T> : True for image skipping activation"
        If Skipping = True Then
            Draw String (16,144),"   <s> or <S> : Scroll image skipped"
            Draw String (16,160),"   <r> or <R> : Remove image skipped"
            Draw String (16,176),"<f> or <F> : False for image skipping activation"
            Draw String (16,208),"<escape> : Quit"
        Else
            Draw String (16,144),"<f> or <F> : False for image skipping activation"
            Draw String (16,176),"<escape> : Quit"
        End If
        Draw String (16, 608),"Click for colour"
        Draw String (544,608),"Graphic animation from dodicat"
        Getmouse(mx,my,,btn)
        If btn And flag=0 And Point(mx,my)<>rgb(255,255,255)  Then
            flag=1
            setcolours(colours(),Point(mx,my))
            For n As Long=1 To 20
                p(n).col=Point(mx,my)
            Next n
        End If
        Screenunlock
    End If
    rfps = regulateLite(fps,skipping, ,skipped)
    If skipped = True Then
        ist += 1
    Else
        mist = ist
        ist = 0
    End If
    sumFps += rfps
    N += 1
    If N >= rfps / 2 Then
        averageFps = sumFps / N
        N = 0
        sumFps = 0
    End If
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If fps < 600 Then fps += 1
    Case "-"
        If fps > 10 Then fps -= 1
    Case "T"
        skipping = True
    Case "F"
        skipping = False
    Case "S"
        If skipping = True Then remove = False
    Case "R"
        If skipping = True Then remove = True
    Case Chr(27)
        Exit do
    End Select
    flag=btn
Loop

imagedestroy(i)

triangles:
Data _
2,3, 7, _
2, 8, 3, _
4, 5, 6, _
5, 4, 9, _
7, 6, 12, _
6, 7, 11, _
10, 11, 3, _
11, 10, 4, _
8, 9, 10, _
9, 8, 1, _
12, 1, 2, _
1, 12, 5, _
7, 3, 11, _
2, 7, 12, _
4, 6, 11, _
6, 5, 12, _
3, 8, 10, _
8, 2, 1, _
4, 10, 9, _
5, 9, 1

[fxm]

A ninth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Quick freebasic sphere.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 35 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 12, CPU load = 8.7 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 15, CPU load = 10.3 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 35, CPU load = 8.5 %
(maximum accessible applied FPS in this third configuration: about 50)

From requested FPS = 35 (by default), I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 15, CPU load = 7.7 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 20, CPU load = 9.9 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 35, CPU load = 6.5 %
(maximum accessible applied FPS in this third configuration: about 90)

Code

Test13:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=237405#p237405)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Screenres 800, 640, 32
Width 800 \ 8, 640 \ 16
Color ,Rgb(0,0,25)
Dim Shared As Integer xres,yres
Screeninfo xres,yres
#define shade(c,n)  rgb(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,byval begin As Long,Byval Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro      
        '<><><>
        Function Blur(Byval tim As Uinteger Pointer,Byval rad As Integer=2) As Uinteger Pointer
            Type p2
                As Integer x,y
                As Uinteger col
            End Type
            #macro ppoint(_x,_y,colour)
            pixel=row+pitch*(_y)+4*(_x)
            (colour)=*pixel
            #endmacro
            #macro ppset(_x,_y,colour)
            pixel2=row2+pitch2*(_y)+4*(_x)
            *pixel2=(colour)
            #endmacro
            #macro average()
            ar=0:ag=0:ab=0:inc=0
            xmin=x:If xmin>rad Then xmin=rad
            xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
            ymin=y:If ymin>rad Then ymin=rad
            ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
            For y1 As Integer=-ymin To 0
                For x1 As Integer=-xmin To 0
                    inc=inc+1 
                    ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
                    ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
                    ab=ab+(NewPoints(x+x1,y+y1).col And 255)
                Next x1
            Next y1
            #endmacro
            Dim As Integer _x,_y
            Imageinfo tim,_x,_y
            Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
            Dim As Long pitch,pitch2
            Dim  As Any Pointer row,row2
            Dim As Uinteger Pointer pixel,pixel2
            Dim As Uinteger col
            Imageinfo tim,,,,pitch,row
            Dim As p2 NewPoints(_x,_y)
            
            Dim As Uinteger averagecolour
            Dim As Integer ar,ag,ab
            Dim As Integer xmin,xmax,ymin,ymax,inc
            Imageinfo im,,,,pitch2,row2
            For y As Integer=0 To _y-1
                For x As Integer=0 To _x-1
                    ppoint((x),(y),col)
                    NewPoints(x,y)=Type<p2>(x,y,col)
                    average()
                    NewPoints(x,y).col=Rgb(ar/(inc),ag/(inc),ab/(inc))
                    ppset((NewPoints(x,y).x),(NewPoints(x,y).y),NewPoints(x,y).col)
                Next x
            Next y
            Function= im
        End Function
        
        Type V3
            As Single x,y,z
            As Ulong col
        End Type
        
        Type _float 
            As Single x,y,Z
        End Type
        
        Type sphere As V3
      ' =========  set up image ======== 
        Dim Shared As v3 eyepoint
        eyepoint=Type(xres/2,yres/2,800)
        Dim Shared As Any Ptr im
        im=Imagecreate (xres,yres,Rgb(100,50,0))
        Redim  As V3 a(0)
        Dim As Ulong Clr
        Randomize 2
        For n As Long=1 To 5000
            If Rnd>.7 Then clr=Rgb(Rnd*200,200-Rnd*100,0) Else clr=Rgb(0,100,255)
            Var xp=Rnd*xres,yp=Rnd*yres
            If yp<100 Or yp>yres-50 Then clr=Rgb(255,255,255)
            Circle im,(Rnd*xres,Rnd*yres),5+Rnd*50,clr,,,,f
        Next n
        im=Blur(im,3)
       '========== done =========== 
        Operator -(Byref v1 As v3,Byref v2 As v3) As v3
        Return Type(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
        End Operator
        
        Function dot(Byref v1 As v3,Byref v2 As v3) Byref As Single 
            Static As Single res
            Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y+  v1.z*v1.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y + v2.z*v2.x)
            Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize
            Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
            Res= (v1x*v2x+v1y*v2y+v1z*v2z) 
            Return res
        End Function
        
        Sub RotateArray(wa() As V3,result() As V3,Byref angle As _float,Byref centre As V3,Byval flag As Long=0,Byval s As Single=1)
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=(((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz))+centre.x
                result(z).y=(((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz))+centre.y
                result(z).z=(((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz))+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = s*(result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = s*(result(z).y-eyepoint.y)/w+eyepoint.y 
                result(z).z = s*(result(z).z-eyepoint.z)/w+eyepoint.z
                #EndMacro
                ' perspective()
                If flag Then: perspective():End If
                result(z).col=wa(z).col
            Next z
        End Sub
        
        'if a point lies on a sphere
        Function onsphere(Byref S As sphere,Byref P As V3,Byval x As Single,Byval y As Single) As Long
            Return Sqr(x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z)) <= S.col Andalso _
            Sqr(x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z)) > (S.col)-2.5
        End Function
        
        Sub addasphere(a() As V3,Byref pt As V3,Byval rad As Long,Byval col As Ulong=0,Byval x1 As Single,Byval y1 As Single,Byval flag As Integer=0)
            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter=Ubound(a)-1
            Dim As Long minx= xx-r-1,maxx=xx+r+1
            Dim As Long miny= yy-r-1,maxy=yy+r+1
            Dim As Single ddx,ddy,ddz
            Dim As sphere sp=Type<sphere>(xx,yy,zz,r)
            For x As Long= xx-r-1 To xx+r+1 Step 2
                For y As Long=yy-r-1 To yy+r+1 Step 2
                    For z As Long=zz-r-1 To zz+r+1 Step 2
                        If onsphere(sp,Type<V3>(x,y,z),x1,y1) Then
                            counter+=1
                            Redim Preserve a(Lbound(a) To counter)
                            If flag Then
                                Var xpos=map((minx),(maxx),x,0,xres)
                                Var ypos=map((miny),(maxy),y,0,yres)
                                col=Point(xpos,ypos,im)
                            End If
                            a(counter)=Type<V3>(x+ddx,y+ddy,z+ddz,col)
                        End If
                    Next z
                Next y
            Next x
        End Sub
        
        AddAsphere(a(),Type<V3>(xres/2,yres/2,0),150,Rgb(255,255,0),1,1,1)
        
        SetQsort(V3,QsortZ,down,.z) 'Set Up the quicksort for UDT V3, on z
        
        Redim As V3 b(Lbound(a) To Ubound(a)) 'feeder array
        
        
        Dim As Single pi=4*Atn(1)
        RotateArray(a(),b(),Type<_float>(0,0,-pi/3.5),Type(xres/2,yres/2,0))
        For n As Long=Lbound(a) To Ubound(a)
          	a(n)=b(n)
        Next
        Dim As Long fps=35,rfps
        Dim As Boolean skipping=False,remove=False,skipped
        Dim As Long ist,mist
        Dim As Ulong averageFps
        Dim As Double sumFps
        Dim As Long N
        Dim As v3 Axis=Type(-.2,.2,-.05)
        Dim As Ulong colour
        Dim As Ubyte rd,gr,bl
        Dim As Ubyte Ptr cc
        Dim As v3 Ectr=Type(xres/2,yres/2,0)
        Dim As Single min=3,max=-3,dt,ang,rad
        Do
            ang+=.025
            RotateArray(a(),b(),Type<_float>(0,ang,0),Type(xres/2,yres/2,0),1,1)
            If (remove = False) Or (skipped = False) Then
                Screenlock
                Cls
                QsortZ(b(),Lbound(b),Ubound(b))
                For n As Long=Lbound(b) To Ubound(b)
                    If b(n).z<0  Then
                        rad=map(-400,400,b(n).z,2.5,1)
                        dt= dot(Ectr-b(n),Axis)
                        If dt >.1 Then
                            colour=shade(b(n).col,.2)
                        Else
                            If min>dt Then min=dt
                            If max<dt Then max=dt
                            cc=Cptr(Ubyte Ptr,@b(n).col)
                            rd=map(min,max,dt,255,cc[2])
                            gr=map(min,max,dt,255,cc[1])
                            bl=map(min,max,dt,255,cc[0])
                            colour=Rgb(rd,gr,bl)
                        End If
                        Circle(b(n).x,b(n).y),rad,colour,,,,f
                    End If
                Next n
                Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
                Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
                Draw String (16,48),"Status : " & _
                    iif(skipping = True, "Image skipping activation = true, with " & _
                    iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
                    "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
                    "Image skipping activation = false")
                Draw String (16,80),"<+> : Increase FPS"
                Draw String (16,96),"<-> : Decrease FPS"
                Draw String (16,128),"<t> or <T> : True for image skipping activation"
                If Skipping = True Then
                    Draw String (16,144),"   <s> or <S> : Scroll image skipped"
                    Draw String (16,160),"   <r> or <R> : Remove image skipped"
                    Draw String (16,176),"<f> or <F> : False for image skipping activation"
                    Draw String (16,208),"<escape> : Quit"
                Else
                    Draw String (16,144),"<f> or <F> : False for image skipping activation"
                    Draw String (16,176),"<escape> : Quit"
                End If
                Draw String (544,608),"Graphic animation from dodicat"
                Screenunlock
            End If
            rfps = regulateLite(fps,skipping, ,skipped)
            If skipped = True Then
                ist += 1
            Else
                mist = ist
                ist = 0
            End If
            sumFps += rfps
            N += 1
            If N >= rfps / 2 Then
                averageFps = sumFps / N
                N = 0
                sumFps = 0
            End If
            Dim As String s = Ucase(Inkey)
            Select Case s
            Case "+"
                If fps < 200 Then fps += 1
            Case "-"
                If fps > 10 Then fps -= 1
            Case "T"
                skipping = True
            Case "F"
                skipping = False
            Case "S"
                If skipping = True Then remove = False
            Case "R"
                If skipping = True Then remove = True
            Case Chr(27)
                Exit do
            End Select
        Loop
    
        imagedestroy (im)

[fxm]

A tenth graphic animation highlighting the interest of the image skipping feature of 'regulateLite()',
with scrolling and above all removing of skipped images

The graphic animation (heavy CPU load) comes from dodicat : Here.
Some initializations and code lines may have been modified from the author's original in order to better highlight the regulation with 'regulateLite()' and its different configurations of use.

This test code allows to modify:
- the value of the requested FPS (and it visualizes the applied FPS),
- the image skipping activation (false or true),
- and in case of image skipping activated, the mode for skipping images (scrolling or removing).
(the removing skipped images adds only three lines to the user code)
The full status of the image skipping feature is also visualized.

Results

From the requested FPS = 150 (by default), I get on my PC (fbc 32-bit/gas):
- for image skipping activation = false, applied FPS = about 30, CPU load = 2.7 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 90, CPU load = 10.0 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 150, CPU load = 3.1 %
(maximum accessible applied FPS in this third configuration: about 600 but too jerky, at limit of N=20)

From requested FPS = 150 (by default), I get on my PC (fbc 64-bit/gcc):
- for image skipping activation = false, applied FPS = about 25, CPU load = 6.0 %
- for image skipping activation = true and with scrolling skipped images, applied FPS = about 40, CPU load = 9.7 %
- for image skipping activation = true and with removing skipped images, applied FPS = about 150, CPU load = 4.3 %
(maximum accessible applied FPS in this third configuration: about 500 but too jerky, at limit of N=20)

Code

Test14:

Code: Select all

'' Graphic animation from dodicat (https://www.freebasic.net/forum/viewtopic.php?p=184009#p184009)

#include "regulateLite.bi"  '' defined in https://www.freebasic.net/forum/viewtopic.php?p=299929#p299929

Type vector3d
    As Single x,y,z
End Type
'assignment macro
#define vct Type<vector3d>
 
 'macros
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    #macro combsort(array,begin,finish,dot)
    Scope
        Var size=(finish),switch=0,j=0
        Dim As Single void=size
        Do
            void=void/1.3: If void<1 Then void=1
            switch=0
            For i As Integer =(begin) To size-void
                j=i+void
                If array(i)dot<array(j)dot Then 
                    Swap array(i),array(j): switch=1
                End If
            Next
        Loop Until  switch =0 And void=1
    End Scope
    #endmacro
    
    Operator -(Byref v1 As vector3d,Byref v2 As vector3d) As vector3d
        Return Type<vector3d>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
    End Operator
    
    Operator + (Byref v1 As vector3d,Byref v2 As vector3d) As vector3d
    Return Type<vector3d>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
    End Operator
    
    Function length(Byref v1 As vector3d) As Single
        Return Sqr(v1.x*v1.x+v1.y*v1.y+v1.z*v1.z)
    End Function 
    
    Function rotate3d(Byval pivot As vector3d,Byval pt As vector3d,Byval Angle As vector3d, Byval scale As vector3d=Type<vector3d>(1,1,1)) As vector3d
        #define cr 0.0174532925199433
        Angle=Type<vector3d>(Angle.x*cr,Angle.y*cr,Angle.z*cr)
        #macro Rotate(a1,a2,b1,b2,d)
        temp=Type<vector3d>((a1)*Cos(Angle.d)+(a2)*Sin(Angle.d),(b1)*Cos(Angle.d)+(b2)*Sin(Angle.d))
        #endmacro
        Dim As vector3d p=Type<vector3d>(pt.x-pivot.x,pt.y-pivot.y,pt.z-pivot.z)
        Dim As vector3d rot,temp
        Rotate(p.y,-p.z,p.z,p.y,x)'X
        rot.y=temp.x:rot.z=temp.y 
        p.y = rot.y:p.z = rot.z 
        Rotate(p.z,-p.x,p.x,p.z,y)'Y
        rot.z=temp.x:rot.x=temp.y
        p.x=rot.x
        Rotate(p.x,-p.y,p.y,p.x,z)'Z
        rot.x=temp.x:rot.y=temp.y
        Return Type<vector3d>((scale.x*rot.x+pivot.x),(scale.y*rot.y+pivot.y),(scale.z*rot.z+pivot.z))
    End Function
    
    Function apply_perspective(Byref p As vector3d,Byref eyepoint As vector3d) As vector3d
        Dim As Single   w=1+(p.z/eyepoint.z)
        If w=0 Then w=1e-20
        Return Type<vector3d>((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z)
    End Function
    '====================== End of rotator and perspective getter ======================================
    Dim Shared As Integer xres,yres
    Screenres 800, 640, 8
    Width 800 \ 8, 640 \ 16
    Screeninfo xres,yres

    'two main arrays
    Dim Shared As vector3d rotated()
    Redim Shared As vector3d array()
    'extra subs to regulate speed
    'four shapes
    Function create1(Byval number As Integer) As Integer
        Redim array(0)
        Dim As Integer count,stepper=10
        For x As Integer=xres/2-number To xres/2+number Step stepper
            For y As Integer=yres/2-number To yres/2+number Step stepper
                For z As Integer=-number To number Step stepper
                    count=count+1
                    Redim Preserve array(1 To count)
                    array(Ubound(array))=vct(x,y,z)
                Next z
            Next y
        Next x
        Redim rotated(Lbound(array) To Ubound(array))
        Return 0
    End Function
    
    'variables
    Dim As vector3d centre=vct(xres/2,yres/2,0)
    Dim As vector3d eyepoint=vct(xres/2,yres/2,600)
    Dim As vector3d angle
    Dim As Long fps=150,rfps
    Dim As Boolean skipping=False,remove=False,skipped
    Dim As Long ist,mist
    Dim As Ulong averageFps
    Dim As Double sumFps
    Dim As Long N
    Dim As vector3d disp=vct(xres/2,yres/2,0)
    Dim As Integer k,flag=1,border=.2*xres
    Dim As Single sx=1,kx=2,ky=1.9,kz=1.5
    create1(90)
    Do
        angle=angle+vct(.2,2,.1)
        With angle
            If .x>=360 Then .x-=360
            If .y>=360 Then .y-=360
            If .x>=360 Then .z-=360
        End With
        disp=disp+vct(kx,ky,0)
        If disp.x<border Then kx=-kx
        If disp.x>xres-border Then kx=-kx
        If disp.y<border Then ky=-ky
        If disp.y>yres-border Then ky=-ky
        If (remove = False) Or (skipped = False) Then
            Screenlock
            Cls
            
            For n As Integer=1 To Ubound(rotated)
                rotated(n)=rotate3d(centre,(array(n)),angle,vct(sx,sx,sx))
            Next n
            
            combsort(rotated,1,Ubound(rotated),.z)
            
            For n As Integer=1 To Ubound(rotated)
                Var dist=length(rotated(n)-centre)
                rotated(n)=apply_perspective(rotated(n),eyepoint)
                rotated(n)=rotated(n)+(disp-centre)
                
                Var col=map(0,200,dist,1,15)
                Var radius=map(-400,400,rotated(n).z,10,1)
                Circle (rotated(n).x,rotated(n).y),radius,col,,,,f
            Next n
            
            Draw String (16,16),"Requested FPS = " & Right("  " & fps, 3)
            Draw String (16,32),"Applied FPS   = " & Right("  " & rfps, 3) & "   (average = " & Right("  " & averageFps, 3) & ")"
            Draw String (16,48),"Status : " & _
                iif(skipping = True, "Image skipping activation = true, with " & _
                iif(remove = True, "removing images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0"), _
                "scrolling images skipped = " & Iif(mist > 0, str(mist) & "/" & str(mist + 1), "0")), _
                "Image skipping activation = false")
            Draw String (16,80),"<+> : Increase FPS"
            Draw String (16,96),"<-> : Decrease FPS"
            Draw String (16,128),"<t> or <T> : True for image skipping activation"
            If Skipping = True Then
                Draw String (16,144),"   <s> or <S> : Scroll image skipped"
                Draw String (16,160),"   <r> or <R> : Remove image skipped"
                Draw String (16,176),"<f> or <F> : False for image skipping activation"
                Draw String (16,208),"<escape> : Quit"
            Else
                Draw String (16,144),"<f> or <F> : False for image skipping activation"
                Draw String (16,176),"<escape> : Quit"
            End If
            Draw String (544,608),"Graphic animation from dodicat"
            Screenunlock
        End If
        rfps = regulateLite(fps,skipping, ,skipped)
        If skipped = True Then
            ist += 1
        Else
            mist = ist
            ist = 0
        End If
        sumFps += rfps
        N += 1
        If N >= rfps / 2 Then
            averageFps = sumFps / N
            N = 0
            sumFps = 0
        End If
        Dim As String s = Ucase(Inkey)
        Select Case s
        Case "+"
            If fps < 700 Then fps += 1
        Case "-"
            If fps > 10 Then fps -= 1
        Case "T"
            skipping = True
        Case "F"
            skipping = False
        Case "S"
            If skipping = True Then remove = False
        Case "R"
            If skipping = True Then remove = True
        Case Chr(27)
            Exit do
        End Select
    Loop