diff options
Diffstat (limited to 'body/fltk-images-pixmaps.adb')
| -rw-r--r-- | body/fltk-images-pixmaps.adb | 75 |
1 files changed, 62 insertions, 13 deletions
diff --git a/body/fltk-images-pixmaps.adb b/body/fltk-images-pixmaps.adb index 2e66d2f..8487459 100644 --- a/body/fltk-images-pixmaps.adb +++ b/body/fltk-images-pixmaps.adb @@ -6,17 +6,34 @@ with - Interfaces.C; + FLTK.Pixmap_Marshal; package body FLTK.Images.Pixmaps is + ------------------------ + -- Functions From C -- + ------------------------ + + -- Allocation -- + + function new_fl_pixmap + (D : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, new_fl_pixmap, "new_fl_pixmap"); + pragma Inline (new_fl_pixmap); + procedure free_fl_pixmap (I : in Storage.Integer_Address); pragma Import (C, free_fl_pixmap, "free_fl_pixmap"); pragma Inline (free_fl_pixmap); + + + + -- Copying -- + function fl_pixmap_copy (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) @@ -33,6 +50,8 @@ package body FLTK.Images.Pixmaps is + -- Colors -- + procedure fl_pixmap_color_average (I : in Storage.Integer_Address; C : in Interfaces.C.int; @@ -48,6 +67,8 @@ package body FLTK.Images.Pixmaps is + -- Activity -- + procedure fl_pixmap_uncache (I : in Storage.Integer_Address); pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache"); @@ -56,6 +77,8 @@ package body FLTK.Images.Pixmaps is + -- Drawing -- + procedure fl_pixmap_draw2 (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); @@ -71,10 +94,15 @@ package body FLTK.Images.Pixmaps is + ------------------- + -- Destructors -- + ------------------- + overriding procedure Finalize (This : in out Pixmap) is begin if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + Pixmap_Marshal.Free_Recursive (This.Loose_Ptr); free_fl_pixmap (This.Void_Ptr); This.Void_Ptr := Null_Pointer; end if; @@ -84,9 +112,35 @@ package body FLTK.Images.Pixmaps is -------------------- - -- Construction -- + -- Constructors -- -------------------- + package body Forge is + + function Create + (Values : in Header; + Colors : in Color_Definition_Array; + Pixels : in Pixmap_Data) + return Pixmap is + begin + return This : Pixmap do + This.Loose_Ptr := Pixmap_Marshal.Marshal_Data (Values, Colors, Pixels); + This.Void_Ptr := new_fl_pixmap + (Storage.To_Integer (This.Loose_Ptr (This.Loose_Ptr'First)'Address)); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + -- Copying -- + function Copy (This : in Pixmap; Width, Height : in Natural) @@ -113,9 +167,7 @@ package body FLTK.Images.Pixmaps is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out Pixmap; @@ -138,9 +190,7 @@ package body FLTK.Images.Pixmaps is - ---------------- -- Activity -- - ---------------- procedure Uncache (This : in out Pixmap) is @@ -151,9 +201,7 @@ package body FLTK.Images.Pixmaps is - --------------- -- Drawing -- - --------------- procedure Draw (This : in Pixmap; @@ -167,9 +215,9 @@ package body FLTK.Images.Pixmaps is procedure Draw - (This : in Pixmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is + (This : in Pixmap; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer := 0) is begin fl_pixmap_draw (This.Void_Ptr, @@ -177,10 +225,11 @@ package body FLTK.Images.Pixmaps is Interfaces.C.int (Y), Interfaces.C.int (W), Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); + Interfaces.C.int (Clip_X), + Interfaces.C.int (Clip_Y)); end Draw; end FLTK.Images.Pixmaps; + |