
-- ----------------------------------------------------------------- --
--                AdaSDL_Framebuffer                                 --
--                Copyright (C) 2001 A.M.F.Vargas                    --
--                Antonio M. F. Vargas                               --
--                Ponta Delgada - Azores - Portugal                  --
--                http://www.adapower.net/~avargas                   --
--                E-mail: avargas@adapower.net                       --
-- ----------------------------------------------------------------- --
--                                                                   --
-- This library 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 library 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.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-- ----------------------------------------------------------------- --

--  ##########################################################################
--  ###   These are new extensions to the SDL API in order to improve the
--  ###   Ada code and to isolate the pointer arithmetic inside the library.
--  ##########################################################################

with Lib_C;
package body SDL_Framebuffer_Generics is
   
   --  ===========================================================
   --                   Go_XY_Generic
   --  ===========================================================
   function Go_XY_Generic (
      Surface : Vd.Surface_ptr;
      X       : Natural;
      Y       : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
      use Uint_Ptrs;
   begin
      if X < Natural (Surface.h) and Y < Natural (Surface.w) then
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
            + C.ptrdiff_t (
                 Y * Natural (Surface.pitch) / Natural (Surface.format.BytesPerPixel)
                 + X));
      else
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels)));
      end if;
   end Go_XY_Generic;
   
   --  ===========================================================
   --                   Go_XY_Unchecked_Generic
   --  ===========================================================
   function Go_XY_Unchecked_Generic (
      Surface : Vd.Surface_ptr;
      X       : Natural;
      Y       : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
      use Uint_Ptrs;
   begin
      return Uint_Ptrs.Object_Pointer (
         Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
         + C.ptrdiff_t (
              Y * Natural (Surface.pitch) / Natural (Surface.format.BytesPerPixel)
              + X));


   end Go_XY_Unchecked_Generic;
   
   --  ===========================================================
   --                 Get_Framebuffer_Generic
   --  ===========================================================
   function Get_Framebuffer_Generic (
      Surface : Vd.Surface_ptr) return Uint_Ptrs.Object_Pointer
   is
   begin
      return Uint_Ptrs.To_Pointer (Surface.pixels);
   end Get_Framebuffer_Generic;
   
   --  ===========================================================
   --                     Goto_Line_Generic
   --  ===========================================================
   function Goto_Line_Generic (
      Surface     : Vd.Surface_ptr;
      Line_Num    : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
      use type C.int;
   begin
      if Line_Num > Natural (Surface.h - 1) then
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
            + C.ptrdiff_t (Line_Num * Natural (Surface.pitch)));
      else
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels)));
      end if;
   end Goto_Line_Generic;
   
   --  ===================================================================
   --                   Goto_Line_Unchecked_Generic
   --  ===================================================================
   function Goto_Line_Unchecked_Generic (
      Surface  : Vd.Surface_ptr;
      Line_Num : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
         Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
         + C.ptrdiff_t (Line_Num * Natural (Surface.pitch)));
   end Goto_Line_Unchecked_Generic;
   
   --  ===========================================================
   --             Goto_Line_End_Unchecked_Generic
   --  ===========================================================
   function Goto_Line_End_Unchecked_Generic (
      Surface  : Vd.Surface_ptr;
      Line_Num : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
      use type C.int;
   begin
      return Uint_Ptrs.Object_Pointer (
         Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
         + C.ptrdiff_t (Line_Num * Natural (Surface.pitch)
                        + Natural (Surface.w - 1)));
   end Goto_Line_End_Unchecked_Generic;
   
   --  ===========================================================
   --                     Goto_Line_End_Generic
   --  ===========================================================
   function Goto_Line_End_Generic (
      Surface  : Vd.Surface_ptr;
      Line_Num : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
      use type C.int;
   begin
      if Line_Num < Natural (Surface.h - 1) then
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
            + C.ptrdiff_t (Line_Num * Natural (Surface.pitch)
                           + Natural (Surface.w - 1)));
      else
         return Uint_Ptrs.Object_Pointer (
            Uint_PtrOps.Pointer (Uint_Ptrs.To_Pointer (Surface.pixels))
            + C.ptrdiff_t (Natural (Surface.w - 1)));
      end if;
   end Goto_Line_End_Generic;
   
   --  ===========================================================
   --                 Next_Line_Unchecked_Generic
   --  ===========================================================
   function Next_Line_Unchecked_Generic (
      Surface : Vd.Surface_ptr;
      Actual : Uint_Ptrs.Object_Pointer) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                + C.ptrdiff_t (Surface.pitch));
   end Next_Line_Unchecked_Generic;
   
   --  ===========================================================
   --                Prev_Line_Unchecked_Generic
   --  ===========================================================
   function Prev_Line_Unchecked_Generic (
      Surface : Vd.Surface_ptr;
      Actual : Uint_Ptrs.Object_Pointer) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                - C.ptrdiff_t (Surface.pitch));
   end Prev_Line_Unchecked_Generic;
   
   --  ===========================================================
   --                   Go_Right_Unchecked_Generic
   --  ===========================================================
   function Go_Right_Unchecked_Generic (
      Actual : Uint_Ptrs.Object_Pointer;
      Displacement : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                + C.ptrdiff_t (Displacement));
   end Go_Right_Unchecked_Generic;
   
   --  ===========================================================
   --                  Go_Left_Unchecked_Generic
   --  ===========================================================
   function Go_Left_Unchecked_Generic (
      Actual : Uint_Ptrs.Object_Pointer;
      Displacement : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                - C.ptrdiff_t (Displacement));
   end Go_Left_Unchecked_Generic;
   
   --  ===========================================================
   --                   Go_Up_Unchecked_Generic
   --  ===========================================================
   function Go_Up_Unchecked_Generic (
      Surface : Vd.Surface_ptr;
      Actual  : Uint_Ptrs.Object_Pointer;
      Displacement : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                - C.ptrdiff_t (Uint16 (Displacement) * Surface.pitch));
   end Go_Up_Unchecked_Generic;
   
   --  ===========================================================
   --                  Go_Down_Unchecked_Generic
   --  ===========================================================
   function Go_Down_Unchecked_Generic (
      Surface : Vd.Surface_ptr;
      Actual  : Uint_Ptrs.Object_Pointer;
      Displacement : Natural) return Uint_Ptrs.Object_Pointer
   is
      use Uint_PtrOps;
   begin
      return Uint_Ptrs.Object_Pointer (
                Uint_PtrOps.Pointer (Actual)
                + C.ptrdiff_t (Uint16 (Displacement) * Surface.pitch));
   end Go_Down_Unchecked_Generic;
   
   --  ===========================================================
   --                     Paint_Line_Generic
   --  ===========================================================
   procedure Paint_Line_Generic (
      Surface : Vd.Surface_ptr;
      Line_Num : Natural;
      Color : C.int)
   is
      Line_Begin : Uint_Ptrs.Object_Pointer;
   begin
      Line_Begin := Goto_Line (Surface, Line_Num);
      Lib_C.memset (
         Uint_Ptrs.To_Address (Line_Begin),
         Color,
         --  Surface.w * Surface.format.BytesPerPixel);
         C.size_t (Surface.pitch));
   end Paint_Line_Generic;
   
   --  ===========================================================
   --                     Paint_Line_Unchecked_Generic
   --  ===========================================================
   procedure Paint_Line_Unchecked_Generic (
      Surface    : Vd.Surface_ptr;
      Line_Begin : Uint_Ptrs.Object_Pointer;
      Color      : C.int) is
   begin
      Lib_C.memset (
         Uint_Ptrs.To_Address (Line_Begin),
         Color,
         --  Surface.w * Surface.format.BytesPerPixel);
         C.size_t (Surface.pitch));
   end Paint_Line_Unchecked_Generic;
   
   --  ===========================================================
   function MapRGB_Generic (
      format : Vd.PixelFormat_ptr;
      r      : Uint8;
      g      : Uint8;
      b      : Uint8)
      return Element_Type is
   begin
      return Element_Type (Vd.MapRGB (format, r, g, b));
   end MapRGB_Generic;
   
   --  ===========================================================
   
end SDL_Framebuffer_Generics;
