
-- ----------------------------------------------------------------- --
--                                                                   --
-- This is free software; you can redistribute it and/or             --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This software is distributed in the hope that it will be useful,  --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- ----------------------------------------------------------------- --

-- ----------------------------------------------------------------- --
-- This is a translation, to the Ada programming language, of the    --
-- original C test files written by Sam Lantinga - www.libsdl.org    --
-- translation made by Antonio F. Vargas - www.adapower.net/~avargas --
-- ----------------------------------------------------------------- --

--  ----------------------------------------------------------------- --
--  WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
--  ----------------------------------------------------------------- --
--  SERIOUS WARNING: The Ada code in this files may, at some points,
--  rely directly on pointer arithmetic which is considered very
--  unsafe and PRONE TO ERROR. The AdaSDL_Framebuffer examples are
--  more appropriate and easier to understand. They should be used in
--  replacement of this files. Please go there.
--  This file exists only for the sake of completness and to test
--  AdaSDL without the dependency of AdaSDL_Framebuffer.
--  ----------------------------------------------------------------- --
--  WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
--  ----------------------------------------------------------------- --


with Interfaces.C.Strings;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Float_Text_IO; use Ada.Float_Text_IO;
with Ada.Command_Line;
with Ada.Characters.Handling;
with Ada.Numerics.Discrete_Random;
with GNAT.OS_Lib;
with SDL.Types; use SDL.Types;
with SDL.Video;
with SDL.Error;
with SDL.Events;
with SDL.Quit;
with SDL.Timer;


procedure Testsprite is

   package C  renames Interfaces.C;
   use type C.int;
   use type C.double;
   use type C.unsigned;
   package CS renames Interfaces.C.Strings;
   package CL renames Ada.Command_Line;
   package CH renames Ada.Characters.Handling;
   package Uint8_IO is new Ada.Text_IO.Modular_IO (Uint8);
   package V  renames SDL.Video;
   use type V.Surface_ptr;
   use type V.Palette_ptr;
   use type V.Surface_Flags;
   package T  renames SDL.Timer;
   package Er renames SDL.Error;
   package Ev renames SDL.Events;

   NUM_SPRITES   : constant :=  100;
   MAX_SPEED     : constant :=    1;
   Screen_Width  : constant :=  640; -- 640 800 1024
   Screen_Height : constant :=  480; -- 480 600  768

   sprite : V.Surface_ptr;
   numsprites : C.unsigned;
   screen : V.Surface_ptr;
   type Rects_Array_Access is access V.Rects_Array;
   sprite_rects, positions, velocities : Rects_Array_Access;
   sprites_visible : C.int;

   use SDL.Types.Uint8_Ptrs;

   --  Packages for random generation numbers

   type Screen_Width_Type is range 0 .. Screen_Width - 1;
   package Random_w is new Ada.Numerics.Discrete_Random (
      Screen_Width_Type);
   Width_Generator : Random_w.Generator;
   
   type Screen_Height_Type is range 0 .. Screen_Height - 1;
   package Random_h is new Ada.Numerics.Discrete_Random (
      Screen_Height_Type);
   Height_Generator : Random_h.Generator;

   type Velocity_Type is range 0 .. MAX_SPEED * 2 + 1;
   package Random_Velocity is new Ada.Numerics.Discrete_Random (
      Velocity_Type);
   Velocity_Generator : Random_Velocity.Generator;

   --  ##################################
   function LoadSprite (screen : V.Surface_ptr; file : String)
      return C.int
   is
      temp : V.Surface_ptr;
   begin
      --  Load the sprite image
      sprite := V.LoadBMP (CS.New_String(file));
      if sprite = null then
         Put_Line ("Couldn't load " & file & " : " & Er.Get_Error);
         return -1;
      end if;
   
      --  Set transparent pixel as the pixel at (0,0)
      if sprite.format.palette /= null then
         V.SetColorKey (
            sprite,
            (V.SRCCOLORKEY or V.RLEACCEL),
            Uint32 (To_Pointer (sprite.pixels).all));
      end if;

      --  Convert sprite to video format
      temp := V.DisplayFormat(sprite);
      if temp = null then
         Put_Line ("Couldn't convert background: " &
                   CS.Value (Er.GetError));
         return -1;
      end if;
      sprite := temp;
      
      --  we're ready to roll. :)
      return 0;
   end LoadSprite;
   
   --  ##################################

   procedure MoveSprites (screen : V.Surface_ptr; background : Uint32)
   is
      nupdates : C.unsigned;
      area : V.Rect;
      type Rect_Access is access all V.Rect;
      position, velocity : Rect_Access;
   begin
      nupdates := 0;
      --  Erase all sprites if necessary
      if sprites_visible /= 0 then
         V.FillRect(screen, null, background);
      end if;

      --  Move the sprite, bounce at the wall, and draw
      for i in sprite_rects'Range loop
         position :=  positions(i)'Access;
         velocity :=  velocities(i)'Access;
         position.x := position.x + velocity.x;
         if (position.x < 0) or (C.int (position.x) >= screen.w) then
            velocity.x := -velocity.x;
            position.x := position.x + velocity.x;
         end if;
         position.y := position.y + velocity.y;
         if (position.y < 0) or (C.int (position.y) >= screen.h) then
            velocity.y := -velocity.y;
            position.y := position.y + velocity.y;
         end if;

         --  Blit the sprite onto the screen
         area := position.all;
         V.BlitSurface (sprite, null, screen, area);
         sprite_rects (nupdates) := area;
         nupdates := nupdates + 1;
      end loop;

      --  Update the screen
      if (screen.flags and V.DOUBLEBUF) = V.DOUBLEBUF then
         V.Flip (screen);
      else
         V.UpdateRects (screen, C.int (nupdates), sprite_rects.all);
      end if;
         
      sprites_visible := 1;
   end MoveSprites;

   --  ##################################
   function FastestFlags(flags : V.Surface_Flags)
      return V.Surface_Flags
   is
      info : V.VideoInfo_ConstPtr;
      new_flags : V.Surface_Flags := flags;
   begin

      --  Hardware aceleration is only used in fullscreen mode
      new_flags := new_flags or V.FULLSCREEN;
      
      --  Check for various video capabilities
      info := V.GetVideoInfo;
      if (info.blit_hw_CC /= 0) and (info.blit_fill /= 0) then
         --  We use accelerated colorkeying and color filling
         new_flags := new_flags or V.HWSURFACE;
      end if;
      --  If we have enough video memory, and will use accelerated
      --  blits directly to it, then use page flipping.
      if (new_flags and V.HWSURFACE) = V.HWSURFACE then
         --  Direct hardware blitting without double-buffering
         --  causes really bad flickering.
         if info.video_mem > Screen_Width * Screen_Height then
            new_flags := new_flags or V.DOUBLEBUF;
         else
            new_flags := new_flags and not V.HWSURFACE;
         end if;
      end if;

      --  Return the flags
      return new_flags;
      
   end FastestFlags;
   
   --  ##################################
   video_bpp : Uint8;
   videoflags : V.Surface_Flags;
   background : Uint32;
   done : C.int;
   event : Ev.Event;
   and_then, now, frames : Uint32;
   argc : Natural := CL.Argument_Count;
   PollEvent_Result : C.int;
  
   --  ##################################

begin
   
   if SDL.Init (SDL.INIT_VIDEO) < 0 then
      Put_Line ("Couldn't initialize SDL: " &
                C.Strings.Value (Er.GetError));
      GNAT.OS_Lib.OS_Exit (1);
   end if;

   SDL.Quit.atexit (SDL.SDL_Quit'Access);
   
   numsprites := NUM_SPRITES;
   videoflags := V.SWSURFACE or V.ANYFORMAT;
   video_bpp := 8;
   
   Put_Line ("Número de argumentos: " & Natural'Image (argc));
   
   while argc > 0 loop
      if (argc > 1) and then
            (CL.Argument (argc - 1) = "-bpp") and then
            CH.Is_Digit (CL.Argument (argc) (1)) then
         declare
            use Uint8_IO;
            last : Positive;
         begin
            Get (CL.Argument (argc), video_bpp, last);
         end;
         videoflags := videoflags and not V.ANYFORMAT;
         argc := argc - 2;
         Put_Line ("-bpp" & Uint8'Image (video_bpp));
      elsif CL.Argument (argc) = "-fast" then
         videoflags := FastestFlags (videoflags);
         argc := argc - 1;
         Put_Line ("-fast");
      elsif CL.Argument (argc) = "-hw" then
         videoflags := videoflags xor V.DOUBLEBUF;
         argc := argc -1;
         Put_Line ("-hw");
      elsif CL.Argument (argc) = "-fullscreen" then
         videoflags := videoflags xor V.FULLSCREEN;
         argc := argc - 1;
         Put_Line ("-fullscreen");
      elsif CH.Is_Digit (CL.Argument (argc) (1)) then
         declare
            package unsigned_IO is new Modular_IO (C.unsigned);
            use unsigned_IO;
            last : Positive;
         begin
            Get (CL.Argument (argc), numsprites, last);
            argc := argc - 1;
            Put ("numsprites: "); Put (numsprites);
            New_Line;
         end;
      else
         Put_Line ("Usage: " & CL.Command_Name & " " &
                   "[-bpp N] [-hw] [-flip] [-fast] " &
                   "[-fullscreen] [numsprites]");
         GNAT.OS_Lib.OS_Exit (1);
      end if;
   end loop;
 
   sprite_rects := new V.Rects_Array (0 .. numsprites - 1);
   positions    := new V.Rects_Array (0 .. numsprites - 1);
   velocities   := new V.Rects_Array (0 .. numsprites - 1);
 
   --  Set video mode
   screen := V.SetVideoMode (Screen_Width, Screen_Height,
                             C.int (video_bpp), videoflags);
   if screen = null then
      Put_Line ("Couldn't set " & Integer'Image (Screen_Width) &
                "x" & Integer'Image (Screen_Height) &
                " video mode: " & CS.Value (Er.GetError));
      GNAT.OS_Lib.OS_Exit (1);
   end if;

   --  Load the sprite
   if LoadSprite (screen, "icon.bmp") < 0 then
      GNAT.OS_Lib.OS_Exit (1);
   end if;
  
   Random_w.Reset (Width_Generator,  17);
   Random_h.Reset (Height_Generator, 13);

   for i in 0 .. numsprites - 1 loop
      positions (i).x := Sint16 (Random_w.Random (Width_Generator));
      positions (i).y := Sint16 (Random_h.Random (Height_Generator));
      positions (i).w := Uint16 (sprite.w);
      positions (i).h := Uint16 (sprite.h);
      velocities (i).x := 0;
      velocities (i).y := 0;
      while (velocities (i).x = 0) and (velocities (i).y = 0) loop
         velocities (i).x := Sint16 (Random_Velocity.Random (Velocity_Generator)
            - MAX_SPEED);
         velocities (i).y := Sint16 (Random_Velocity.Random (Velocity_Generator)
            - MAX_SPEED);
      end loop;
   end loop;
   background := V.MapRGB (screen.format, 16#00#, 16#00#, 16#00#);

   --  Print out information about our surfaces
   Put_Line ("Screen is at " & Uint8'Image (screen.format.BitsPerPixel) &
             " bits per pixel");
   if (screen.flags and V.HWSURFACE) = V.HWSURFACE then
      Put_Line ("Screen is in video memory");
   else
      Put_Line ("Screen is in system memory");
   end if;

   if (screen.flags and V.DOUBLEBUF) = V.DOUBLEBUF then
      Put_Line ("Screen has double-buffering enabled");
   end if;

   if (sprite.flags and V.HWSURFACE) = V.HWSURFACE then
      Put_Line ("Sprite is in video memory");
   else
      Put_Line ("Sprite in in system memory");
   end if;

   --  Run a sample blit to trigger blit aceleration
   declare
      dst : V.Rect;
   begin
      dst.x := 0;
      dst.y := 0;
      dst.w := Uint16 (sprite.w);
      dst.h := Uint16 (sprite.h);
      V.BlitSurface (sprite, null, screen, dst);
      V.FillRect(screen, dst, background);
   end;
   
   if (sprite.flags and V.HWACCEL) = V.HWACCEL then
      Put_Line ("Sprite blit uses hardware acceleration");
   end if;

   if (sprite.flags and V.RLEACCEL) = V.RLEACCEL then
      Put_Line ("Sprite blit uses RLE acceleration");
   end if;

   --  Loop, blitting sprite and waiting for a keystroke
   frames := 0;
   and_then := T.GetTicks;
   done := 0;
   sprites_visible := 0;
   while done = 0 loop
      --  Check for events
      frames := frames + 1;
      loop
         Ev.PollEventVP (PollEvent_Result, event);
         exit when PollEvent_Result = 0;
         case event.the_type is
            when Ev.KEYDOWN =>
               --  any keypress quits teh app
               done := 1;
            when Ev.QUIT =>
               done := 1;
            when others => null;
         end case;
      end loop;
      MoveSprites (screen, background);
   end loop;
   V.FreeSurface (sprite);
 
   --  Print out some timing information
   now := T.GetTicks;
   if now > and_then then
      Put (Float (frames) * 1000.0 / Float (now - and_then),
           3, 2, 0);
      Put_Line (" frames per second");
   end if;
   
end Testsprite;
