-- ----------------------------------------------------------------- --
--                Copyright (C) 2001 A.M.F.Vargas                    --
--                Antonio M. F. Vargas                               --
--                Ponta Delgada - Azores - Portugal                  --
--                E-mail: avargas@adapower.net                       --
--                http://www.adapower.net/~avargas/                  --
-- ----------------------------------------------------------------- --
--                                                                   --
-- 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.                                       --
--                                                                   --
-- ----------------------------------------------------------------- --

with SDL.Types; use SDL.Types;
with SDL.Video;
with SDL.Error;
with SDL.Events;
with SDL.Keyboard;
with SDL.Quit;
with SDL.Keysym;
with GNAT.OS_Lib;
with Interfaces.C.Strings;
with Ada.Text_IO; use Ada.Text_IO;

--  =====================================
procedure Simple02 is
   package C  renames Interfaces.C;
   package V  renames SDL.Video;
   package Er renames SDL.Error;
   package S  renames C.Strings;
   package Ev renames SDL.Events;
   package Kb renames SDL.Keyboard; 
   package Ks renames SDL.Keysym;
   use type SDL.Init_Flags;
   use type C.int;
   use type V.Surface_ptr;
   
   Main_Surface : SDL.Video.Surface_ptr;
   
   --  -----------------------------------
   procedure RS_Blit (
      bitmap : V.Surface_ptr;
      x      : Sint16;
      y      : Sint16)
   is
      dest : aliased V.Rect;
   begin
      dest.x := x;
      dest.y := y;
      dest.w := Uint16 (bitmap.w);
      dest.h := Uint16 (bitmap.h);
      V.BlitSurface (bitmap, null, Main_Surface, dest);
   end RS_Blit;
   
   --  ----------------------------------
   procedure Get_Background_Image (
      Surface : V.Surface_ptr;
      x       : C.int;
      y       : C.int)
   is
      Source      : aliased V.Rect;
      Destination : aliased V.Rect;
   begin
      Source.x := Sint16 (x);
      Source.y := Sint16 (y);
      Source.w := Uint16 (Surface.w);
      Source.h := Uint16 (Surface.h);
      
      Destination.x := 0;
      Destination.y := 0;
      Destination.w := Uint16 (Surface.w);
      Destination.h := Uint16 (Surface.h);

      V.BlitSurface (Main_Surface, Source, Surface, Destination);
                                  
   end Get_Background_Image;

   --  ---------------------------------
   Procedure Put_Background_Image
   is
      Image : V.Surface_ptr := V.LoadBmp ( 
                     S.New_String ("background00.bmp"));
   begin
      if Image /= null then
         RS_Blit (image, 0, 0);
         V.Flip (Main_Surface);
      end if;
   end Put_Background_Image;
      
   --  ---------------------------------
   procedure Start_Event_Management
   is
      Quit  : Boolean := False;
      Event : aliased Ev.Event;
      Rect  : V.Rect := (100, 100, 200, 200);
      PollEvent_Result : C.int;
   begin
      loop
         Ev.PollEventVP (PollEvent_Result, Event);
         if PollEvent_Result = 1 then
            case Event.the_type is
               when Ev.KEYDOWN =>
                  Put_line (Ks.Key'Image (
                     Event.key.keysym.sym));
                  case event.key.keysym.sym is
                     when Ks.K_ESCAPE =>
                        Quit := True;
                     when others => null;
                  end case;
                when  Ev.QUIT => Quit := True;
                when others => null;
            end case;
         end if;
         exit when Quit;
      end loop;

   end Start_Event_Management;

   --  ---------------------------------
begin

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

   SDL.Quit.atexit (SDL.SDL_Quit'Access);

   SDL.Video.WM_SetCaption (S.New_String (" Olá mundo "),
                            S.Null_Ptr);

   Main_Surface := V.SetVideoMode (800, 600, 16,
                                   V.SWSURFACE);
   if Main_Surface = null then
      Put_Line ("Couldn't set video mode" &
                S.Value (Er.GetError));
      GNAT.OS_Lib.OS_Exit (1);
   end if;
   
   Put_Background_Image;
    
   Kb.EnableUNICODE (1);
  
   Start_Event_Management;
  
   V.FreeSurface (Main_Surface);

end Simple02;


syntax highlighted by Code2HTML, v. 0.9.1