1. ----------------------------------------------------------------------------- 
  2.  --  This file contains the body, please refer to specification (.ads file) 
  3.  ----------------------------------------------------------------------------- 
  4.  
  5.  -- with Interfaces; 
  6.  -- with Ada.Characters.Handling;           use Ada.Characters.Handling; 
  7.  
  8. package body Game_Control is 
  9.  
  10.    use GL; 
  11.  
  12.    procedure Append_Commands (size_x, 
  13.                               size_y     :        Integer;                  -- screen dimensions for mouse 
  14.                               warp_mouse :        Boolean;                  -- recenter mouse cursor 
  15.                               c          : in out Command_set;              -- commands are added to c 
  16.                               gx, gy     :    out GL.Double;                -- mouse movement since last call 
  17.                               Keyboard   : access GLUT.Devices.Keyboard := GLUT.Devices.default_Keyboard'Access; 
  18.                               Mouse      : access GLUT.Devices.Mouse    := GLUT.Devices.default_Mouse'Access) is 
  19.  
  20.       use GLUT.Devices; 
  21.  
  22.       sensib : constant := 8.0; 
  23.       dx, dy : Integer; 
  24.  
  25.    begin 
  26.       -------------- 
  27.       -- Keyboard -- 
  28.       -------------- 
  29.  
  30.       -- Clavier : !! lettres : clavier CH 
  31.  
  32.       c (slide_mode) :=     Keyboard.all.modif_set (GLUT.Active_Alt); 
  33.  
  34.       if c (slide_mode) then 
  35.          c (slide_up) :=       Keyboard.all.special_set (GLUT.KEY_PAGE_UP); 
  36.          c (slide_down) :=     Keyboard.all.special_set (GLUT.KEY_PAGE_DOWN); 
  37.       else 
  38.          c (turn_up) :=        Keyboard.all.special_set (GLUT.KEY_PAGE_UP); 
  39.          c (turn_down) :=      Keyboard.all.special_set (GLUT.KEY_PAGE_DOWN); 
  40.          c (slide_left) :=     Keyboard.all.normal_set ('A'); 
  41.          c (slide_right) :=    Keyboard.all.normal_set ('D'); 
  42.          c (slide_up) :=       Keyboard.all.normal_set ('R'); 
  43.          c (slide_down) :=     Keyboard.all.normal_set ('F'); 
  44.       end if; 
  45.       c (swing_plus) :=     Keyboard.all.normal_set ('E'); 
  46.       c (swing_minus) :=    Keyboard.all.normal_set ('Q'); 
  47.       c (special_plus) :=   Keyboard.all.normal_set ('+'); 
  48.       c (special_minus) :=  Keyboard.all.normal_set ('-'); 
  49.       c (jump) :=           Strike_once (' ', Keyboard); 
  50.       for i in n0 .. n9 loop 
  51.          c (i) := Strike_once (Character'Val (Command'Pos (i) - Command'Pos (n0) + Character'Pos ('0')), 
  52.                                Keyboard); 
  53.       end loop; 
  54.  
  55.       c (photo) :=          Strike_once (GLUT.KEY_F12, Keyboard); 
  56.       c (video) :=          Strike_once (GLUT.KEY_F11, Keyboard); 
  57.       c (toggle_10) :=      Strike_once (GLUT.KEY_F10, Keyboard); 
  58.  
  59.       c (interrupt_game) := Keyboard.all.normal_set (ASCII.ESC); 
  60.       c (go_forward) :=     Keyboard.all.special_set (GLUT.KEY_UP) 
  61.                     or else Keyboard.all.normal_set ('W'); 
  62.       c (go_backwards) :=   Keyboard.all.special_set (GLUT.KEY_DOWN) 
  63.                     or else Keyboard.all.normal_set ('S'); 
  64.       c (run_mode) :=       Keyboard.all.modif_set (GLUT.Active_Shift); 
  65.       c (ctrl_mode) :=      Keyboard.all.modif_set (GLUT.Active_Control); 
  66.  
  67.       ----------- 
  68.       -- Mouse -- 
  69.       ----------- 
  70.  
  71.       if Mouse.all.button_state (GLUT.LEFT_BUTTON)  then 
  72.          c (go_forward) := True; 
  73.       end if; 
  74.       if Mouse.all.button_state (GLUT.RIGHT_BUTTON) then 
  75.          c (slide_mode) := True; 
  76.       end if; 
  77.  
  78.       dx := Mouse.all.mx - Mouse.all.oldx; 
  79.       dy := Mouse.all.my - Mouse.all.oldy; 
  80.       gx := 0.0; 
  81.       gy := 0.0; 
  82.       if abs dx <= 100 and then abs dy <= 100 then 
  83.          -- ^ avoid window in/out movements 
  84.          if dx /= 0 then 
  85.             gx := sensib * GL.Double (dx) / GL.Double (size_x); 
  86.             case c (slide_mode) is 
  87.                when True  => c (slide_lateral_graduated) := True; 
  88.                when False => c (turn_lateral_graduated) := True; 
  89.             end case; 
  90.          end if; 
  91.          if dy /= 0 then 
  92.             gy := -sensib * GL.Double (dy) / GL.Double (size_y); 
  93.             case c (slide_mode) is 
  94.                when True  => c (slide_vertical_graduated) := True; 
  95.                when False => c (turn_vertical_graduated) := True; 
  96.             end case; 
  97.          end if; 
  98.       end if; 
  99.  
  100.       if warp_mouse and then 
  101.         (abs (Mouse.all.mx - size_x / 2) > size_x / 4 or else abs (Mouse.all.my - size_y / 2) > size_y / 4) 
  102.       then 
  103.          Mouse.all.oldx := size_x / 2; 
  104.          Mouse.all.oldy := size_y / 2; 
  105.          GLUT.WarpPointer (Mouse.all.oldx, Mouse.all.oldy); 
  106.       else 
  107.          Mouse.all.oldx := Mouse.all.mx; 
  108.          Mouse.all.oldy := Mouse.all.my; 
  109.       end if; 
  110.  
  111.       if c (slide_mode) then 
  112.          c (slide_left) :=     Keyboard.all.special_set (GLUT.KEY_LEFT); 
  113.          c (slide_right) :=    Keyboard.all.special_set (GLUT.KEY_RIGHT); 
  114.       else 
  115.          c (turn_left) :=      Keyboard.all.special_set (GLUT.KEY_LEFT); 
  116.          c (turn_right) :=     Keyboard.all.special_set (GLUT.KEY_RIGHT); 
  117.       end if; 
  118.  
  119.    end Append_Commands; 
  120.  
  121. end Game_Control;