diff options
Diffstat (limited to 'body/fltk-images-pixmaps.adb')
-rw-r--r-- | body/fltk-images-pixmaps.adb | 186 |
1 files changed, 186 insertions, 0 deletions
diff --git a/body/fltk-images-pixmaps.adb b/body/fltk-images-pixmaps.adb new file mode 100644 index 0000000..2e66d2f --- /dev/null +++ b/body/fltk-images-pixmaps.adb @@ -0,0 +1,186 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C; + + +package body FLTK.Images.Pixmaps is + + + procedure free_fl_pixmap + (I : in Storage.Integer_Address); + pragma Import (C, free_fl_pixmap, "free_fl_pixmap"); + pragma Inline (free_fl_pixmap); + + function fl_pixmap_copy + (I : in Storage.Integer_Address; + W, H : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy"); + pragma Inline (fl_pixmap_copy); + + function fl_pixmap_copy2 + (I : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2"); + pragma Inline (fl_pixmap_copy2); + + + + + procedure fl_pixmap_color_average + (I : in Storage.Integer_Address; + C : in Interfaces.C.int; + B : in Interfaces.C.C_float); + pragma Import (C, fl_pixmap_color_average, "fl_pixmap_color_average"); + pragma Inline (fl_pixmap_color_average); + + procedure fl_pixmap_desaturate + (I : in Storage.Integer_Address); + pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate"); + pragma Inline (fl_pixmap_desaturate); + + + + + procedure fl_pixmap_uncache + (I : in Storage.Integer_Address); + pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache"); + pragma Inline (fl_pixmap_uncache); + + + + + procedure fl_pixmap_draw2 + (I : in Storage.Integer_Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_pixmap_draw2, "fl_pixmap_draw2"); + pragma Inline (fl_pixmap_draw2); + + procedure fl_pixmap_draw + (I : in Storage.Integer_Address; + X, Y, W, H, CX, CY : in Interfaces.C.int); + pragma Import (C, fl_pixmap_draw, "fl_pixmap_draw"); + pragma Inline (fl_pixmap_draw); + + + + + overriding procedure Finalize + (This : in out Pixmap) is + begin + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_pixmap (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Construction -- + -------------------- + + function Copy + (This : in Pixmap; + Width, Height : in Natural) + return Pixmap'Class is + begin + return Copied : Pixmap do + Copied.Void_Ptr := fl_pixmap_copy + (This.Void_Ptr, + Interfaces.C.int (Width), + Interfaces.C.int (Height)); + end return; + end Copy; + + + function Copy + (This : in Pixmap) + return Pixmap'Class is + begin + return Copied : Pixmap do + Copied.Void_Ptr := fl_pixmap_copy2 (This.Void_Ptr); + end return; + end Copy; + + + + + -------------- + -- Colors -- + -------------- + + procedure Color_Average + (This : in out Pixmap; + Col : in Color; + Amount : in Blend) is + begin + fl_pixmap_color_average + (This.Void_Ptr, + Interfaces.C.int (Col), + Interfaces.C.C_float (Amount)); + end Color_Average; + + + procedure Desaturate + (This : in out Pixmap) is + begin + fl_pixmap_desaturate (This.Void_Ptr); + end Desaturate; + + + + + ---------------- + -- Activity -- + ---------------- + + procedure Uncache + (This : in out Pixmap) is + begin + fl_pixmap_uncache (This.Void_Ptr); + end Uncache; + + + + + --------------- + -- Drawing -- + --------------- + + procedure Draw + (This : in Pixmap; + X, Y : in Integer) is + begin + fl_pixmap_draw2 + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Draw; + + + procedure Draw + (This : in Pixmap; + X, Y, W, H : in Integer; + CX, CY : in Integer := 0) is + begin + fl_pixmap_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)); + end Draw; + + +end FLTK.Images.Pixmaps; + |