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. private with Ada.Real_Time; 
  10. private with Tiles; 
  11. private with Tiles.Libraries; 
  12.  
  13. package Widgets.Paddle_Wars is 
  14.  
  15.     -- A Paddle War widget implements the pong-like Paddle War game in the Keen 
  16.     -- menu. The player plays against a computer opponent. The game logic is 
  17.     -- implemented as an Animated widget, using the Tick procedure to update the 
  18.     -- game state. There is no maximum score. 
  19.     type Paddle_War is new Widget and Animated with private; 
  20.     type A_Paddle_War is access all Paddle_War'Class; 
  21.  
  22.     -- Creates a new Paddle War widget with a new game ready to play. 
  23.     function Create_Paddle_War( view    : not null access Game_Views.Game_View'Class; 
  24.                                 id      : String; 
  25.                                 libName : String ) return A_Paddle_War; 
  26.     pragma Precondition( id'Length > 0 ); 
  27.     pragma Precondition( libName'Length > 0 ); 
  28.     pragma Postcondition( Create_Paddle_War'Result /= null ); 
  29.  
  30.     -- Manually resets the Paddle War game. This can only be called after the 
  31.     -- widget has been parented. The game will also automatically reset when the 
  32.     -- widget becomes visible. 
  33.     procedure Reset( this : not null access Paddle_War'Class ); 
  34.  
  35. private 
  36.  
  37.     use Ada.Real_Time; 
  38.     use Tiles; 
  39.     use Tiles.Libraries; 
  40.  
  41.     type Entity_Rec is 
  42.         record 
  43.             x, y   : Float := 0.0; 
  44.             xv, yv : Float := 0.0; 
  45.             w, h   : Float := 0.0; 
  46.             w2, h2 : Float := 0.0;    -- half the width and height 
  47.         end record; 
  48.  
  49.     type Paddle_War is new Widget and Animated with 
  50.         record 
  51.             lib          : A_Tile_Library := null;    -- may be null if library cant load 
  52.             backgroundId : Natural := 0;              -- tile id of the background 
  53.             paddleId     : Natural := 0;              -- tile id of a paddle 
  54.             ballId       : Natural := 0;              -- tile id of the ball 
  55.  
  56.             boundsX1, 
  57.             boundsY1, 
  58.             boundsX2, 
  59.             boundsY2     : Float := 0.0; 
  60.  
  61.             ball, 
  62.             compPlayer, 
  63.             keenPlayer   : Entity_Rec; 
  64.  
  65.             compScore, 
  66.             keenScore    : Natural := 0; 
  67.  
  68.             outOfBounds  : Boolean := False;          -- ball is out of bounds 
  69.             nextBall     : Time_Span := Time_Span_Last;  -- time of next ball reset 
  70.         end record; 
  71.  
  72.     procedure Construct( this    : access Paddle_War; 
  73.                          view    : not null access Game_Views.Game_View'Class; 
  74.                          id      : String; 
  75.                          libName : String ); 
  76.     pragma Precondition( id'Length > 0 ); 
  77.     pragma Precondition( libName'Length > 0 ); 
  78.  
  79.     procedure Delete( this : in out Paddle_War ); 
  80.  
  81.     procedure Draw_Content( this : access Paddle_War ); 
  82.  
  83.     function Get_Min_Height( this : access Paddle_War ) return Natural; 
  84.  
  85.     function Get_Min_Width( this : access Paddle_War ) return Natural; 
  86.  
  87.     procedure On_Key_Press( this    : access Paddle_War; 
  88.                             evt     : not null A_Key_Event; 
  89.                             handled : in out Boolean ); 
  90.  
  91.     procedure On_Key_Release( this    : access Paddle_War; 
  92.                               evt     : not null A_Key_Event; 
  93.                               handled : in out Boolean ); 
  94.  
  95.     procedure On_Shown( this : access Paddle_War; shown : Boolean ); 
  96.  
  97.     procedure Tick( this : access Paddle_War; time : Tick_Time ); 
  98.  
  99. end Widgets.Paddle_Wars;