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 --- src/c_fl_draw.cpp | 23 +++++++ src/c_fl_draw.h | 7 ++ src/fltk-draw.adb | 195 +++++++++++++++++++++++++++++++++++++++++++++++++++++- src/fltk-draw.ads | 52 ++++++++++++++- 4 files changed, 273 insertions(+), 4 deletions(-) (limited to 'src') 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