1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, July 2011 
  3. -- 
  4.  
  5. package body Graphics_FrameRates is 
  6.  
  7.    type Ring_Ix is mod Smoothing_Buffer_Size; 
  8.  
  9.    Smoothing_Buffer    : array (Ring_Ix) of Time_Span := (others => Seconds (1)); 
  10.    Smoothing_Buffer_Ix : Ring_Ix := Ring_Ix'First; 
  11.  
  12.    Last_Call_To_Limiter          : Time := Clock; 
  13.    Last_Padding_Delay            : Time_Span := Time_Span_Zero; 
  14.    Last_Call_To_Measure_Interval : Time := Clock; 
  15.  
  16.    -- 
  17.    -- 
  18.    -- 
  19.  
  20.    function Measure_Interval return Time_Span is 
  21.  
  22.       Interval : constant Time_Span := Clock - Last_Call_To_Measure_Interval; 
  23.  
  24.    begin 
  25.       Last_Call_To_Measure_Interval := Clock; 
  26.       return Interval; 
  27.    end Measure_Interval; 
  28.  
  29.    ----------------------- 
  30.    -- Average_Framerate -- 
  31.    ----------------------- 
  32.  
  33.    function Average_Framerate (Interval : Time_Span) return Hz is 
  34.  
  35.       Interval_Sum : Time_Span := Time_Span_Zero; 
  36.  
  37.    begin 
  38.       Smoothing_Buffer (Smoothing_Buffer_Ix) := Interval; 
  39.       Smoothing_Buffer_Ix := Smoothing_Buffer_Ix + 1; 
  40.  
  41.       for i in Ring_Ix'Range loop 
  42.          Interval_Sum := Interval_Sum + Smoothing_Buffer (i); 
  43.       end loop; 
  44.  
  45.       if Interval_Sum = Time_Span_Zero then 
  46.          return 0.0; 
  47.       else 
  48.          return 1.0 / Real (To_Duration (Interval_Sum / Smoothing_Buffer_Size)); 
  49.       end if; 
  50.    end Average_Framerate; 
  51.  
  52.    -- 
  53.    -- 
  54.    -- 
  55.  
  56.    procedure Framerate_Limiter (Max_Framerate : Hz) is 
  57.  
  58.       Intended_Time_Span    : constant Time_Span := To_Time_Span (Duration (1.0 / Max_Framerate)); 
  59.       Actual_Execution_Time : constant Time_Span := (Clock - Last_Call_To_Limiter) - Last_Padding_Delay; 
  60.       Padding_Delay         :          Time_Span := Intended_Time_Span - Actual_Execution_Time; 
  61.  
  62.    begin 
  63.       if Padding_Delay > Intended_Time_Span then 
  64.          Padding_Delay := Intended_Time_Span; 
  65.       elsif Padding_Delay < -Intended_Time_Span then 
  66.          Padding_Delay := -Intended_Time_Span; 
  67.       end if; 
  68.  
  69.       Last_Call_To_Limiter := Clock; 
  70.       Last_Padding_Delay   := Padding_Delay; 
  71.       delay To_Duration (Padding_Delay); 
  72.    end Framerate_Limiter; 
  73.  
  74. end Graphics_FrameRates;