summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_fl_draw.cpp23
-rw-r--r--src/c_fl_draw.h7
-rw-r--r--src/fltk-draw.adb195
-rw-r--r--src/fltk-draw.ads52
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 --
-----------------------
generated by cgit (git 2.30.0) at 2024-12-22 22:28:08 +0000