-- ----------------------------------------------------------------- --
-- 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 Interfaces.C;
with Lib_C;
package body SDL_Framebuffer is
use type C.int;
-- ===========================================================
function Go_XY_24b_Unchecked (
Surface : Vd.Surface_ptr;
X : Natural;
Y : Natural) return Framebuffer_8bPointer
is
begin
return Go_XY_Unchecked (Surface, Natural (3 * X), Natural (Y));
end Go_XY_24b_Unchecked;
-- ===========================================================
procedure Set_24b_Value_Unchecked (
Surface : Vd.Surface_ptr;
Location : Framebuffer_8bPointer;
Value : Uint32)
is
use Uint8_Ptrs;
use Uint8_PtrOps;
use Interfaces;
Shift : C.int;
Pix : Framebuffer_8bPointer := Location;
begin
Shift := C.int (Surface.format.Rshift);
Uint8_Ptrs.Object_Pointer (
Uint8_PtrOps.Pointer (Pix)
+ C.ptrdiff_t (Shift / 8)
).all := Uint8 (Shift_Right (Value, Integer (Shift)));
Shift := C.int (Surface.format.Gshift);
Uint8_Ptrs.Object_Pointer (
Uint8_PtrOps.Pointer (Pix)
+ C.ptrdiff_t (Shift / 8)
).all := Uint8 (Shift_Right (Value, Integer (Shift)));
Shift := C.int (Surface.format.Bshift);
Uint8_Ptrs.Object_Pointer (
Uint8_PtrOps.Pointer (Pix)
+ C.ptrdiff_t (Shift / 8)
).all := Uint8 (Shift_Right (Value, Integer (Shift)));
end Set_24b_Value_Unchecked;
-- =======================================
procedure Copy_Colors (
Source : Surface_ptr;
Dest : Color_PtrOps.Pointer;
Num_Colors : Natural)
is
begin
Color_PtrOps.Copy_Array (
Color_PtrOps.Pointer (Source.format.palette.colors),
Dest,
C.ptrdiff_t (Num_Colors));
end Copy_Colors;
-- =======================================
function Copy_Colors (
Surface : Surface_ptr;
Num_Colors : Natural) return Colors_Array is
begin
return Color_PtrOps.Value (
Color_PtrOps.Pointer (Surface.format.palette.colors),
C.ptrdiff_t (Num_Colors));
end Copy_Colors;
-- ===================================================================
function Pitch_Gap (Surface : Surface_ptr) return Uint16 is
begin
return Surface.pitch
- Uint16 (Surface.w)* Uint16 (Surface.format.BytesPerPixel);
end Pitch_Gap;
-- ==================================================================
function Get_Palette_Red (
Surface : Surface_ptr;
Color_Index : Uint8) return Uint8
is
use Color_PtrOps;
begin
return
Color_ptr (
Color_PtrOps.Pointer (Surface.format.palette.colors)
+ C.ptrdiff_t (Color_Index)
).all.r;
end Get_Palette_Red;
-- =============================================
function Get_Palette_Green (
Surface : Surface_ptr;
Color_Index : Uint8) return Uint8
is
use Color_PtrOps;
begin
return
Color_ptr (
Color_PtrOps.Pointer (Surface.format.palette.colors)
+ C.ptrdiff_t (Color_Index)
).all.g;
end Get_Palette_Green;
-- =============================================
function Get_Palette_Blue (
Surface : Surface_ptr;
Color_Index : Uint8) return Uint8
is
use Color_PtrOps;
begin
return
Color_ptr (
Color_PtrOps.Pointer (Surface.format.palette.colors)
+ C.ptrdiff_t (Color_Index)
).all.b;
end Get_Palette_Blue;
-- #######################################################################
end SDL_Framebuffer;
syntax highlighted by Code2HTML, v. 0.9.1