1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  10. with Objects;                           use Objects; 
  11. with Processes;                         use Processes; 
  12. with Widgets.Containers.Windows;        use Widgets.Containers.Windows; 
  13.  
  14. private with Ada.Real_Time; 
  15.  
  16. package Renderers is 
  17.  
  18.     -- A Renderer is a member of the Game View system and is responsible for 
  19.     -- drawing a Window widget to the screen. Only one renderer exists per 
  20.     -- application. It implements the Process interface to draw on a tick when 
  21.     -- the specified framerate allows. The renderer uses double-buffering for 
  22.     -- updating frames. 
  23.     type Renderer is new Object and Process with private; 
  24.     type A_Renderer is access all Renderer'Class; 
  25.  
  26.     -- Create a Renderer object that draws 'win' to the screen at a maximum 
  27.     -- frequency of 'fps'. For best performance, do not attach the Renderer to 
  28.     -- a Process_Manager running at a frequency less than 'fps'; it's best if 
  29.     -- the Process is ticked at the same frequency, or a multiple of it. 
  30.     function Create_Renderer( win : not null A_Window; 
  31.                               fps : Positive ) return A_Renderer; 
  32.     pragma Postcondition( Create_Renderer'Result /= null ); 
  33.  
  34.     -- Copies the Renderer. Its window widget is not copied, just re-referenced. 
  35.     function Copy( src : A_Renderer ) return A_Renderer; 
  36.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  37.  
  38.     -- Deletes the Renderer. 
  39.     procedure Delete( this : in out A_Renderer ); 
  40.     pragma Postcondition( this = null ); 
  41.  
  42.     ---------------------------------------------------------------------------- 
  43.  
  44.     -- Instructs renderers to draw a software mouse. This flag is checked when 
  45.     -- a Renderer is constructed, so it will not affect existing Renderer 
  46.     -- instances. 
  47.     procedure Use_Software_Mouse; 
  48.  
  49. private 
  50.  
  51.     use Ada.Real_Time; 
  52.  
  53.     -- an array of video bitmaps for double/triple-buffering 
  54.     type Page_Array is array(Natural range <>) of A_Bitmap; 
  55.     type A_Page_Array is access all Page_Array; 
  56.  
  57.     ---------------------------------------------------------------------------- 
  58.  
  59.     type Renderer is new Object and Process with 
  60.         record 
  61.             win            : A_Window := null; 
  62.             videoPages     : A_Page_Array; 
  63.             drawPage       : Natural := 0; 
  64.             tripleBuffered : Boolean := False; 
  65.             clearedPage    : Integer := -1; 
  66.             frameDelta     : Time_Span := Time_Span_Zero; 
  67.             lastFrame      : Time := Time_First; 
  68.         end record; 
  69.  
  70.     procedure Adjust( this : access Renderer ); 
  71.  
  72.     procedure Construct( this : access Renderer; 
  73.                          win  : not null A_Window; 
  74.                          fps  : Positive ); 
  75.  
  76.     procedure Delete( this : in out Renderer ); 
  77.  
  78.     -- Draws a new frame to 'vpage'. 
  79.     procedure Draw_Frame( this  : not null access Renderer'Class; 
  80.                           vpage : not null A_Bitmap; 
  81.                           dt    : Time_Span ); 
  82.  
  83.     function Get_Process_Name( this : access Renderer ) return String; 
  84.  
  85.     -- Updates the screen. 
  86.     procedure Tick( this : access Renderer; time : Tick_Time ); 
  87.  
  88. end Renderers;