diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2024-02-20 18:04:23 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2024-02-20 18:04:23 +1300 |
commit | f18ea4474bb4905a00e0b39e7205c177ee994196 (patch) | |
tree | 67a06833192e0f47695ab872badb88fb0970280a /src/fltk-images-rgb-jpeg.adb | |
parent | c47bea48a24e51e178354f3e3bb53d8b9964b769 (diff) |
Improved binding for the FLTK.Images package subtree
Diffstat (limited to 'src/fltk-images-rgb-jpeg.adb')
-rw-r--r-- | src/fltk-images-rgb-jpeg.adb | 43 |
1 files changed, 34 insertions, 9 deletions
diff --git a/src/fltk-images-rgb-jpeg.adb b/src/fltk-images-rgb-jpeg.adb index 9448570..9d7afe1 100644 --- a/src/fltk-images-rgb-jpeg.adb +++ b/src/fltk-images-rgb-jpeg.adb @@ -19,6 +19,13 @@ package body FLTK.Images.RGB.JPEG is pragma Import (C, new_fl_jpeg_image, "new_fl_jpeg_image"); pragma Inline (new_fl_jpeg_image); + function new_fl_jpeg_image2 + (N : in Interfaces.C.char_array; + D : in System.Address) + return System.Address; + pragma Import (C, new_fl_jpeg_image2, "new_fl_jpeg_image2"); + pragma Inline (new_fl_jpeg_image2); + procedure free_fl_jpeg_image (P : in System.Address); pragma Import (C, free_fl_jpeg_image, "free_fl_jpeg_image"); @@ -42,6 +49,10 @@ package body FLTK.Images.RGB.JPEG is + -------------------- + -- Construction -- + -------------------- + package body Forge is function Create @@ -50,16 +61,30 @@ package body FLTK.Images.RGB.JPEG is begin return This : JPEG_Image do This.Void_Ptr := new_fl_jpeg_image - (Interfaces.C.To_C (Filename)); + (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; + end return; + end Create; + + function Create + (Name : in String := ""; + Data : in Color_Component_Array) + return JPEG_Image is + begin + return This : JPEG_Image do + This.Void_Ptr := new_fl_jpeg_image2 + (Interfaces.C.To_C (Name), + 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; + when 1 => raise No_Image_Error; + when 2 => raise File_Access_Error; + when 3 => raise Format_Error; + when others => null; end case; end return; end Create; |