
-- ----------------------------------------------------------------- --
--                                                                   --
-- 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 --
-- ----------------------------------------------------------------- --

with Interfaces.C.Strings;
with Ada.Text_IO; use Ada.Text_IO;
with SDL.Error;
with SDL.Active;
with SDL.Keysym;
with SDL.Mouse;
with SDL.Timer;
with SDL_Framebuffer;

package body ThreadWin_Sprogs is
   package It renames Interfaces;
   package CS renames Interfaces.C.Strings;
   use type C.int;
   use type V.Surface_ptr;
   use type V.Palette_ptr;
   package Er renames SDL.Error;
   use type Ev.Event_Mask;
   package A  renames SDL.Active;
   use type A.Active_State;
   package Ks renames SDL.Keysym;
   use type Ks.Key;
   package M  renames SDL.Mouse;
   use type M.Mouse_Button_State;
   package Tm renames SDL.Timer;
   package Fb renames SDL_Framebuffer;
  
   --  Is the cursor visible
   visible : Boolean := True;

   type Mask_Array is
      array (Integer range <>) of aliased Uint8;
   pragma Convention (C, Mask_Array);
   type Mask_Array_Access is access Mask_Array;

   --  ======================================
   procedure LoadIconSurface (
      file   : in string;
      maskp  : in out Icon_Mask_Array_Access;
      icon   : out V.Surface_ptr)
   is
      use type Interfaces.Unsigned_8;
      mlen   : C.int;
      i : Integer;

      pixels    : Fb.Framebuffer_8bPointer;
      use V.Color_PtrOps;

   begin
      --  Load the icon surface
      icon := V.LoadBMP (file);
      if icon = null then
         Put_Line ("Couldn't load " & file & Er.Get_Error);
         return;
      end if;

      --  Check width and height
      if icon.w mod 8 /= 0 then
         Put_Line ("Icon width must be a multiple of 8!");
         V.FreeSurface (icon);
         icon := null;
         return;
      end if;
      
      if icon.format.palette = null then
         Put_Line ("Icon must have a palette!");
         V.FreeSurface (icon);
         icon := null;
         return;
      end if;

      --  Set the colorkey
      V.SetColorKey (icon, V.SRCCOLORKEY,
                     Fb.Get_Framebuffer (icon).all);
      
      --  Create the mask
      pixels := Fb.Get_Framebuffer (icon);
      Put_Line ("Transparent pixel: (" &
         Uint8'Image (Fb.Get_Palette_Red (icon, pixels.all))
         & "," &
         Uint8'Image (Fb.Get_Palette_Green (icon, pixels.all))
         & "," &
         Uint8'Image (Fb.Get_Palette_Blue (icon, pixels.all))
         & ")");

      mlen := icon.w * icon.h;
      maskp := new V.Icon_Mask_Array (0 .. Integer(mlen/8 - 1));
      maskp.all := (others => 0);
      i := 0;
      while i < Integer (mlen) loop
         if Fb.Go_Right_Unchecked (pixels, i).all /= pixels.all then
            maskp (i / 8) := Uint8 (
               It.Unsigned_8 (maskp (i / 8)) or 16#01#);
         end if;
         i := i + 1;
         if i mod 8 /= 0 then
            maskp (i / 8) := Shift_Left (maskp (i / 8), 1);
         end if;
      end loop;
   end LoadIconSurface;
   
   --  ======================================
   reallyquit : Boolean := False;
   --  ======================================
   function  FilterEvents (event : Ev.Event_ptr) return C.int is
   begin
      case event.the_type is
         when Ev.ISACTIVEEVENT =>
            --  See what happened
            Put("App ");
            if event.active.gain /= 0 then
               Put ("gained ");
            else
               Put ("lost ");
            end if;
            if (event.active.state and A.APPACTIVE) /= 0 then
               Put ("active ");
            end if;
            if (event.active.state and A.APPMOUSEFOCUS) /= 0 then
               Put ("mouse ");
            end if;
            Put_Line ("input");

            --  See if we are iconified or restored
            if (event.active.state and A.APPACTIVE) /= 0 then
               Put ("App has been ");
               if event.active.gain /= 0 then
                  Put_Line ("restored");
               else
                  Put_Line ("iconified");
               end if;
            end if;
            return 0;

         --  This is important! Queue it if we want to quit.
         when Ev.QUIT =>
            if not reallyquit then
               reallyquit := True;
               Put_Line ("Quit requested");
               return 0;
            end if;
            Put_Line ("Quit demanded");
            return 1;
         
         --  Mouse and keyboard events go to threads
         when Ev.MOUSEMOTION
              | Ev.MOUSEBUTTONDOWN
              | Ev.MOUSEBUTTONUP
              | Ev.KEYDOWN
              | Ev.KEYUP =>
            return 1;
         
         --  Drop all other events
         when others =>
            return 0;
      end case;
   end FilterEvents;

   --  ======================================
   function HandleMouse (unused : System.Address) return C.int
   is
      events : Ev.Events_Array (0 .. 9);
      found : C.int;
      mask : Ev.Event_Mask;
   begin
      --  Handle mouse events here
      mask := (Ev.MOUSEMOTIONMASK or Ev.MOUSEBUTTONDOWNMASK or Ev.MOUSEBUTTONUPMASK);
      while not done loop
         Ev.PeepEventsVP (found, events, 10, Ev.GETEVENT, mask);
         for i in Natural range 0 .. Natural (found) - 1 loop
            case events (i).the_type is
               --  We want to toggle visibility on buttonpress
               when Ev.MOUSEBUTTONDOWN | Ev.MOUSEBUTTONUP =>
                  if events (i).button.state = SDL_PRESSED then
                     visible := not visible;
                     M.ShowCursor (Boolean'Pos(visible));
                  end if;
                  Put ("Mouse button '" & Uint8'Image (events (i).button.button));
                  if events (i).button.state = M.Mouse_Button_State (SDL_PRESSED) then
                     Put_Line ("' pressed");
                  else
                     Put_Line ("' released");
                  end if;
               when Ev.MOUSEMOTION =>
                  Put_Line ("Mouse relative motion: {" &
                            Sint16'Image (events (i).motion.xrel) &
                            "," & Sint16'Image (events (i).motion.yrel) & "}");
               when others => null;
            end case;
         end loop;
         --  Give up some CPU to allow events to arrive
         Tm.SDL_Delay (20);
      end loop;
      return 0;
   end HandleMouse;
   
   --  ======================================
   function HandleKeyboard (unused : System.Address) return C.int
   is
      events : Ev.Events_Array (0 .. 9);
      found : C.int;
      mask : Ev.Event_Mask;
   begin
      --  Handle mouse events here
      mask := (Ev.KEYDOWNMASK or Ev.KEYUPMASK);
      while not done loop
         Ev.PeepEventsVP (found, events, 10, Ev.GETEVENT, mask);
         for i in Natural range 0 .. Natural (found) - 1 loop
            case events (i).the_type is
               --  We want to toggle visibility on buttonpress
               when Ev.KEYDOWN | Ev.KEYUP =>
                  --  Allow hitting <ESC> to quit the app
                  if events (i).key.keysym.sym = Ks.K_ESCAPE then
                     done := True;
                  end if;
                  Put ("Key '" &
                       C.wchar_t'Image (C.wchar_t'Val (events (i).key.keysym.unicode)) &
                       "' has been ");
                  if events (i).key.state = Uint8 (SDL_PRESSED) then
                     Put_Line (" pressed");
                  else
                     Put_Line (" released");
                  end if;
               when others => null;
            end case;
         end loop;
         --  Give up some CPU to allow events to arrive
         Tm.SDL_Delay (20);
      end loop;
      return 0;
   end HandleKeyboard;
   
   --  ======================================
end ThreadWin_Sprogs;
