diff options
-rw-r--r-- | doc/fl_draw.html | 61 | ||||
-rw-r--r-- | src/c_fl_draw.cpp | 23 | ||||
-rw-r--r-- | src/c_fl_draw.h | 7 | ||||
-rw-r--r-- | src/fltk-draw.adb | 195 | ||||
-rw-r--r-- | 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 @@ <tr> <td><pre> -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); </pre></td> <td><pre> procedure Add_Symbol @@ -215,18 +216,14 @@ function Clip_Box <td><pre> Fl_Region fl_clip_region(); </pre></td> -<td><pre> - -</pre></td> +<td>Left unbound due to being OS-specific</td> </tr> <tr> <td><pre> void fl_clip_region(Fl_Region r); </pre></td> -<td><pre> - -</pre></td> +<td>Left unbound due to being OS-specific</td> </tr> <tr> @@ -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); </pre></td> <td><pre> - +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); </pre></td> </tr> @@ -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); </pre></td> <td><pre> - +procedure Draw_Image + (X, Y, W, H : in Integer; + Callback : in Image_Draw_Function; + Depth : in Positive := 3); </pre></td> </tr> @@ -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); </pre></td> <td><pre> - +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); </pre></td> </tr> @@ -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); </pre></td> <td><pre> - +procedure Draw_Image_Mono + (X, Y, W, H : in Integer; + Callback : in Image_Draw_Function; + Depth : in Positive := 1); </pre></td> </tr> @@ -674,7 +689,8 @@ procedure Outline <tr> <td><pre> -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); </pre></td> <td><pre> procedure Outline @@ -870,10 +886,18 @@ procedure Push_No_Clip; <tr> <td><pre> -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); </pre></td> <td><pre> - +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); </pre></td> </tr> @@ -1035,7 +1059,8 @@ procedure Set_Status <td><pre> 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); </pre></td> <td><pre> function Shortcut_Label @@ -1056,9 +1081,11 @@ function Get_Font_Size <tr> <td><pre> -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); </pre></td> <td><pre> 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<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 -- ----------------------- |