A few more Fl_Draw functions bound

4 files changed, 273 insertions, 4 deletions

diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp
index f8a5303..4c63f77 100644
--- a/src/c_fl_draw.cpp
+++ b/src/c_fl_draw.cpp
@@ -196,6 +196,29 @@ void fl_draw_vertex(double x, double y) {
 
 
 
+void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l) {
+    fl_draw_image(reinterpret_cast<uchar*>(data), x, y, w, h, d, l);
+}
+
+void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d) {
+    fl_draw_image(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d);
+}
+
+void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l) {
+    fl_draw_image_mono(reinterpret_cast<uchar*>(data), x, y, w, h, d, l);
+}
+
+void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d) {
+    fl_draw_image_mono(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d);
+}
+
+void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha) {
+    return fl_read_image(reinterpret_cast<uchar*>(data), x, y, w, h, alpha);
+}
+
+
+
+
 typedef void (sym_hook)(Fl_Color);
 typedef sym_hook* sym_hook_p;
 
diff --git a/src/c_fl_draw.h b/src/c_fl_draw.h
index dec536c..74c0d00 100644
--- a/src/c_fl_draw.h
+++ b/src/c_fl_draw.h
@@ -62,6 +62,13 @@ extern "C" void fl_draw_translate(double x, double y);
 extern "C" void fl_draw_vertex(double x, double y);
 
 
+extern "C" void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l);
+extern "C" void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d);
+extern "C" void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l);
+extern "C" void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d);
+extern "C" void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha);
+
+
 extern "C" int fl_draw_add_symbol(const char *name, void *func, int scalable);
 extern "C" void fl_draw_draw_text(const char *str, int n, int x, int y);
 extern "C" void fl_draw_draw_text2(const char *str, int x, int y, int w, int h,
diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb
index 626e017..4c17674 100644
--- a/src/fltk-draw.adb
+++ b/src/fltk-draw.adb
@@ -9,7 +9,8 @@ with
 use type
 
     Interfaces.C.int,
-    Interfaces.C.size_t;
+    Interfaces.C.size_t,
+    System.Address;
 
 
 package body FLTK.Draw is
@@ -263,6 +264,43 @@ package body FLTK.Draw is
 
 
 
+    procedure fl_draw_draw_image
+           (Buf        : in System.Address;
+            X, Y, W, H : in Interfaces.C.int;
+            D, L       : in Interfaces.C.int);
+    pragma Import (C, fl_draw_draw_image, "fl_draw_draw_image");
+    pragma Inline (fl_draw_draw_image);
+
+    procedure fl_draw_draw_image2
+           (Call, User    : in System.Address;
+            X, Y, W, H, D : in Interfaces.C.int);
+    pragma Import (C, fl_draw_draw_image2, "fl_draw_draw_image2");
+    pragma Inline (fl_draw_draw_image2);
+
+    procedure fl_draw_draw_image_mono
+           (Buf        : in System.Address;
+            X, Y, W, H : in Interfaces.C.int;
+            D, L       : in Interfaces.C.int);
+    pragma Import (C, fl_draw_draw_image_mono, "fl_draw_draw_image_mono");
+    pragma Inline (fl_draw_draw_image_mono);
+
+    procedure fl_draw_draw_image_mono2
+           (Call, User    : in System.Address;
+            X, Y, W, H, D : in Interfaces.C.int);
+    pragma Import (C, fl_draw_draw_image_mono2, "fl_draw_draw_image_mono2");
+    pragma Inline (fl_draw_draw_image_mono2);
+
+    function fl_draw_read_image
+           (Buf        : in System.Address;
+            X, Y, W, H : in Interfaces.C.int;
+            Alpha      : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, fl_draw_read_image, "fl_draw_read_image");
+    pragma Inline (fl_draw_read_image);
+
+
+
+
     function fl_draw_add_symbol
            (Name     : in Interfaces.C.char_array;
             Drawit   : in System.Address;
@@ -1027,6 +1065,161 @@ package body FLTK.Draw is
 
 
 
+    ---------------------
+    --  Image Drawing  --
+    ---------------------
+
+    procedure Draw_Image
+           (X, Y, W, H      : in Integer;
+            Data            : in Color_Component_Array;
+            Depth           : in Positive := 3;
+            Line_Data       : in Natural := 0;
+            Flip_Horizontal : in Boolean := False;
+            Flip_Vertical   : in Boolean := False)
+    is
+        Real_Depth : Integer := Depth;
+        Real_Line_Data : Integer := Line_Data;
+    begin
+        if Flip_Horizontal then
+            Real_Depth := Real_Depth * (-1);
+        end if;
+        if Flip_Vertical then
+            if Real_Line_Data = 0 then
+                Real_Line_Data := W * Depth * (-1);
+            else
+                Real_Line_Data := Real_Line_Data * (-1);
+            end if;
+        end if;
+        fl_draw_draw_image
+           (Data (Data'First)'Address,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.int (Real_Depth),
+            Interfaces.C.int (Real_Line_Data));
+    end Draw_Image;
+
+
+    Image_Func_Ptr : Image_Draw_Function;
+
+    procedure Draw_Image_Hook
+           (User    : in System.Address;
+            X, Y, W : in Interfaces.C.int;
+            Buf_Ptr : in System.Address)
+    is
+        Data_Buffer : Color_Component_Array (1 .. Integer (W));
+        for Data_Buffer'Address use Buf_Ptr;
+        pragma Import (Ada, Data_Buffer);
+    begin
+        Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer);
+    end Draw_Image_Hook;
+
+    procedure Draw_Image
+           (X, Y, W, H : in Integer;
+            Callback   : in Image_Draw_Function;
+            Depth      : in Positive := 3) is
+    begin
+        Image_Func_Ptr := Callback;
+        fl_draw_draw_image2
+           (Draw_Image_Hook'Address,
+            System.Null_Address,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.int (Depth));
+    end Draw_Image;
+
+
+    procedure Draw_Image_Mono
+           (X, Y, W, H      : in Integer;
+            Data            : in Color_Component_Array;
+            Depth           : in Positive := 1;
+            Line_Data       : in Natural := 0;
+            Flip_Horizontal : Boolean := False;
+            Flip_Vertical   : Boolean := False)
+    is
+        Real_Depth : Integer := Depth;
+        Real_Line_Data : Integer := Line_Data;
+    begin
+        if Flip_Horizontal then
+            Real_Depth := Real_Depth * (-1);
+        end if;
+        if Flip_Vertical then
+            if Real_Line_Data = 0 then
+                Real_Line_Data := W * Depth * (-1);
+            else
+                Real_Line_Data := Real_Line_Data * (-1);
+            end if;
+        end if;
+        fl_draw_draw_image_mono
+           (Data (Data'First)'Address,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.int (Real_Depth),
+            Interfaces.C.int (Real_Line_Data));
+    end Draw_Image_Mono;
+
+
+    Mono_Image_Func_Ptr : Image_Draw_Function;
+
+    procedure Draw_Image_Mono_Hook
+           (User    : in System.Address;
+            X, Y, W : in Interfaces.C.int;
+            Buf_Ptr : in System.Address)
+    is
+        Data_Buffer : Color_Component_Array (1 .. Integer (W));
+        for Data_Buffer'Address use Buf_Ptr;
+        pragma Import (Ada, Data_Buffer);
+    begin
+        Mono_Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer);
+    end Draw_Image_Mono_Hook;
+
+    procedure Draw_Image_Mono
+           (X, Y, W, H : in Integer;
+            Callback   : in Image_Draw_Function;
+            Depth      : in Positive := 1) is
+    begin
+        Mono_Image_Func_Ptr := Callback;
+        fl_draw_draw_image_mono2
+           (Draw_Image_Mono_Hook'Address,
+            System.Null_Address,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.int (Depth));
+    end Draw_Image_Mono;
+
+
+    function Read_Image
+           (X, Y, W, H : in Integer;
+            Alpha      : in Integer := 0)
+        return Color_Component_Array
+    is
+        My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4);
+        Result : Color_Component_Array (1 .. My_Len);
+        Buffer : System.Address;
+    begin
+        Buffer := fl_draw_read_image
+           (Result (Result'First)'Address,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Interfaces.C.int (Alpha));
+        if Buffer /= Result (Result'First)'Address then
+            raise Program_Error;
+        end if;
+        return Result;
+    end Read_Image;
+
+
+
+
     -----------------------
     --  Special Drawing  --
     -----------------------
diff --git a/src/fltk-draw.ads b/src/fltk-draw.ads
index 004463a..b4e14ee 100644
--- a/src/fltk-draw.ads
+++ b/src/fltk-draw.ads
@@ -43,13 +43,17 @@ package FLTK.Draw is
 
     Empty_Dashes : constant Dash_Gap_Array (1 .. 0) := (others => (1, 1));
 
-    type Text_Draw_Function is access procedure
-           (X, Y : in Integer;
-            Text : in String);
+    type Image_Draw_Function is access procedure
+           (X, Y : in     Natural;
+            Data :    out Color_Component_Array);
 
     type Symbol_Draw_Function is access procedure
            (Hue : in Color);
 
+    type Text_Draw_Function is access procedure
+           (X, Y : in Integer;
+            Text : in String);
+
     type Area_Draw_Function is access procedure
            (X, Y, W, H : in Integer);
 
@@ -255,6 +259,48 @@ package FLTK.Draw is
 
 
 
+    ---------------------
+    --  Image Drawing  --
+    ---------------------
+
+    procedure Draw_Image
+           (X, Y, W, H      : in Integer;
+            Data            : in Color_Component_Array;
+            Depth           : in Positive := 3;
+            Line_Data       : in Natural := 0;
+            Flip_Horizontal : in Boolean := False;
+            Flip_Vertical   : in Boolean := False);
+
+    procedure Draw_Image
+           (X, Y, W, H : in Integer;
+            Callback   : in Image_Draw_Function;
+            Depth      : in Positive := 3);
+
+    procedure Draw_Image_Mono
+           (X, Y, W, H      : in Integer;
+            Data            : in Color_Component_Array;
+            Depth           : in Positive := 1;
+            Line_Data       : in Natural := 0;
+            Flip_Horizontal : Boolean := False;
+            Flip_Vertical   : Boolean := False);
+
+    procedure Draw_Image_Mono
+           (X, Y, W, H : in Integer;
+            Callback   : in Image_Draw_Function;
+            Depth      : in Positive := 1);
+
+    function Read_Image
+           (X, Y, W, H : in Integer;
+            Alpha      : in Integer := 0)
+        return Color_Component_Array
+    with Post =>
+           (if Alpha = 0
+            then Read_Image'Result'Length = W * H * 3
+            else Read_Image'Result'Length = W * H * 4);
+
+
+
+
     -----------------------
     --  Special Drawing  --
     -----------------------