diff options
Diffstat (limited to 'body/fltk-images-rgb-jpeg.adb')
| -rw-r--r-- | body/fltk-images-rgb-jpeg.adb | 32 |
1 files changed, 18 insertions, 14 deletions
diff --git a/body/fltk-images-rgb-jpeg.adb b/body/fltk-images-rgb-jpeg.adb index 17debb5..61d06e6 100644 --- a/body/fltk-images-rgb-jpeg.adb +++ b/body/fltk-images-rgb-jpeg.adb @@ -12,6 +12,12 @@ with package body FLTK.Images.RGB.JPEG is + ------------------------ + -- Functions From C -- + ------------------------ + + -- Allocation -- + function new_fl_jpeg_image (F : in Interfaces.C.char_array) return Storage.Integer_Address; @@ -33,6 +39,10 @@ package body FLTK.Images.RGB.JPEG is + ------------------- + -- Destructors -- + ------------------- + overriding procedure Finalize (This : in out JPEG_Image) is begin @@ -46,7 +56,7 @@ package body FLTK.Images.RGB.JPEG is -------------------- - -- Construction -- + -- Constructors -- -------------------- package body Forge is @@ -58,15 +68,11 @@ package body FLTK.Images.RGB.JPEG is return This : JPEG_Image do This.Void_Ptr := new_fl_jpeg_image (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; + Raise_Fail_Errors (This); end return; end Create; + function Create (Name : in String := ""; Data : in Color_Component_Array) @@ -75,13 +81,10 @@ package body FLTK.Images.RGB.JPEG is return This : JPEG_Image do This.Void_Ptr := new_fl_jpeg_image2 (Interfaces.C.To_C (Name), - Storage.To_Integer (Data (Data'First)'Address)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; + (if Data'Length > 0 + then Storage.To_Integer (Data (Data'First)'Address) + else Null_Pointer)); + Raise_Fail_Errors (This); end return; end Create; @@ -90,3 +93,4 @@ package body FLTK.Images.RGB.JPEG is end FLTK.Images.RGB.JPEG; + |