diff options
Diffstat (limited to 'src/fltk-images-rgb.adb')
| -rw-r--r-- | src/fltk-images-rgb.adb | 143 |
1 files changed, 130 insertions, 13 deletions
diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb index 8e3e36f..4382e93 100644 --- a/src/fltk-images-rgb.adb +++ b/src/fltk-images-rgb.adb @@ -13,11 +13,35 @@ use type package body FLTK.Images.RGB is + function new_fl_rgb_image + (Data : in System.Address; + W, H, D, L : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_rgb_image, "new_fl_rgb_image"); + pragma Inline (new_fl_rgb_image); + + function new_fl_rgb_image2 + (P : in System.Address; + C : in Interfaces.C.unsigned) + return System.Address; + pragma Import (C, new_fl_rgb_image2, "new_fl_rgb_image2"); + pragma Inline (new_fl_rgb_image2); + procedure free_fl_rgb_image (I : in System.Address); pragma Import (C, free_fl_rgb_image, "free_fl_rgb_image"); pragma Inline (free_fl_rgb_image); + function fl_rgb_image_get_max_size + return Interfaces.C.size_t; + pragma Import (C, fl_rgb_image_get_max_size, "fl_rgb_image_get_max_size"); + pragma Inline (fl_rgb_image_get_max_size); + + procedure fl_rgb_image_set_max_size + (V : in Interfaces.C.size_t); + pragma Import (C, fl_rgb_image_set_max_size, "fl_rgb_image_set_max_size"); + pragma Inline (fl_rgb_image_set_max_size); + function fl_rgb_image_copy (I : in System.Address; W, H : in Interfaces.C.int) @@ -49,6 +73,14 @@ package body FLTK.Images.RGB is + procedure fl_rgb_image_uncache + (I : in System.Address); + pragma Import (C, fl_rgb_image_uncache, "fl_rgb_image_uncache"); + pragma Inline (fl_rgb_image_uncache); + + + + procedure fl_rgb_image_draw2 (I : in System.Address; X, Y : in Interfaces.C.int); @@ -79,6 +111,70 @@ package body FLTK.Images.RGB is + -------------------- + -- Construction -- + -------------------- + + package body Forge is + + function Create + (Data : in Color_Component_Array; + Width, Height : in Natural; + Depth : in Natural := 3; + Line_Data : in Natural := 0) + return RGB_Image is + begin + return This : RGB_Image do + This.Void_Ptr := new_fl_rgb_image + (Data (Data'First)'Address, + Interfaces.C.int (Width), + Interfaces.C.int (Height), + Interfaces.C.int (Depth), + Interfaces.C.int (Line_Data)); + 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 + (Data : in FLTK.Images.Pixmaps.Pixmap'Class; + Background : in Color := Background_Color) + return RGB_Image is + begin + return This : RGB_Image do + This.Void_Ptr := new_fl_rgb_image2 + (Wrapper (Data).Void_Ptr, + Interfaces.C.unsigned (Background)); + 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; + + end Forge; + + + function Get_Max_Size + return Natural is + begin + return Natural (fl_rgb_image_get_max_size); + end Get_Max_Size; + + + procedure Set_Max_Size + (Value : in Natural) is + begin + fl_rgb_image_set_max_size (Interfaces.C.size_t (Value)); + end Set_Max_Size; + + function Copy (This : in RGB_Image; Width, Height : in Natural) @@ -105,15 +201,19 @@ package body FLTK.Images.RGB is + -------------- + -- Colors -- + -------------- + procedure Color_Average (This : in out RGB_Image; Col : in Color; Amount : in Blend) is begin fl_rgb_image_color_average - (This.Void_Ptr, - Interfaces.C.int (Col), - Interfaces.C.C_float (Amount)); + (This.Void_Ptr, + Interfaces.C.int (Col), + Interfaces.C.C_float (Amount)); end Color_Average; @@ -126,14 +226,31 @@ package body FLTK.Images.RGB is + ---------------- + -- Activity -- + ---------------- + + procedure Uncache + (This : in out RGB_Image) is + begin + fl_rgb_image_uncache (This.Void_Ptr); + end Uncache; + + + + + --------------- + -- Drawing -- + --------------- + procedure Draw (This : in RGB_Image; X, Y : in Integer) is begin fl_rgb_image_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); end Draw; @@ -143,13 +260,13 @@ package body FLTK.Images.RGB is CX, CY : in Integer := 0) is begin fl_rgb_image_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.int (CX), + Interfaces.C.int (CY)); end Draw; |