diff options
| -rw-r--r-- | doc/fl_cairo_window.html | 138 | ||||
| -rw-r--r-- | doc/index.html | 3 | ||||
| -rw-r--r-- | progress.txt | 2 | ||||
| -rw-r--r-- | src/c_fl_cairo_window.cpp | 110 | ||||
| -rw-r--r-- | src/c_fl_cairo_window.h | 29 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-windows-double-cairo.adb | 221 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-windows-double-cairo.ads | 101 |
7 files changed, 602 insertions, 2 deletions
diff --git a/doc/fl_cairo_window.html b/doc/fl_cairo_window.html new file mode 100644 index 0000000..e7f2f09 --- /dev/null +++ b/doc/fl_cairo_window.html @@ -0,0 +1,138 @@ + +<!DOCTYPE html> + +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Fl_Cairo_Window Binding Map</title> + <link href="map.css" rel="stylesheet"> + </head> + + <body> + + +<h2>Fl_Cairo_Window Binding Map</h2> + + +<a href="index.html">Back to Index</a> + + +<table class="package"> + <tr><th colspan="2">Package name</th></tr> + + <tr> + <td>Fl_Cairo_Window</td> + <td>FLTK.Widgets.Groups.Windows.Double.Cairo</td> + </tr> + +</table> + + + +<table class="type"> + <tr><th colspan="2">Types</th></tr> + + <tr> + <td>Fl_Cairo_Window</td> + <td>Cairo_Window</td> + </tr> + + <tr> + <td> </td> + <td>Cairo_Window_Reference</td> + </tr> + + <tr> + <td>cairo_draw_cb</td> + <td>Cairo_Callback</td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Constructors</th></tr> + + <tr> +<td><pre> +Fl_Cairo_Window(int w, int h); +</pre></td> +<td><pre> +function Create + (W, H : in Integer) + return Cairo_Window; +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Create + (W, H : in Integer; + Text : in String := "") + return Cairo_Window; +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Cairo_Window; +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Functions and Procedures</th></tr> + + <tr> +<td> </td> +<td><pre> +function Handle + (This : in out Cairo_Window; + Event : in Event_Kind) + return Event_Outcome; +</pre></td> + </tr> + + <tr> +<td><pre> +void set_draw_cb(cairo_draw_cb cb); +</pre></td> +<td><pre> +procedure Set_Cairo_Draw + (This : in out Cairo_Window; + Func : in Cairo_Callback); +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Protected Functions and Procedures</th></tr> + + <tr> +<td><pre> +void draw(); +</pre></td> +<td><pre> +procedure Draw + (This : in out Cairo_Window); +</pre></td> + </tr> + +</table> + + + </body> +</html> + diff --git a/doc/index.html b/doc/index.html index 335bd70..cf2f5c0 100644 --- a/doc/index.html +++ b/doc/index.html @@ -27,7 +27,7 @@ <li>Fl_Browser</li> <li><a href="fl_browser_.html">Fl_Browser_</a></li> <li><a href="fl_button.html">Fl_Button</a></li> - <li>Fl_Cairo_Window</li> + <li><a href="fl_cairo_window.html">Fl_Cairo_Window</a></li> <li><a href="fl_chart.html">Fl_Chart</a></li> <li>Fl_Check_Browser</li> <li><a href="fl_check_button.html">Fl_Check_Button</a></li> @@ -197,6 +197,7 @@ <li><a href="fl_tile.html">FLTK.Widgets.Groups.Tiled</a></li> <li><a href="fl_window.html">FLTK.Widgets.Groups.Windows</a></li> <li><a href="fl_double_window.html">FLTK.Widgets.Groups.Windows.Double</a></li> + <li><a href="fl_cairo_window.html">FLTK.Widgets.Groups.Windows.Double.Cairo</a></li> <li><a href="fl_overlay_window.html">FLTK.Widgets.Groups.Windows.Double.Overlay</a></li> <li><a href="fl_gl_window.html">FLTK.Widgets.Groups.Windows.OpenGL</a></li> <li><a href="fl_single_window.html">FLTK.Widgets.Groups.Windows.Single</a></li> diff --git a/progress.txt b/progress.txt index cc9ece1..59e783c 100644 --- a/progress.txt +++ b/progress.txt @@ -80,6 +80,7 @@ FLTK.Widgets.Groups.Text_Displays.Text_Editors FLTK.Widgets.Groups.Tiled FLTK.Widgets.Groups.Windows FLTK.Widgets.Groups.Windows.Double +FLTK.Widgets.Groups.Windows.Double.Cairo FLTK.Widgets.Groups.Windows.Double.Overlay FLTK.Widgets.Groups.Windows.OpenGL FLTK.Widgets.Groups.Windows.Single @@ -137,7 +138,6 @@ FLTK.Devices.Surfaces (incomplete API, otherwise polished) To-Do: Fl_Browser -Fl_Cairo_Window Fl_Check_Browser Fl_Display_Device Fl_File_Browser diff --git a/src/c_fl_cairo_window.cpp b/src/c_fl_cairo_window.cpp new file mode 100644 index 0000000..59b03ed --- /dev/null +++ b/src/c_fl_cairo_window.cpp @@ -0,0 +1,110 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <FL/Fl_Cairo_Window.H> +#include <FL/Fl_Double_Window.H> +#include "c_fl_cairo_window.h" + + + + +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + +class My_Cairo_Window : +#ifdef FLTK_HAVE_CAIRO +public Fl_Cairo_Window +#else +public Fl_Double_Window +#endif +{ +public: +#ifdef FLTK_HAVE_CAIRO + using Fl_Cairo_Window::Fl_Cairo_Window; +#else + using Fl_Double_Window::Fl_Double_Window; +#endif + + friend void fl_cairo_window_draw(CAIROWINDOW w); + + int handle(int e); + +protected: + void draw(); +}; + + +void My_Cairo_Window::draw() { + widget_draw_hook(this->user_data()); +} + +int My_Cairo_Window::handle(int e) { + return widget_handle_hook(this->user_data(), e); +} + + + + +// Flattened C API begins here + +CAIROWINDOW new_fl_cairo_window(int x, int y, int w, int h, char * label) { + My_Cairo_Window *c = new My_Cairo_Window(x, y, w, h, label); + return c; +} + +CAIROWINDOW new_fl_cairo_window2(int w, int h, char * label) { + My_Cairo_Window *c = new My_Cairo_Window(w, h, label); + return c; +} + +CAIROWINDOW new_fl_cairo_window3(int w, int h) { + My_Cairo_Window *c = new My_Cairo_Window(w, h); + return c; +} + +void free_fl_cairo_window(CAIROWINDOW w) { + delete reinterpret_cast<My_Cairo_Window*>(w); +} + + + + +void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb) { + #ifdef FLTK_HAVE_CAIRO + reinterpret_cast<Fl_Cairo_Window*>(w)->set_draw_cb(reinterpret_cast<cairo_draw_cb>(cb)); + #else + (void)(w); + (void)(cb); + #endif +} + + + + +void fl_cairo_window_draw(CAIROWINDOW w) { + #ifdef FLTK_HAVE_CAIRO + reinterpret_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::draw(); + #else + reinterpret_cast<My_Cairo_Window*>(w)->Fl_Double_Window::draw(); + #endif +} + +int fl_cairo_window_handle(CAIROWINDOW w, int e) { + #ifdef FLTK_HAVE_CAIRO + return reinterpret_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::handle(e); + #else + return reinterpret_cast<My_Cairo_Window*>(w)->Fl_Double_Window::handle(e); + #endif +} + + diff --git a/src/c_fl_cairo_window.h b/src/c_fl_cairo_window.h new file mode 100644 index 0000000..e9a1437 --- /dev/null +++ b/src/c_fl_cairo_window.h @@ -0,0 +1,29 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_CAIRO_WINDOW_GUARD +#define FL_CAIRO_WINDOW_GUARD + + +typedef void* CAIROWINDOW; + + +extern "C" CAIROWINDOW new_fl_cairo_window(int x, int y, int w, int h, char * label); +extern "C" CAIROWINDOW new_fl_cairo_window2(int w, int h, char * label); +extern "C" CAIROWINDOW new_fl_cairo_window3(int w, int h); +extern "C" void free_fl_cairo_window(CAIROWINDOW w); + + +extern "C" void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb); + + +extern "C" void fl_cairo_window_draw(CAIROWINDOW w); +extern "C" int fl_cairo_window_handle(CAIROWINDOW w, int e); + + +#endif + + diff --git a/src/fltk-widgets-groups-windows-double-cairo.adb b/src/fltk-widgets-groups-windows-double-cairo.adb new file mode 100644 index 0000000..61ea232 --- /dev/null +++ b/src/fltk-widgets-groups-windows-double-cairo.adb @@ -0,0 +1,221 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C, + System.Address_To_Access_Conversions; + + +package body FLTK.Widgets.Groups.Windows.Double.Cairo is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_cairo_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_cairo_window, "new_fl_cairo_window"); + pragma Inline (new_fl_cairo_window); + + function new_fl_cairo_window2 + (W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_cairo_window2, "new_fl_cairo_window2"); + pragma Inline (new_fl_cairo_window2); + + function new_fl_cairo_window3 + (W, H : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Import (C, new_fl_cairo_window3, "new_fl_cairo_window3"); + pragma Inline (new_fl_cairo_window3); + + procedure free_fl_cairo_window + (W : in Storage.Integer_Address); + pragma Import (C, free_fl_cairo_window, "free_fl_cairo_window"); + pragma Inline (free_fl_cairo_window); + + + + + procedure fl_cairo_window_set_draw_cb + (W, F : in Storage.Integer_Address); + pragma Import (C, fl_cairo_window_set_draw_cb, "fl_cairo_window_set_draw_cb"); + pragma Inline (fl_cairo_window_set_draw_cb); + + + + + procedure fl_cairo_window_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_cairo_window_draw, "fl_cairo_window_draw"); + pragma Inline (fl_cairo_window_draw); + + function fl_cairo_window_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_cairo_window_handle, "fl_cairo_window_handle"); + pragma Inline (fl_cairo_window_handle); + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + package Cairo_Convert is new System.Address_To_Access_Conversions (Cairo_Window'Class); + + + procedure Cairo_Draw_Hook + (C_Addr, Cairo_Addr : in Storage.Integer_Address); + + pragma Convention (C, Cairo_Draw_Hook); + + procedure Cairo_Draw_Hook + (C_Addr, Cairo_Addr : in Storage.Integer_Address) + is + Ada_Addr : System.Address := + Storage.To_Address (fl_widget_get_user_data (C_Addr)); + Ada_Object : access Cairo_Window'Class := + Cairo_Convert.To_Pointer (Ada_Addr); + begin + if Ada_Object.My_Func /= null then + Ada_Object.My_Func (Cairo_Window (Ada_Object.all), Storage.To_Address (Cairo_Addr)); + end if; + end Cairo_Draw_Hook; + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Cairo_Window) is + begin + Extra_Final (Double_Window (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Cairo_Window) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_cairo_window (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Cairo_Window; + X, Y, W, H : in Integer; + Text : in String) is + begin + fl_cairo_window_set_draw_cb (This.Void_Ptr, Storage.To_Integer (Cairo_Draw_Hook'Address)); + Extra_Init (Double_Window (This), X, Y, W, H, Text); + end Extra_Init; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Cairo_Window is + begin + return This : Cairo_Window do + This.Void_Ptr := new_fl_cairo_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + + function Create + (W, H : in Integer; + Text : in String := "") + return Cairo_Window is + begin + return This : Cairo_Window do + This.Void_Ptr := new_fl_cairo_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); + end return; + end Create; + + + function Create + (W, H : in Integer) + return Cairo_Window is + begin + return This : Cairo_Window do + This.Void_Ptr := new_fl_cairo_window3 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + Extra_Init (This, This.Get_X, This.Get_Y, W, H, This.Get_Label); + end return; + end Create; + + end Forge; + + + + + ------------------------ + -- Cairo Window API -- + ------------------------ + + procedure Set_Cairo_Draw + (This : in out Cairo_Window; + Func : in Cairo_Callback) is + begin + This.My_Func := Func; + end Set_Cairo_Draw; + + + + + procedure Draw + (This : in out Cairo_Window) is + begin + fl_cairo_window_draw (This.Void_Ptr); + end Draw; + + + function Handle + (This : in out Cairo_Window; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_cairo_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + +end FLTK.Widgets.Groups.Windows.Double.Cairo; + + diff --git a/src/fltk-widgets-groups-windows-double-cairo.ads b/src/fltk-widgets-groups-windows-double-cairo.ads new file mode 100644 index 0000000..111f7ac --- /dev/null +++ b/src/fltk-widgets-groups-windows-double-cairo.ads @@ -0,0 +1,101 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + System; + + +package FLTK.Widgets.Groups.Windows.Double.Cairo is + + + -- If FLTK has not been built with Cairo support then + -- this will just be a duplicate of Double_Window and the + -- callback set with Set_Cairo_Draw will never be triggered. + + -- Building with Cairo support requires either of + -- 1. CMake option FLTK_OPTION_CAIRO_WINDOW + -- 2. configure -enable-cairo + -- when building FLTK itself. + + + type Cairo_Window is new Double_Window with private; + + type Cairo_Window_Reference (Data : not null access Cairo_Window'Class) is + limited null record with Implicit_Dereference => Data; + + type Cairo_Callback is access procedure + (This : in out Cairo_Window; + Context : in System.Address); + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Cairo_Window; + + function Create + (W, H : in Integer; + Text : in String := "") + return Cairo_Window; + + function Create + (W, H : in Integer) + return Cairo_Window; + + end Forge; + + + + + procedure Set_Cairo_Draw + (This : in out Cairo_Window; + Func : in Cairo_Callback); + + + + + procedure Draw + (This : in out Cairo_Window); + + function Handle + (This : in out Cairo_Window; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Cairo_Window is new Double_Window with record + My_Func : Cairo_Callback; + end record; + + overriding procedure Finalize + (This : in out Cairo_Window); + + procedure Extra_Init + (This : in out Cairo_Window; + X, Y, W, H : in Integer; + Text : in String); + + procedure Extra_Final + (This : in out Cairo_Window); + + + pragma Inline (Set_Cairo_Draw); + + pragma Inline (Draw); + pragma Inline (Handle); + + +end FLTK.Widgets.Groups.Windows.Double.Cairo; + + |