File : ../src/simple_jpeg_lib.adb
-----------------------------------------------------------------------
-- Simple JPEG Library - a libjpeg binding for ADA --
-- --
-- Copyright (C) 2002 --
-- Freydiere P. --
-- --
-- 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. --
-----------------------------------------------------------------------
package body simple_jpeg_lib is
procedure JPEG_Err_Exit(Info : System.Address);
pragma Convention(C,JPEG_Err_Exit);
----------------
-- Close_Jpeg --
----------------
procedure Close_Jpeg (J : in out Jpeg_Handle_decompress) is
use Interfaces.C;
Ret : Int;
begin
Ret := C_Close_Jpeg(J);
if Ret/=0 then
raise Jpeg_Exception;
end if;
end Close_Jpeg;
---------------
-- Open_Jpeg --
---------------
procedure Open_Jpeg (Nom : in String; J : Out Jpeg_Handle_Decompress; Scale_Denom : in Integer ) is
use Interfaces.C;
use System;
begin
J := C_Open_Jpeg(Interfaces.C.To_C(Nom),Jpeg_Err_Exit'Access, Int(Scale_Denom));
if Address(J) = Null_Address then
raise jpeg_exception; -- pb
end if;
end Open_Jpeg;
--------------------
-- Read_Next_Line --
--------------------
procedure Read_Next_Line
(J: in Jpeg_Handle_decompress;
Components : in Out Component_Ptr)
is
use Interfaces.C;
use component_array_ptr; -- for component operator
begin
Components := C_Get_Row(J);
if Components = null then
raise Jpeg_Exception;
end if;
end Read_Next_Line;
--------------------
-- Create_Jpeg --
--------------------
procedure Close_Jpeg(J : in out Jpeg_Handle_compress)
is
use Interfaces.C;
Ret : Int;
begin
Ret := C_Close_Compress_Jpeg(J);
end Close_Jpeg;
procedure Create_Jpeg(Nom : in String ; J : out Jpeg_Handle_Compress ; Width , Height , NbComposantes : in Interfaces.C.int)
is
use Interfaces.C;
use System;
Jptr : jpeg_handle_compress;
begin
Jptr := C_Create_Jpeg(Interfaces.C.To_C(Nom),Jpeg_Err_Exit'Access, width,height,nbcomposantes);
if Address(Jptr) = null_address then
raise Jpeg_Exception;
end if;
J := Jptr;
end Create_Jpeg;
procedure Write_Line(J : in Jpeg_Handle_Compress; Components : in Component_Ptr)
is
use Interfaces.C;
Ret : Int;
begin
Ret := C_Write_Row(J,Components);
if Ret >0 then
raise Jpeg_Exception;
end if;
end Write_Line;
procedure Get_Image_Info(J : in Jpeg_Handle_Decompress ; Width , Height , NbComposantes : out Interfaces.C.Int)
is
begin
Width := C_Get_Image_Width(J);
Height := c_get_image_height(J);
nbcomposantes := c_get_image_num_components(J);
end Get_Image_Info;
procedure JPEG_Err_Exit(Info : System.Address) is
begin
raise Jpeg_Exception;
end;
end simple_jpeg_lib;