From ece14b9a9bce88245543bd7f1a3d40367276c9b5 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 5 Mar 2018 19:03:59 +1100 Subject: Added FLTK.Widgets.Groups.Wizards --- progress.txt | 2 +- src/c_fl_wizard.cpp | 106 +++++++++++++++++++++ src/c_fl_wizard.h | 37 ++++++++ src/fltk-widgets-groups-wizards.adb | 177 ++++++++++++++++++++++++++++++++++++ src/fltk-widgets-groups-wizards.ads | 58 ++++++++++++ 5 files changed, 379 insertions(+), 1 deletion(-) create mode 100644 src/c_fl_wizard.cpp create mode 100644 src/c_fl_wizard.h create mode 100644 src/fltk-widgets-groups-wizards.adb create mode 100644 src/fltk-widgets-groups-wizards.ads diff --git a/progress.txt b/progress.txt index 7b3909f..54492f6 100644 --- a/progress.txt +++ b/progress.txt @@ -39,6 +39,7 @@ FLTK.Widgets.Groups.Text_Displays.Text_Editors FLTK.Widgets.Groups.Windows.Double FLTK.Widgets.Groups.Windows.Single FLTK.Widgets.Groups.Windows.Single.Menu +FLTK.Widgets.Groups.Wizards FLTK.Widgets.Inputs.Float FLTK.Widgets.Inputs.Integer FLTK.Widgets.Inputs.Multiline @@ -107,7 +108,6 @@ FL_Table FL_Table_Row FL_Tile FL_Tree -FL_Wizard FL_Scrollbar FL_Value_Slider FL_Hor_Value_Slider diff --git a/src/c_fl_wizard.cpp b/src/c_fl_wizard.cpp new file mode 100644 index 0000000..7ed33db --- /dev/null +++ b/src/c_fl_wizard.cpp @@ -0,0 +1,106 @@ + + +#include +#include "c_fl_wizard.h" +#include "c_fl_type.h" + + + + +class My_Wizard : public Fl_Wizard { + public: + using Fl_Wizard::Fl_Wizard; + friend void wizard_set_draw_hook(WIZARD w, void * d); + friend void fl_wizard_draw(WIZARD w); + friend void wizard_set_handle_hook(WIZARD w, void * h); + friend int fl_wizard_handle(WIZARD w, int e); + protected: + void draw(); + void real_draw(); + int handle(int e); + int real_handle(int e); + d_hook_p draw_hook; + h_hook_p handle_hook; +}; + +void My_Wizard::draw() { + (*draw_hook)(this->user_data()); +} + +void My_Wizard::real_draw() { + //Fl_Wizard::draw(); + + // required because of Fl_Wizard::draw() being private + // probably a bug in FLTK? + Fl_Widget *kid = value(); + if (damage() & FL_DAMAGE_ALL) { + if (kid) { + draw_box(box(), x(), y(), w(), h(), kid->color()); + draw_child(*kid); + } else { + draw_box(box(), x(), y(), w(), h(), color()); + } + } else if (kid) { + update_child(*kid); + } +} + +int My_Wizard::handle(int e) { + return (*handle_hook)(this->user_data(), e); +} + +int My_Wizard::real_handle(int e) { + return Fl_Wizard::handle(e); +} + +void wizard_set_draw_hook(WIZARD w, void * d) { + reinterpret_cast(w)->draw_hook = reinterpret_cast(d); +} + +void fl_wizard_draw(WIZARD w) { + reinterpret_cast(w)->real_draw(); +} + +void wizard_set_handle_hook(WIZARD w, void * h) { + reinterpret_cast(w)->handle_hook = reinterpret_cast(h); +} + +int fl_wizard_handle(WIZARD w, int e) { + return reinterpret_cast(w)->real_handle(e); +} + + + + +WIZARD new_fl_wizard(int x, int y, int w, int h, char* label) { + My_Wizard *g = new My_Wizard(x, y, w, h, label); + return g; +} + +void free_fl_wizard(WIZARD w) { + delete reinterpret_cast(w); +} + + + + +void fl_wizard_next(WIZARD w) { + reinterpret_cast(w)->next(); +} + +void fl_wizard_prev(WIZARD w) { + reinterpret_cast(w)->prev(); +} + + + + +void * fl_wizard_get_visible(WIZARD w) { + return reinterpret_cast(w)->value(); +} + +void fl_wizard_set_visible(WIZARD w, void * i) { + reinterpret_cast(w)->value(reinterpret_cast(i)); +} + + diff --git a/src/c_fl_wizard.h b/src/c_fl_wizard.h new file mode 100644 index 0000000..2068683 --- /dev/null +++ b/src/c_fl_wizard.h @@ -0,0 +1,37 @@ + + +#ifndef FL_WIZARD_GUARD +#define FL_WIZARD_GUARD + + + + +typedef void* WIZARD; + + + + +extern "C" void wizard_set_draw_hook(WIZARD w, void * d); +extern "C" void fl_wizard_draw(WIZARD w); +extern "C" void wizard_set_handle_hook(WIZARD w, void * h); +extern "C" int fl_wizard_handle(WIZARD w, int e); + + + + +extern "C" WIZARD new_fl_wizard(int x, int y, int w, int h, char* label); +extern "C" void free_fl_wizard(WIZARD w); + + + + +extern "C" void fl_wizard_next(WIZARD w); +extern "C" void fl_wizard_prev(WIZARD w); + + +extern "C" void * fl_wizard_get_visible(WIZARD w); +extern "C" void fl_wizard_set_visible(WIZARD w, void * i); + + +#endif + diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb new file mode 100644 index 0000000..ff9bc92 --- /dev/null +++ b/src/fltk-widgets-groups-wizards.adb @@ -0,0 +1,177 @@ + + +with + + Interfaces.C, + System; + +use type + + System.Address; + + +package body FLTK.Widgets.Groups.Wizards is + + + procedure wizard_set_draw_hook + (W, D : in System.Address); + pragma Import (C, wizard_set_draw_hook, "wizard_set_draw_hook"); + + procedure wizard_set_handle_hook + (W, H : in System.Address); + pragma Import (C, wizard_set_handle_hook, "wizard_set_handle_hook"); + + + + + function new_fl_wizard + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_wizard, "new_fl_wizard"); + + procedure free_fl_wizard + (S : in System.Address); + pragma Import (C, free_fl_wizard, "free_fl_wizard"); + + + + + procedure fl_wizard_next + (W : in System.Address); + pragma Import (C, fl_wizard_next, "fl_wizard_next"); + + procedure fl_wizard_prev + (W : in System.Address); + pragma Import (C, fl_wizard_prev, "fl_wizard_prev"); + + + + + function fl_wizard_get_visible + (W : in System.Address) + return System.Address; + pragma Import (C, fl_wizard_get_visible, "fl_wizard_get_visible"); + + procedure fl_wizard_set_visible + (W, I : in System.Address); + pragma Import (C, fl_wizard_set_visible, "fl_wizard_set_visible"); + + + + + procedure fl_wizard_draw + (W : in System.Address); + pragma Import (C, fl_wizard_draw, "fl_wizard_draw"); + + function fl_wizard_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_wizard_handle, "fl_wizard_handle"); + + + + + procedure Finalize + (This : in out Wizard) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Wizard'Class + then + This.Clear; + free_fl_wizard (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Group (This)); + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Wizard is + begin + return This : Wizard do + This.Void_Ptr := new_fl_wizard + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + wizard_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); + wizard_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + end return; + end Create; + + + + + procedure Next + (This : in out Wizard) is + begin + fl_wizard_next (This.Void_Ptr); + end Next; + + + procedure Prev + (This : in out Wizard) is + begin + fl_wizard_prev (This.Void_Ptr); + end Prev; + + + + + function Get_Visible + (This : in Wizard) + return access Widget'Class + is + Widget_Ptr : System.Address := + fl_wizard_get_visible (This.Void_Ptr); + Actual_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + begin + return Actual_Widget; + end Get_Visible; + + + procedure Set_Visible + (This : in out Wizard; + Item : access Widget'Class) is + begin + if Item = null then + fl_wizard_set_visible (This.Void_Ptr, System.Null_Address); + else + fl_wizard_set_visible (This.Void_Ptr, Item.Void_Ptr); + end if; + end Set_Visible; + + + + + procedure Draw + (This : in out Wizard) is + begin + fl_wizard_draw (This.Void_Ptr); + end Draw; + + + function Handle + (This : in out Wizard; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_wizard_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + +end FLTK.Widgets.Groups.Wizards; + diff --git a/src/fltk-widgets-groups-wizards.ads b/src/fltk-widgets-groups-wizards.ads new file mode 100644 index 0000000..63221db --- /dev/null +++ b/src/fltk-widgets-groups-wizards.ads @@ -0,0 +1,58 @@ + + +package FLTK.Widgets.Groups.Wizards is + + + type Wizard is new Group with private; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Wizard; + + + + + procedure Next + (This : in out Wizard); + + procedure Prev + (This : in out Wizard); + + + + + function Get_Visible + (This : in Wizard) + return access Widget'Class; + + procedure Set_Visible + (This : in out Wizard; + Item : access Widget'Class); + + + + + procedure Draw + (This : in out Wizard); + + function Handle + (This : in out Wizard; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Wizard is new Group with null record; + + overriding procedure Finalize + (This : in out Wizard); + + +end FLTK.Widgets.Groups.Wizards; + -- cgit