From de0f3b8bbb85d9c5d5a226e761f658ee2e0d697b Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 25 Feb 2024 20:00:47 +1300 Subject: A few more Fl_Draw functions bound --- doc/fl_draw.html | 61 ++++++++++++----- src/c_fl_draw.cpp | 23 +++++++ src/c_fl_draw.h | 7 ++ src/fltk-draw.adb | 195 +++++++++++++++++++++++++++++++++++++++++++++++++++++- src/fltk-draw.ads | 52 ++++++++++++++- 5 files changed, 317 insertions(+), 21 deletions(-) diff --git a/doc/fl_draw.html b/doc/fl_draw.html index 71da104..654d586 100644 --- a/doc/fl_draw.html +++ b/doc/fl_draw.html @@ -91,7 +91,8 @@ 
-int fl_add_symbol(const char *name, void(*drawit)(Fl_Color), int scalable);
+int fl_add_symbol(const char *name, void(*drawit)(Fl_Color),
+    int scalable);
 
 procedure Add_Symbol
@@ -215,18 +216,14 @@ function Clip_Box
 
 Fl_Region fl_clip_region();
 

-
-
-

+Left unbound due to being OS-specific
   
 
   
 
 void fl_clip_region(Fl_Region r);
 

-
-
-

+Left unbound due to being OS-specific
   
 
   
@@ -403,7 +400,13 @@ void fl_draw_image(const uchar *buf, int X, int Y,
     int W, int H, int D=3, int L=0);
 
-
+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);
@@ -413,7 +416,10 @@ void fl_draw_image(Fl_Draw_Image_Cb cb, void *data, int X, int Y, int W, int H, int D=3); 
-
+procedure Draw_Image
+       (X, Y, W, H : in Integer;
+        Callback   : in Image_Draw_Function;
+        Depth      : in Positive := 3);
@@ -423,7 +429,13 @@ void fl_draw_image_mono(const uchar *buf, int X, int Y, int W, int H, int D=1, int L=0); 
-
+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);
@@ -433,7 +445,10 @@ void fl_draw_image_mono(Fl_Draw_Image_Cb cb, void *data, int X, int Y, int W, int H, int D=1); 
-
+procedure Draw_Image_Mono
+       (X, Y, W, H : in Integer;
+        Callback   : in Image_Draw_Function;
+        Depth      : in Positive := 1);
@@ -674,7 +689,8 @@ procedure Outline 
-void fl_loop(int x, int y, int x1, int y1, int x2, int y2, int x3, int y3);
+void fl_loop(int x, int y, int x1, int y1,
+    int x2, int y2, int x3, int y3);
 
 procedure Outline
@@ -870,10 +886,18 @@ procedure Push_No_Clip;
 
   
 
-uchar * fl_read_image(uchar *p, int X, int Y, int W, int H, int alpha=0);
+uchar * fl_read_image(uchar *p, int X, int Y, int W, int H,
+    int alpha=0);
 

 
-
+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);
 

   
 
@@ -1035,7 +1059,8 @@ procedure Set_Status
 
 const char * fl_shortcut_label(unsigned int shortcut);
 
-const char * fl_shortcut_label(unsigned int shortcut, const char **eom);
+const char * fl_shortcut_label(unsigned int shortcut,
+    const char **eom);
 

 
 function Shortcut_Label
@@ -1056,9 +1081,11 @@ function Get_Font_Size
 
   
 
-void fl_text_extents(const char *, int &dx, int &dy, int &w, int &h);
+void fl_text_extents(const char *,
+    int &dx, int &dy, int &w, int &h);
 
-void fl_text_extents(const char *t, int n, int &dx, int &dy, int &w, int &h);
+void fl_text_extents(const char *t, int n,
+    int &dx, int &dy, int &w, int &h);
 

 
 procedure Text_Extents
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(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(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(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(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(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  --
     -----------------------
-- 
cgit