diff options
Diffstat (limited to 'src')
121 files changed, 6871 insertions, 0 deletions
diff --git a/src/c_fl.cpp b/src/c_fl.cpp new file mode 100644 index 0000000..b628c41 --- /dev/null +++ b/src/c_fl.cpp @@ -0,0 +1,10 @@ + + +#include <FL/Fl.H> +#include "c_fl.h" + + +int fl_run(void) { + return Fl::run(); +} + diff --git a/src/c_fl.h b/src/c_fl.h new file mode 100644 index 0000000..69e2e72 --- /dev/null +++ b/src/c_fl.h @@ -0,0 +1,11 @@ + + +#ifndef FL_GUARD +#define FL_GUARD + + +extern "C" int fl_run(void); + + +#endif + diff --git a/src/c_fl_box.cpp b/src/c_fl_box.cpp new file mode 100644 index 0000000..eeee320 --- /dev/null +++ b/src/c_fl_box.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Box.H> +#include "c_fl_box.h" + + +BOX new_fl_box(int x, int y, int w, int h, char* label) { + Fl_Box *b = new Fl_Box(x, y, w, h, label); + return b; +} + + +void free_fl_box(BOX b) { + delete reinterpret_cast<Fl_Box*>(b); +} + diff --git a/src/c_fl_box.h b/src/c_fl_box.h new file mode 100644 index 0000000..df7b629 --- /dev/null +++ b/src/c_fl_box.h @@ -0,0 +1,15 @@ + + +#ifndef FL_BOX_GUARD +#define FL_BOX_GUARD + + +typedef void* BOX; + + +extern "C" BOX new_fl_box(int x, int y, int w, int h, char * label); +extern "C" void free_fl_box(BOX b); + + +#endif + diff --git a/src/c_fl_button.cpp b/src/c_fl_button.cpp new file mode 100644 index 0000000..621656c --- /dev/null +++ b/src/c_fl_button.cpp @@ -0,0 +1,31 @@ + + +#include <FL/Fl_Button.H> +#include "c_fl_button.h" + + +BUTTON new_fl_button(int x, int y, int w, int h, char* label) { + Fl_Button *b = new Fl_Button(x, y, w, h, label); + return b; +} + + +void free_fl_button(BUTTON b) { + delete reinterpret_cast<Fl_Button*>(b); +} + + +int fl_button_get_state(BUTTON b) { + return reinterpret_cast<Fl_Button*>(b)->value(); +} + + +void fl_button_set_state(BUTTON b, int s) { + reinterpret_cast<Fl_Button*>(b)->value(s); +} + + +void fl_button_set_only(BUTTON b) { + reinterpret_cast<Fl_Button*>(b)->setonly(); +} + diff --git a/src/c_fl_button.h b/src/c_fl_button.h new file mode 100644 index 0000000..239689a --- /dev/null +++ b/src/c_fl_button.h @@ -0,0 +1,19 @@ + + +#ifndef FL_BUTTON_GUARD +#define FL_BUTTON_GUARD + + +typedef void* BUTTON; + + +extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_button(BUTTON b); + +extern "C" int fl_button_get_state(BUTTON b); +extern "C" void fl_button_set_state(BUTTON b, int s); +extern "C" void fl_button_set_only(BUTTON b); + + +#endif + diff --git a/src/c_fl_check_button.cpp b/src/c_fl_check_button.cpp new file mode 100644 index 0000000..e737942 --- /dev/null +++ b/src/c_fl_check_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Check_Button.H> +#include "c_fl_check_button.h" + + +CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label) { + Fl_Check_Button *b = new Fl_Check_Button(x, y, w, h, label); + return b; +} + + +void free_fl_check_button(CHECKBUTTON b) { + delete reinterpret_cast<Fl_Check_Button*>(b); +} + diff --git a/src/c_fl_check_button.h b/src/c_fl_check_button.h new file mode 100644 index 0000000..f44b5ec --- /dev/null +++ b/src/c_fl_check_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_CHECK_BUTTON_GUARD +#define FL_CHECK_BUTTON_GUARD + + +typedef void* CHECKBUTTON; + + +extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_check_button(CHECKBUTTON b); + + +#endif + diff --git a/src/c_fl_dialog.cpp b/src/c_fl_dialog.cpp new file mode 100644 index 0000000..cb6d305 --- /dev/null +++ b/src/c_fl_dialog.cpp @@ -0,0 +1,32 @@ + + +#include <FL/fl_ask.H> +#include <FL/Fl_File_Chooser.H> +#include <FL/Fl_Color_Chooser.H> +#include "c_fl_dialog.h" + + +void dialog_fl_alert(const char * m) { + fl_alert(m); +} + + +int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c) { + return fl_choice(m, a, b, c); +} + + +char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r) { + return fl_file_chooser(m, p, d, r); +} + + +const char * dialog_fl_input(const char * m, const char * d) { + return fl_input(m, d); +} + + +void dialog_fl_message(const char * m) { + fl_message(m); +} + diff --git a/src/c_fl_dialog.h b/src/c_fl_dialog.h new file mode 100644 index 0000000..6804022 --- /dev/null +++ b/src/c_fl_dialog.h @@ -0,0 +1,15 @@ + + +#ifndef FL_DIALOG_GUARD +#define FL_DIALOG_GUARD + + +extern "C" void dialog_fl_alert(const char * m); +extern "C" int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c); +extern "C" char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r); +extern "C" const char * dialog_fl_input(const char * m, const char * d); +extern "C" void dialog_fl_message(const char * m); + + +#endif + diff --git a/src/c_fl_double_window.cpp b/src/c_fl_double_window.cpp new file mode 100644 index 0000000..7f29af8 --- /dev/null +++ b/src/c_fl_double_window.cpp @@ -0,0 +1,32 @@ + + +#include <FL/Fl_Double_Window.H> +#include "c_fl_double_window.h" + + +DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label) { + Fl_Double_Window *d = new Fl_Double_Window(x, y, w, h, label); + return d; +} + + +DOUBLEWINDOW new_fl_double_window2(int w, int h) { + Fl_Double_Window *d = new Fl_Double_Window(w, h); + return d; +} + + +void free_fl_double_window(DOUBLEWINDOW d) { + delete reinterpret_cast<Fl_Double_Window*>(d); +} + + +void fl_double_window_show(DOUBLEWINDOW d) { + reinterpret_cast<Fl_Double_Window*>(d)->show(); +} + + +void fl_double_window_hide(DOUBLEWINDOW d) { + reinterpret_cast<Fl_Double_Window*>(d)->hide(); +} + diff --git a/src/c_fl_double_window.h b/src/c_fl_double_window.h new file mode 100644 index 0000000..3be3588 --- /dev/null +++ b/src/c_fl_double_window.h @@ -0,0 +1,19 @@ + + +#ifndef FL_DOUBLE_WINDOW_GUARD +#define FL_DOUBLE_WINDOW_GUARD + + +typedef void* DOUBLEWINDOW; + + +extern "C" DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label); +extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h); +extern "C" void free_fl_double_window(DOUBLEWINDOW d); + +extern "C" void fl_double_window_show(DOUBLEWINDOW d); +extern "C" void fl_double_window_hide(DOUBLEWINDOW d); + + +#endif + diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp new file mode 100644 index 0000000..9ea2764 --- /dev/null +++ b/src/c_fl_group.cpp @@ -0,0 +1,69 @@ + + +#include <FL/Fl_Group.H> +#include <FL/Fl_Widget.H> +#include "c_fl_group.h" +#include "c_fl_widget.h" + + +GROUP new_fl_group(int x, int y, int w, int h, char* label) { + Fl_Group *g = new Fl_Group(x, y, w, h, label); + return g; +} + + +void free_fl_group(GROUP g) { + delete reinterpret_cast<Fl_Group*>(g); +} + + + + +void fl_group_end(GROUP g) { + reinterpret_cast<Fl_Group*>(g)->end(); +} + + + + +void fl_group_add(GROUP g, WIDGET item) { + reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); +} + + +int fl_group_find(GROUP g, WIDGET item) { + return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); +} + + +void fl_group_insert(GROUP g, WIDGET item, int place) { + reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); +} + + +void fl_group_remove(GROUP g, WIDGET item) { + reinterpret_cast<Fl_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item)); +} + + +void fl_group_remove2(GROUP g, int place) { + reinterpret_cast<Fl_Group*>(g)->remove(place); +} + + +void fl_group_resizable(GROUP g, WIDGET item) { + reinterpret_cast<Fl_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item)); +} + + + + +int fl_group_children(GROUP g) { + return reinterpret_cast<Fl_Group*>(g)->children(); +} + + +void * fl_group_child(GROUP g, int place) { + return reinterpret_cast<Fl_Group*>(g)->child(place); +} + diff --git a/src/c_fl_group.h b/src/c_fl_group.h new file mode 100644 index 0000000..9b58f8c --- /dev/null +++ b/src/c_fl_group.h @@ -0,0 +1,29 @@ + + +#ifndef FL_GROUP_GUARD +#define FL_GROUP_GUARD + +#include "c_fl_widget.h" + + +typedef void* GROUP; + + +extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); +extern "C" void free_fl_group(GROUP g); + +extern "C" void fl_group_end(GROUP g); + +extern "C" void fl_group_add(GROUP g, WIDGET item); +extern "C" int fl_group_find(GROUP g, WIDGET item); +extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); +extern "C" void fl_group_remove(GROUP g, WIDGET item); +extern "C" void fl_group_remove2(GROUP g, int place); +extern "C" void fl_group_resizable(GROUP g, WIDGET item); + +extern "C" int fl_group_children(GROUP g); +extern "C" void * fl_group_child(GROUP g, int place); + + +#endif + diff --git a/src/c_fl_image.cpp b/src/c_fl_image.cpp new file mode 100644 index 0000000..8222392 --- /dev/null +++ b/src/c_fl_image.cpp @@ -0,0 +1,33 @@ + + +#include <FL/Fl_Image.H> +#include "c_fl_image.h" + + +IMAGE new_fl_image(int w, int h, int d) { + Fl_Image *i = new Fl_Image(w, h, d); + return i; +} + + +void free_fl_image(IMAGE i) { + delete reinterpret_cast<Fl_Image*>(i); +} + + + + +int fl_image_w(IMAGE i) { + return reinterpret_cast<Fl_Image*>(i)->w(); +} + + +int fl_image_h(IMAGE i) { + return reinterpret_cast<Fl_Image*>(i)->h(); +} + + +int fl_image_d(IMAGE i) { + return reinterpret_cast<Fl_Image*>(i)->d(); +} + diff --git a/src/c_fl_image.h b/src/c_fl_image.h new file mode 100644 index 0000000..a4be6df --- /dev/null +++ b/src/c_fl_image.h @@ -0,0 +1,20 @@ + + +#ifndef FL_IMAGE_GUARD +#define FL_IMAGE_GUARD + + +typedef void* IMAGE; + + +extern "C" IMAGE new_fl_image(int w, int h, int d); +extern "C" void free_fl_image(IMAGE i); + + +extern "C" int fl_image_w(IMAGE i); +extern "C" int fl_image_h(IMAGE i); +extern "C" int fl_image_d(IMAGE i); + + +#endif + diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp new file mode 100644 index 0000000..4f19bd1 --- /dev/null +++ b/src/c_fl_input.cpp @@ -0,0 +1,21 @@ + + +#include <FL/Fl_Input.H> +#include "c_fl_input.h" + + +INPUT new_fl_input(int x, int y, int w, int h, char* label) { + Fl_Input *i = new Fl_Input(x, y, w, h, label); + return i; +} + + +void free_fl_input(INPUT i) { + delete reinterpret_cast<Fl_Input*>(i); +} + + +const char * fl_input_get_value(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->value(); +} + diff --git a/src/c_fl_input.h b/src/c_fl_input.h new file mode 100644 index 0000000..cb40d42 --- /dev/null +++ b/src/c_fl_input.h @@ -0,0 +1,18 @@ + + +#ifndef FL_INPUT_GUARD +#define FL_INPUT_GUARD + + +typedef void* INPUT; + + +extern "C" INPUT new_fl_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_input(INPUT i); + + +extern "C" const char * fl_input_get_value(INPUT i); + + +#endif + diff --git a/src/c_fl_int_input.cpp b/src/c_fl_int_input.cpp new file mode 100644 index 0000000..2224857 --- /dev/null +++ b/src/c_fl_int_input.cpp @@ -0,0 +1,21 @@ + + +#include <FL/Fl_Int_Input.H> +#include "c_fl_int_input.h" + + +INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label) { + Fl_Int_Input *i = new Fl_Int_Input(x, y, w, h, label); + return i; +} + + +void free_fl_int_input(INT_INPUT i) { + delete reinterpret_cast<Fl_Int_Input*>(i); +} + + +const char * fl_int_input_get_value(INT_INPUT i) { + return reinterpret_cast<Fl_Int_Input*>(i)->value(); +} + diff --git a/src/c_fl_int_input.h b/src/c_fl_int_input.h new file mode 100644 index 0000000..5d99c3f --- /dev/null +++ b/src/c_fl_int_input.h @@ -0,0 +1,18 @@ + + +#ifndef FL_INT_INPUT_GUARD +#define FL_INT_INPUT_GUARD + + +typedef void* INT_INPUT; + + +extern "C" INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_int_input(INT_INPUT i); + + +extern "C" const char * fl_int_input_get_value(INT_INPUT i); + + +#endif + diff --git a/src/c_fl_light_button.cpp b/src/c_fl_light_button.cpp new file mode 100644 index 0000000..daa99ef --- /dev/null +++ b/src/c_fl_light_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Light_Button.H> +#include "c_fl_light_button.h" + + +LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label) { + Fl_Light_Button *b = new Fl_Light_Button(x, y, w, h, label); + return b; +} + + +void free_fl_light_button(LIGHTBUTTON b) { + delete reinterpret_cast<Fl_Light_Button*>(b); +} + diff --git a/src/c_fl_light_button.h b/src/c_fl_light_button.h new file mode 100644 index 0000000..f8c005d --- /dev/null +++ b/src/c_fl_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_LIGHT_BUTTON_GUARD +#define FL_LIGHT_BUTTON_GUARD + + +typedef void* LIGHTBUTTON; + + +extern "C" LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_light_button(LIGHTBUTTON b); + + +#endif + diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp new file mode 100644 index 0000000..f8c7b9e --- /dev/null +++ b/src/c_fl_menu.cpp @@ -0,0 +1,38 @@ + + +#include <FL/Fl_Menu_.H> +#include <FL/Fl_Menu_Item.H> +#include "c_fl_menu.h" + + +int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) { + return reinterpret_cast<Fl_Menu_*>(m)->add(t, s, reinterpret_cast<Fl_Callback_p>(c), u, f); +} + + +const void * fl_menu_find_item(MENU m, const char * t) { + return reinterpret_cast<Fl_Menu_*>(m)->find_item(t); +} + + +const void * fl_menu_mvalue(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->mvalue(); +} + + + + +int fl_menuitem_value(void * mi) { + return reinterpret_cast<Fl_Menu_Item*>(mi)->value(); +} + + +void fl_menuitem_activate(void * mi) { + reinterpret_cast<Fl_Menu_Item*>(mi)->activate(); +} + + +void fl_menuitem_deactivate(void * mi) { + reinterpret_cast<Fl_Menu_Item*>(mi)->deactivate(); +} + diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h new file mode 100644 index 0000000..2b9aa68 --- /dev/null +++ b/src/c_fl_menu.h @@ -0,0 +1,22 @@ + + +#ifndef FL_MENU_GUARD +#define FL_MENU_GUARD + + +typedef void* MENU; +// typedef void* MENUITEM; + + +extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); +extern "C" const void * fl_menu_find_item(MENU m, const char * t); +extern "C" const void * fl_menu_mvalue(MENU m); + + +extern "C" int fl_menuitem_value(void * mi); +extern "C" void fl_menuitem_activate(void * mi); +extern "C" void fl_menuitem_deactivate(void * mi); + + +#endif + diff --git a/src/c_fl_menu_bar.cpp b/src/c_fl_menu_bar.cpp new file mode 100644 index 0000000..3349008 --- /dev/null +++ b/src/c_fl_menu_bar.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Menu_Bar.H> +#include "c_fl_menu_bar.h" + + +MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) { + Fl_Menu_Bar *m = new Fl_Menu_Bar(x, y, w, h, label); + return m; +} + + +void free_fl_menu_bar(MENUBAR m) { + delete reinterpret_cast<Fl_Menu_Bar*>(m); +} + diff --git a/src/c_fl_menu_bar.h b/src/c_fl_menu_bar.h new file mode 100644 index 0000000..a09d22b --- /dev/null +++ b/src/c_fl_menu_bar.h @@ -0,0 +1,15 @@ + + +#ifndef FL_MENU_BAR_GUARD +#define FL_MENU_BAR_GUARD + + +typedef void* MENUBAR; + + +extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label); +extern "C" void free_fl_menu_bar(MENUBAR m); + + +#endif + diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp new file mode 100644 index 0000000..864dd3e --- /dev/null +++ b/src/c_fl_menu_button.cpp @@ -0,0 +1,21 @@ + + +#include <FL/Fl_Menu_Button.H> +#include "c_fl_menu_button.h" + + +MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label) { + Fl_Menu_Button *m = new Fl_Menu_Button(x, y, w, h, label); + return m; +} + + +void free_fl_menu_button(MENUBUTTON m) { + delete reinterpret_cast<Fl_Menu_Button*>(m); +} + + +void fl_menu_button_type(MENUBUTTON m, unsigned int t) { + reinterpret_cast<Fl_Menu_Button*>(m)->type(t); +} + diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h new file mode 100644 index 0000000..8c089b6 --- /dev/null +++ b/src/c_fl_menu_button.h @@ -0,0 +1,18 @@ + + +#ifndef FL_MENU_BUTTON_GUARD +#define FL_MENU_BUTTON_GUARD + + +typedef void* MENUBUTTON; + + +extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_menu_button(MENUBUTTON m); + + +extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); + + +#endif + diff --git a/src/c_fl_menu_window.cpp b/src/c_fl_menu_window.cpp new file mode 100644 index 0000000..66ad6f3 --- /dev/null +++ b/src/c_fl_menu_window.cpp @@ -0,0 +1,52 @@ + + +#include <FL/Fl_Menu_Window.H> +#include "c_fl_menu_window.h" + + +MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) { + Fl_Menu_Window *m = new Fl_Menu_Window(x, y, w, h, label); + return m; +} + + +MENUWINDOW new_fl_menu_window2(int w, int h) { + Fl_Menu_Window *m = new Fl_Menu_Window(w, h); + return m; +} + + +void free_fl_menu_window(MENUWINDOW m) { + delete reinterpret_cast<Fl_Menu_Window*>(m); +} + + +void fl_menu_window_show(MENUWINDOW m) { + reinterpret_cast<Fl_Menu_Window*>(m)->show(); +} + + +void fl_menu_window_hide(MENUWINDOW m) { + reinterpret_cast<Fl_Menu_Window*>(m)->hide(); +} + + +void fl_menu_window_flush(MENUWINDOW m) { + reinterpret_cast<Fl_Menu_Window*>(m)->flush(); +} + + +void fl_menu_window_set_overlay(MENUWINDOW m) { + reinterpret_cast<Fl_Menu_Window*>(m)->set_overlay(); +} + + +void fl_menu_window_clear_overlay(MENUWINDOW m) { + reinterpret_cast<Fl_Menu_Window*>(m)->clear_overlay(); +} + + +unsigned int fl_menu_window_overlay(MENUWINDOW m) { + return reinterpret_cast<Fl_Menu_Window*>(m)->overlay(); +} + diff --git a/src/c_fl_menu_window.h b/src/c_fl_menu_window.h new file mode 100644 index 0000000..3322b29 --- /dev/null +++ b/src/c_fl_menu_window.h @@ -0,0 +1,23 @@ + + +#ifndef FL_MENU_WINDOW_GUARD +#define FL_MENU_WINDOW_GUARD + + +typedef void* MENUWINDOW; + + +extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label); +extern "C" MENUWINDOW new_fl_menu_window2(int w, int h); +extern "C" void free_fl_menu_window(MENUWINDOW m); + +extern "C" void fl_menu_window_show(MENUWINDOW m); +extern "C" void fl_menu_window_hide(MENUWINDOW m); +extern "C" void fl_menu_window_flush(MENUWINDOW m); +extern "C" void fl_menu_window_set_overlay(MENUWINDOW m); +extern "C" void fl_menu_window_clear_overlay(MENUWINDOW m); +extern "C" unsigned int fl_menu_window_overlay(MENUWINDOW m); + + +#endif + diff --git a/src/c_fl_png_image.cpp b/src/c_fl_png_image.cpp new file mode 100644 index 0000000..16d5927 --- /dev/null +++ b/src/c_fl_png_image.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_PNG_Image.H> +#include "c_fl_png_image.h" + + +PNG_IMAGE new_fl_png_image(const char * f) { + Fl_PNG_Image *p = new Fl_PNG_Image(f); + return p; +} + + +void free_fl_png_image(PNG_IMAGE p) { + delete reinterpret_cast<Fl_PNG_Image*>(p); +} + diff --git a/src/c_fl_png_image.h b/src/c_fl_png_image.h new file mode 100644 index 0000000..a67a5aa --- /dev/null +++ b/src/c_fl_png_image.h @@ -0,0 +1,15 @@ + + +#ifndef FL_PNG_IMAGE_GUARD +#define FL_PNG_IMAGE_GUARD + + +typedef void* PNG_IMAGE; + + +extern "C" PNG_IMAGE new_fl_png_image(const char * f); +extern "C" void free_fl_png_image(PNG_IMAGE p); + + +#endif + diff --git a/src/c_fl_radio_button.cpp b/src/c_fl_radio_button.cpp new file mode 100644 index 0000000..1cac323 --- /dev/null +++ b/src/c_fl_radio_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Button.H> +#include "c_fl_radio_button.h" + + +RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Button *b = new Fl_Radio_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_button(RADIOBUTTON b) { + delete reinterpret_cast<Fl_Radio_Button*>(b); +} + diff --git a/src/c_fl_radio_button.h b/src/c_fl_radio_button.h new file mode 100644 index 0000000..d9ea819 --- /dev/null +++ b/src/c_fl_radio_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_BUTTON_GUARD +#define FL_RADIO_BUTTON_GUARD + + +typedef void* RADIOBUTTON; + + +extern "C" RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_button(RADIOBUTTON b); + + +#endif + diff --git a/src/c_fl_radio_light_button.cpp b/src/c_fl_radio_light_button.cpp new file mode 100644 index 0000000..7dd4a5f --- /dev/null +++ b/src/c_fl_radio_light_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Light_Button.H> +#include "c_fl_radio_light_button.h" + + +RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Light_Button *b = new Fl_Radio_Light_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_light_button(RADIOLIGHTBUTTON b) { + delete reinterpret_cast<Fl_Radio_Light_Button*>(b); +} + diff --git a/src/c_fl_radio_light_button.h b/src/c_fl_radio_light_button.h new file mode 100644 index 0000000..ee5f2a1 --- /dev/null +++ b/src/c_fl_radio_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_LIGHT_BUTTON_GUARD +#define FL_RADIO_LIGHT_BUTTON_GUARD + + +typedef void* RADIOLIGHTBUTTON; + + +extern "C" RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_light_button(RADIOLIGHTBUTTON b); + + +#endif + diff --git a/src/c_fl_radio_round_button.cpp b/src/c_fl_radio_round_button.cpp new file mode 100644 index 0000000..9e94244 --- /dev/null +++ b/src/c_fl_radio_round_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Round_Button.H> +#include "c_fl_radio_round_button.h" + + +RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Round_Button *b = new Fl_Radio_Round_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_round_button(RADIOROUNDBUTTON b) { + delete reinterpret_cast<Fl_Radio_Round_Button*>(b); +} + diff --git a/src/c_fl_radio_round_button.h b/src/c_fl_radio_round_button.h new file mode 100644 index 0000000..34f1189 --- /dev/null +++ b/src/c_fl_radio_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_ROUND_BUTTON_GUARD +#define FL_RADIO_ROUND_BUTTON_GUARD + + +typedef void* RADIOROUNDBUTTON; + + +extern "C" RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_round_button(RADIOROUNDBUTTON b); + + +#endif + diff --git a/src/c_fl_repeat_button.cpp b/src/c_fl_repeat_button.cpp new file mode 100644 index 0000000..eafefde --- /dev/null +++ b/src/c_fl_repeat_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Repeat_Button.H> +#include "c_fl_repeat_button.h" + + +REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label) { + Fl_Repeat_Button *b = new Fl_Repeat_Button(x, y, w, h, label); + return b; +} + + +void free_fl_repeat_button(REPEATBUTTON b) { + delete reinterpret_cast<Fl_Repeat_Button*>(b); +} + diff --git a/src/c_fl_repeat_button.h b/src/c_fl_repeat_button.h new file mode 100644 index 0000000..d899730 --- /dev/null +++ b/src/c_fl_repeat_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_REPEAT_BUTTON_GUARD +#define FL_REPEAT_BUTTON_GUARD + + +typedef void* REPEATBUTTON; + + +extern "C" REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_repeat_button(REPEATBUTTON b); + + +#endif + diff --git a/src/c_fl_return_button.cpp b/src/c_fl_return_button.cpp new file mode 100644 index 0000000..5f87fb3 --- /dev/null +++ b/src/c_fl_return_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Return_Button.H> +#include "c_fl_return_button.h" + + +RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label) { + Fl_Return_Button *b = new Fl_Return_Button(x, y, w, h, label); + return b; +} + + +void free_fl_return_button(RETURNBUTTON b) { + delete reinterpret_cast<Fl_Return_Button*>(b); +} + diff --git a/src/c_fl_return_button.h b/src/c_fl_return_button.h new file mode 100644 index 0000000..558e9dc --- /dev/null +++ b/src/c_fl_return_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RETURN_BUTTON_GUARD +#define FL_RETURN_BUTTON_GUARD + + +typedef void* RETURNBUTTON; + + +extern "C" RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_return_button(RETURNBUTTON b); + + +#endif + diff --git a/src/c_fl_round_button.cpp b/src/c_fl_round_button.cpp new file mode 100644 index 0000000..b33448f --- /dev/null +++ b/src/c_fl_round_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Round_Button.H> +#include "c_fl_round_button.h" + + +ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label) { + Fl_Round_Button *b = new Fl_Round_Button(x, y, w, h, label); + return b; +} + + +void free_fl_round_button(ROUNDBUTTON b) { + delete reinterpret_cast<Fl_Round_Button*>(b); +} + diff --git a/src/c_fl_round_button.h b/src/c_fl_round_button.h new file mode 100644 index 0000000..36113a4 --- /dev/null +++ b/src/c_fl_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_ROUND_BUTTON_GUARD +#define FL_ROUND_BUTTON_GUARD + + +typedef void* ROUNDBUTTON; + + +extern "C" ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_round_button(ROUNDBUTTON b); + + +#endif + diff --git a/src/c_fl_single_window.cpp b/src/c_fl_single_window.cpp new file mode 100644 index 0000000..ec9a315 --- /dev/null +++ b/src/c_fl_single_window.cpp @@ -0,0 +1,32 @@ + + +#include <FL/Fl_Single_Window.H> +#include "c_fl_single_window.h" + + +SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) { + Fl_Single_Window *sw = new Fl_Single_Window(x, y, w, h, label); + return sw; +} + + +SINGLEWINDOW new_fl_single_window2(int x, int y) { + Fl_Single_Window *sw = new Fl_Single_Window(x, y); + return sw; +} + + +void free_fl_single_window(SINGLEWINDOW w) { + delete reinterpret_cast<Fl_Single_Window*>(w); +} + + +void fl_single_window_show(SINGLEWINDOW w) { + reinterpret_cast<Fl_Single_Window*>(w)->show(); +} + + +void fl_single_window_flush(SINGLEWINDOW w) { + reinterpret_cast<Fl_Single_Window*>(w)->flush(); +} + diff --git a/src/c_fl_single_window.h b/src/c_fl_single_window.h new file mode 100644 index 0000000..96f6d5b --- /dev/null +++ b/src/c_fl_single_window.h @@ -0,0 +1,19 @@ + + +#ifndef FL_SINGLE_WINDOW_GUARD +#define FL_SINGLE_WINDOW_GUARD + + +typedef void* SINGLEWINDOW; + + +extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label); +extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y); +extern "C" void free_fl_single_window(SINGLEWINDOW w); + +extern "C" void fl_single_window_show(SINGLEWINDOW w); +extern "C" void fl_single_window_flush(SINGLEWINDOW w); + + +#endif + diff --git a/src/c_fl_text_buffer.cpp b/src/c_fl_text_buffer.cpp new file mode 100644 index 0000000..71f04d2 --- /dev/null +++ b/src/c_fl_text_buffer.cpp @@ -0,0 +1,111 @@ + + +#include <FL/Fl_Text_Buffer.H> +#include "c_fl_text_buffer.h" + + +TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { + Fl_Text_Buffer *tb = new Fl_Text_Buffer(rs, pgs); + return tb; +} + + +void free_fl_text_buffer(TEXTBUFFER tb) { + delete reinterpret_cast<Fl_Text_Buffer*>(tb); +} + + +void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->add_modify_callback(reinterpret_cast<Fl_Text_Modify_Cb>(cb), ud); +} + + +void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->add_predelete_callback(reinterpret_cast<Fl_Text_Predelete_Cb>(cb), ud); +} + + +void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->call_modify_callbacks(); +} + + +void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->call_predelete_callbacks(); +} + + +void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->insert(p, item); +} + + +void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->remove(s, f); +} + + +int fl_text_buffer_length(TEXTBUFFER tb) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->length(); +} + + +int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->loadfile(n); +} + + +void fl_text_buffer_remove_selection(TEXTBUFFER tb) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->remove_selection(); +} + + +int fl_text_buffer_savefile(TEXTBUFFER tb, char * n) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->savefile(n); +} + + +int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->search_forward(start, item, found, mcase); +} + + +int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->search_backward(start, item, found, mcase); +} + + +void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { + reinterpret_cast<Fl_Text_Buffer*>(tb)->select(s, e); +} + + +int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->selection_position(s, e); +} + + +int fl_text_buffer_selected(TEXTBUFFER tb) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->selected(); +} + + +int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->skip_lines(s, l); +} + + +int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->rewind_lines(s, l); +} + + +unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->char_at(p); +} + + +char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f) { + return reinterpret_cast<Fl_Text_Buffer*>(tb)->text_range(s, f); +} + diff --git a/src/c_fl_text_buffer.h b/src/c_fl_text_buffer.h new file mode 100644 index 0000000..1551d2b --- /dev/null +++ b/src/c_fl_text_buffer.h @@ -0,0 +1,36 @@ + + +#ifndef FL_TEXT_BUFFER_GUARD +#define FL_TEXT_BUFFER_GUARD + + +typedef void* TEXTBUFFER; + + +extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); +extern "C" void free_fl_text_buffer(TEXTBUFFER tb); + + +extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb); +extern "C" void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb); +extern "C" void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item); +extern "C" void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f); +extern "C" int fl_text_buffer_length(TEXTBUFFER tb); +extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n); +extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); +extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n); +extern "C" int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); +extern "C" int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); +extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); +extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e); +extern "C" int fl_text_buffer_selected(TEXTBUFFER tb); +extern "C" int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l); +extern "C" int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l); +extern "C" unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p); +extern "C" char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f); + + +#endif + diff --git a/src/c_fl_text_display.cpp b/src/c_fl_text_display.cpp new file mode 100644 index 0000000..b9e59c6 --- /dev/null +++ b/src/c_fl_text_display.cpp @@ -0,0 +1,105 @@ + + +#include <FL/Fl_Text_Display.H> +#include <FL/Fl_Text_Buffer.H> +#include "c_fl_text_display.h" +#include "c_fl_text_buffer.h" + + +TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) { + Fl_Text_Display *td = new Fl_Text_Display(x, y, w, h, label); + return td; +} + + +void free_fl_text_display(TEXTDISPLAY td) { + delete reinterpret_cast<Fl_Text_Display*>(td); +} + + +// this actually never gets called, since an access to the text_buffer +// object is stored on the Ada side of things +TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->buffer(); +} + + +void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) { + reinterpret_cast<Fl_Text_Display*>(td)->buffer(reinterpret_cast<Fl_Text_Buffer*>(tb)); +} + + +int fl_text_display_get_text_color(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->textcolor(); +} + + +void fl_text_display_set_text_color(TEXTDISPLAY td, int c) { + reinterpret_cast<Fl_Text_Display*>(td)->textcolor(static_cast<Fl_Color>(c)); +} + + +int fl_text_display_get_text_font(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->textfont(); +} + + +void fl_text_display_set_text_font(TEXTDISPLAY td, int f) { + reinterpret_cast<Fl_Text_Display*>(td)->textfont(static_cast<Fl_Font>(f)); +} + + +int fl_text_display_get_text_size(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->textsize(); +} + + +void fl_text_display_set_text_size(TEXTDISPLAY td, int s) { + reinterpret_cast<Fl_Text_Display*>(td)->textsize(static_cast<Fl_Fontsize>(s)); +} + + +int fl_text_display_get_insert_pos(TEXTDISPLAY td) { + return reinterpret_cast<Fl_Text_Display*>(td)->insert_position(); +} + + +void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p) { + reinterpret_cast<Fl_Text_Display*>(td)->insert_position(p); +} + + +void fl_text_display_show_insert_pos(TEXTDISPLAY td) { + reinterpret_cast<Fl_Text_Display*>(td)->show_insert_position(); +} + + +void fl_text_display_next_word(TEXTDISPLAY td) { + reinterpret_cast<Fl_Text_Display*>(td)->next_word(); +} + + +void fl_text_display_previous_word(TEXTDISPLAY td) { + reinterpret_cast<Fl_Text_Display*>(td)->previous_word(); +} + + +void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m) { + reinterpret_cast<Fl_Text_Display*>(td)->wrap_mode(w, m); +} + + +int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p) { + return reinterpret_cast<Fl_Text_Display*>(td)->skip_lines(s, l, p); +} + + +int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l) { + return reinterpret_cast<Fl_Text_Display*>(td)->rewind_lines(s, l); +} + + +void fl_text_display_linenumber_width(TEXTDISPLAY td, int w) { + reinterpret_cast<Fl_Text_Display*>(td)->linenumber_width(w); +} + diff --git a/src/c_fl_text_display.h b/src/c_fl_text_display.h new file mode 100644 index 0000000..dbd683f --- /dev/null +++ b/src/c_fl_text_display.h @@ -0,0 +1,35 @@ + + +#ifndef FL_TEXT_DISPLAY_GUARD +#define FL_TEXT_DISPLAY_GUARD + +#include "c_fl_text_buffer.h" + + +typedef void* TEXTDISPLAY; + + +extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); +extern "C" void free_fl_text_display(TEXTDISPLAY td); + +extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); +extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); +extern "C" int fl_text_display_get_text_color(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, int c); +extern "C" int fl_text_display_get_text_font(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_font(TEXTDISPLAY td, int f); +extern "C" int fl_text_display_get_text_size(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_size(TEXTDISPLAY td, int s); +extern "C" int fl_text_display_get_insert_pos(TEXTDISPLAY td); +extern "C" void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p); +extern "C" void fl_text_display_show_insert_pos(TEXTDISPLAY td); +extern "C" void fl_text_display_next_word(TEXTDISPLAY td); +extern "C" void fl_text_display_previous_word(TEXTDISPLAY td); +extern "C" void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m); +extern "C" int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p); +extern "C" int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l); +extern "C" void fl_text_display_linenumber_width(TEXTDISPLAY td, int w); + + +#endif + diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp new file mode 100644 index 0000000..c28f6fa --- /dev/null +++ b/src/c_fl_text_editor.cpp @@ -0,0 +1,48 @@ + + +#include <FL/Fl_Text_Editor.H> +#include "c_fl_text_editor.h" + + +TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) { + Fl_Text_Editor *te = new Fl_Text_Editor(x, y, w, h, label); + return te; +} + + +void free_fl_text_editor(TEXTEDITOR te) { + delete reinterpret_cast<Fl_Text_Editor*>(te); +} + + + + +void fl_text_editor_undo(TEXTEDITOR te) { + Fl_Text_Editor::kf_undo(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_cut(TEXTEDITOR te) { + Fl_Text_Editor::kf_cut(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_copy(TEXTEDITOR te) { + Fl_Text_Editor::kf_copy(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_paste(TEXTEDITOR te) { + Fl_Text_Editor::kf_paste(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_delete(TEXTEDITOR te) { + Fl_Text_Editor::kf_delete(0, reinterpret_cast<Fl_Text_Editor*>(te)); +} + + +void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m) { + reinterpret_cast<Fl_Text_Editor*>(te)->remove_key_binding(k, m); +} + diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h new file mode 100644 index 0000000..ebaab0d --- /dev/null +++ b/src/c_fl_text_editor.h @@ -0,0 +1,23 @@ + + +#ifndef FL_TEXT_EDITOR_GUARD +#define FL_TEXT_EDITOR_GUARD + + +typedef void* TEXTEDITOR; + + +extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label); +extern "C" void free_fl_text_editor(TEXTEDITOR te); + + +extern "C" void fl_text_editor_undo(TEXTEDITOR te); +extern "C" void fl_text_editor_cut(TEXTEDITOR te); +extern "C" void fl_text_editor_copy(TEXTEDITOR te); +extern "C" void fl_text_editor_paste(TEXTEDITOR te); +extern "C" void fl_text_editor_delete(TEXTEDITOR te); +extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m); + + +#endif + diff --git a/src/c_fl_toggle_button.cpp b/src/c_fl_toggle_button.cpp new file mode 100644 index 0000000..d52e72e --- /dev/null +++ b/src/c_fl_toggle_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Toggle_Button.H> +#include "c_fl_toggle_button.h" + + +TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label) { + Fl_Toggle_Button *b = new Fl_Toggle_Button(x, y, w, h, label); + return b; +} + + +void free_fl_toggle_button(TOGGLEBUTTON b) { + delete reinterpret_cast<Fl_Toggle_Button*>(b); +} + diff --git a/src/c_fl_toggle_button.h b/src/c_fl_toggle_button.h new file mode 100644 index 0000000..ed86ed4 --- /dev/null +++ b/src/c_fl_toggle_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_TOGGLE_BUTTON_GUARD +#define FL_TOGGLE_BUTTON_GUARD + + +typedef void* TOGGLEBUTTON; + + +extern "C" TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_toggle_button(TOGGLEBUTTON b); + + +#endif + diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp new file mode 100644 index 0000000..30c4de3 --- /dev/null +++ b/src/c_fl_widget.cpp @@ -0,0 +1,119 @@ + + +#include <FL/Fl_Widget.H> +#include <FL/Fl_Image.H> +#include "c_fl_widget.h" + + + + +void * fl_widget_get_user_data(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->user_data(); +} + + +void fl_widget_set_user_data(WIDGET w, void * d) { + reinterpret_cast<Fl_Widget*>(w)->user_data(d); +} + + + + +int fl_widget_get_box(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->box(); +} + + +void fl_widget_set_box(WIDGET w, int b) { + reinterpret_cast<Fl_Widget*>(w)->box(static_cast<Fl_Boxtype>(b)); +} + + +const char* fl_widget_get_label(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->label(); +} + + +void fl_widget_set_label(WIDGET w, const char* t) { + reinterpret_cast<Fl_Widget*>(w)->copy_label(t); +} + + +int fl_widget_get_label_font(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->labelfont(); +} + + +void fl_widget_set_label_font(WIDGET w, int f) { + reinterpret_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f)); +} + + +int fl_widget_get_label_size(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->labelsize(); +} + + +void fl_widget_set_label_size(WIDGET w, int s) { + reinterpret_cast<Fl_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s)); +} + + +int fl_widget_get_label_type(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->labeltype(); +} + + +void fl_widget_set_label_type(WIDGET w, int l) { + reinterpret_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l)); +} + + +void * fl_widget_get_parent(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->parent(); +} + + + + +void fl_widget_set_callback(WIDGET w, void * cb) { + reinterpret_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb)); +} + + + + +int fl_widget_get_x(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->x(); +} + + +int fl_widget_get_y(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->y(); +} + + +int fl_widget_get_w(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->w(); +} + + +int fl_widget_get_h(WIDGET w) { + return reinterpret_cast<Fl_Widget*>(w)->h(); +} + + +void fl_widget_size(WIDGET w, int d, int h) { + reinterpret_cast<Fl_Widget*>(w)->size(d, h); +} + + +void fl_widget_position(WIDGET w, int x, int y) { + reinterpret_cast<Fl_Widget*>(w)->position(x, y); +} + + +void fl_widget_set_image(WIDGET w, void * img) { + reinterpret_cast<Fl_Widget*>(w)->image(reinterpret_cast<Fl_Image*>(img)); +} + diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h new file mode 100644 index 0000000..3c20dc2 --- /dev/null +++ b/src/c_fl_widget.h @@ -0,0 +1,40 @@ + + +#ifndef FL_WIDGET_GUARD +#define FL_WIDGET_GUARD + + +typedef void* WIDGET; + + +extern "C" void * fl_widget_get_user_data(WIDGET w); +extern "C" void fl_widget_set_user_data(WIDGET w, void * d); + + +extern "C" int fl_widget_get_box(WIDGET w); +extern "C" void fl_widget_set_box(WIDGET w, int b); +extern "C" const char* fl_widget_get_label(WIDGET w); +extern "C" void fl_widget_set_label(WIDGET w, const char* t); +extern "C" int fl_widget_get_label_font(WIDGET w); +extern "C" void fl_widget_set_label_font(WIDGET w, int f); +extern "C" int fl_widget_get_label_size(WIDGET w); +extern "C" void fl_widget_set_label_size(WIDGET w, int s); +extern "C" int fl_widget_get_label_type(WIDGET w); +extern "C" void fl_widget_set_label_type(WIDGET w, int l); +extern "C" void * fl_widget_get_parent(WIDGET w); + + +extern "C" void fl_widget_set_callback(WIDGET w, void * cb); + + +extern "C" int fl_widget_get_x(WIDGET w); +extern "C" int fl_widget_get_y(WIDGET w); +extern "C" int fl_widget_get_w(WIDGET w); +extern "C" int fl_widget_get_h(WIDGET w); +extern "C" void fl_widget_size(WIDGET w, int d, int h); +extern "C" void fl_widget_position(WIDGET w, int x, int y); +extern "C" void fl_widget_set_image(WIDGET w, void * img); + + +#endif + diff --git a/src/c_fl_window.cpp b/src/c_fl_window.cpp new file mode 100644 index 0000000..fbce39b --- /dev/null +++ b/src/c_fl_window.cpp @@ -0,0 +1,58 @@ + + +#include <FL/Fl_Window.H> +#include <FL/Fl_RGB_Image.H> +#include "c_fl_window.h" + + +WINDOW new_fl_window(int x, int y, int w, int h, char* label) { + Fl_Window *n = new Fl_Window(x, y, w, h, label); + return n; +} + + +WINDOW new_fl_window2(int w, int h) { + Fl_Window *n = new Fl_Window(w, h); + return n; +} + + +void free_fl_window(WINDOW n) { + delete reinterpret_cast<Fl_Window*>(n); +} + + +void fl_window_show(WINDOW n) { + reinterpret_cast<Fl_Window*>(n)->show(); +} + + +void fl_window_hide(WINDOW n) { + reinterpret_cast<Fl_Window*>(n)->hide(); +} + + +void fl_window_set_label(WINDOW n, char* text) { + reinterpret_cast<Fl_Window*>(n)->copy_label(text); +} + + +void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) { + reinterpret_cast<Fl_Window*>(n)->size_range(lw, lh, hw, hh, dw, dh, a); +} + + +void fl_window_set_icon(WINDOW n, void * img) { + reinterpret_cast<Fl_Window*>(n)->icon(reinterpret_cast<Fl_RGB_Image*>(img)); +} + + +void fl_window_set_modal(WINDOW n) { + reinterpret_cast<Fl_Window*>(n)->set_modal(); +} + + +void fl_window_set_non_modal(WINDOW n) { + reinterpret_cast<Fl_Window*>(n)->set_non_modal(); +} + diff --git a/src/c_fl_window.h b/src/c_fl_window.h new file mode 100644 index 0000000..c382919 --- /dev/null +++ b/src/c_fl_window.h @@ -0,0 +1,24 @@ + + +#ifndef FL_WINDOW_GUARD +#define FL_WINDOW_GUARD + + +typedef void* WINDOW; + + +extern "C" WINDOW new_fl_window(int x, int y, int w, int h, char* label); +extern "C" WINDOW new_fl_window2(int w, int h); +extern "C" void free_fl_window(WINDOW n); + +extern "C" void fl_window_show(WINDOW n); +extern "C" void fl_window_hide(WINDOW n); +extern "C" void fl_window_set_label(WINDOW n, char* text); +extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); +extern "C" void fl_window_set_icon(WINDOW n, void * img); +extern "C" void fl_window_set_modal(WINDOW n); +extern "C" void fl_window_set_non_modal(WINDOW n); + + +#endif + diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb new file mode 100644 index 0000000..0c9adcf --- /dev/null +++ b/src/fltk-dialogs.adb @@ -0,0 +1,111 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +use type Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Dialogs is + + + procedure dialog_fl_alert + (M : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_alert, "dialog_fl_alert"); + + function dialog_fl_choice + (M, A, B, C : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, dialog_fl_choice, "dialog_fl_choice"); + + function dialog_fl_file_chooser + (M, P, D : in Interfaces.C.char_array; + R : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, dialog_fl_file_chooser, "dialog_fl_file_chooser"); + + function dialog_fl_input + (M, D : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, dialog_fl_input, "dialog_fl_input"); + + procedure dialog_fl_message + (M : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_message, "dialog_fl_message"); + + + + + procedure Alert + (Message : String) is + begin + dialog_fl_alert (Interfaces.C.To_C (Message)); + end Alert; + + + + + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice + is + Result : Interfaces.C.int := dialog_fl_choice + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Button1), + Interfaces.C.To_C (Button2), + Interfaces.C.To_C (Button3)); + begin + return Choice'Val (Result); + end Three_Way_Choice; + + + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String + is + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_file_chooser + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Filter_Pattern), + Interfaces.C.To_C (Default), + Boolean'Pos (Relative)); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end File_Chooser; + + + + + function Text_Input + (Message : in String; + Default : in String := "") + return String + is + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Default)); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Text_Input; + + + + + procedure Message_Box + (Message : in String) is + begin + dialog_fl_message (Interfaces.C.To_C (Message)); + end Message_Box; + + +end FLTK.Dialogs; + diff --git a/src/fltk-dialogs.ads b/src/fltk-dialogs.ads new file mode 100644 index 0000000..cb5b966 --- /dev/null +++ b/src/fltk-dialogs.ads @@ -0,0 +1,33 @@ + + +package FLTK.Dialogs is + + + procedure Alert + (Message : String); + + + type Choice is (First, Second, Third); + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice; + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String; + + + function Text_Input + (Message : in String; + Default : in String := "") + return String; + + + procedure Message_Box + (Message : in String); + + +end FLTK.Dialogs; + diff --git a/src/fltk-enum_values.ads b/src/fltk-enum_values.ads new file mode 100644 index 0000000..068d5c1 --- /dev/null +++ b/src/fltk-enum_values.ads @@ -0,0 +1,7 @@ + + +private package FLTK.Enum_Values is + + +end FLTK.Enum_Values; + diff --git a/src/fltk-enums.adb b/src/fltk-enums.adb new file mode 100644 index 0000000..292e5ff --- /dev/null +++ b/src/fltk-enums.adb @@ -0,0 +1,71 @@ + + +with Interfaces.C; +use type Interfaces.C.unsigned_long; + + +package body FLTK.Enums is + + + function Shortcut + (Key : Pressable_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Mod_None; + This.Keypress := Key; + end return; + end Shortcut; + + + + + function Key_To_C + (Key : Shortcut_Key) + return Interfaces.C.unsigned_long is + begin + return Interfaces.C.unsigned_long (Key.Modifier) * + 65536 + Character'Pos (Key.Keypress); + end Key_To_C; + + + + + function "+" + (Left, Right : in Modifier_Key) + return Modifier_Key is + begin + return Left or Right; + end "+"; + + + + + function "+" + (Left : in Modifier_Key; + Right : in Pressable_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Left; + This.Keypress := Right; + end return; + end "+"; + + + + + function "+" + (Left : in Modifier_Key; + Right : in Shortcut_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Left or Right.Modifier; + This.Keypress := Right.Keypress; + end return; + end "+"; + + +end FLTK.Enums; + diff --git a/src/fltk-enums.ads b/src/fltk-enums.ads new file mode 100644 index 0000000..91f7353 --- /dev/null +++ b/src/fltk-enums.ads @@ -0,0 +1,146 @@ + + +with Interfaces.C; +private with FLTK.Enum_Values; + + +package FLTK.Enums is + + + type Box_Kind is + (No_Box, + Flat_Box, + Up_Box, + Down_Box, + Up_Frame, + Down_Frame, + Thin_Up_Box, + Thin_Down_Box, + Thin_Up_Frame, + Thin_Down_Frame, + Engraved_Box, + Embossed_Box, + Engraved_Frame, + Embossed_Frame, + Border_Box, + Shadow_Box, + Border_Frame, + Shadow_Frame, + Rounded_Box, + RShadow_Box, + Rounded_Frame, + RFlat_Box, + Round_Up_Box, + Round_Down_Box, + Diamond_Up_Box, + Diamond_Down_Box, + Oval_Box, + OShadow_Box, + Oval_Frame, + OFlat_Box, + Plastic_Up_Box, + Plastic_Down_Box, + Plastic_Up_Frame, + Plastic_Down_Frame, + Plastic_Thin_Up_Box, + Plastic_Thin_Down_Box, + Plastic_Round_Up_Box, + Plastic_Round_Down_Box, + Gtk_Up_Box, + Gtk_Down_Box, + Gtk_Up_Frame, + Gtk_Down_Frame, + Gtk_Thin_Up_Box, + Gtk_Thin_Down_Box, + Gtk_Thin_Up_Frame, + Gtk_Thin_Down_Frame, + Gtk_Round_Up_Box, + Gtk_Round_Down_Box, + Gleam_Up_Box, + Gleam_Down_Box, + Gleam_Up_Frame, + Gleam_Down_Frame, + Gleam_Thin_Up_Box, + Gleam_Thin_Down_Box, + Gleam_Round_Up_Box, + Gleam_Round_Down_Box, + Free_Box); + + + type Font_Kind is + (Helvetica, + Helvetica_Bold, + Helvetica_Italic, + Helvetica_Bold_Italic, + Courier, + Courier_Bold, + Courier_Italic, + Courier_Bold_Italic, + Times, + Times_Bold, + Times_Italic, + Times_Bold_Italic, + Symbol, + Screen, + Screen_Bold, + Zapf_Dingbats, + Free_Font); + + + type Label_Kind is + (Normal_Label, + No_Label, + Shadow_Label, + Engraved_Label, + Embossed_Label, + Multi_Label, + Icon_Label, + Image_Label, + Free_Label); + + + -- type Modifier_Key is private; + type Modifier_Key is new Interfaces.Unsigned_8; + + -- type Shortcut_Key is private; + type Shortcut_Key is + record + Modifier : Modifier_Key; + Keypress : Character; + end record; + + subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); + function Shortcut (Key : Pressable_Key) return Shortcut_Key; + No_Key : constant Shortcut_Key; + + + function "+" (Left, Right : in Modifier_Key) return Modifier_Key; + function "+" (Left : in Modifier_Key; Right : in Pressable_Key) return Shortcut_Key; + function "+" (Left : in Modifier_Key; Right : in Shortcut_Key) return Shortcut_Key; + Mod_None : constant Modifier_Key; + Mod_Shift : constant Modifier_Key; + Mod_Ctrl : constant Modifier_Key; + Mod_Alt : constant Modifier_Key; + + + function Key_To_C + (Key : Shortcut_Key) + return Interfaces.C.unsigned_long; + + +private + + + -- these values designed to align with FLTK enumeration types + Mod_None : constant Modifier_Key := 2#00000000#; + Mod_Shift : constant Modifier_Key := 2#00000001#; + Mod_Ctrl : constant Modifier_Key := 2#00000100#; + Mod_Alt : constant Modifier_Key := 2#00001000#; + + + No_Key : constant Shortcut_Key := + (Modifier => Mod_None, Keypress => Character'Val (0)); + + +end FLTK.Enums; + diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb new file mode 100644 index 0000000..ecb2f5e --- /dev/null +++ b/src/fltk-images-rgb-png.adb @@ -0,0 +1,49 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Images.RGB.PNG is + + + function new_fl_png_image + (F : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_png_image, "new_fl_png_image"); + + procedure free_fl_png_image + (P : in System.Address); + pragma Import (C, free_fl_png_image, "free_fl_png_image"); + + + + + overriding procedure Finalize + (This : in out PNG_Image) is + begin + Finalize (RGB_Image (This)); + if This.Void_Ptr /= System.Null_Address then + if This in PNG_Image then + free_fl_png_image (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (Filename : in String) + return PNG_Image is + begin + return This : PNG_Image do + This.Void_Ptr := new_fl_png_image + (Interfaces.C.To_C (Filename)); + end return; + end Create; + + +end FLTK.Images.RGB.PNG; + diff --git a/src/fltk-images-rgb-png.ads b/src/fltk-images-rgb-png.ads new file mode 100644 index 0000000..0b44cb0 --- /dev/null +++ b/src/fltk-images-rgb-png.ads @@ -0,0 +1,25 @@ + + +package FLTK.Images.RGB.PNG is + + + type PNG_Image is new RGB_Image with private; + + + function Create + (Filename : in String) + return PNG_Image; + + +private + + + type PNG_Image is new RGB_Image with null record; + + + overriding procedure Finalize + (This : in out PNG_Image); + + +end FLTK.Images.RGB.PNG; + diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb new file mode 100644 index 0000000..3556f74 --- /dev/null +++ b/src/fltk-images-rgb.adb @@ -0,0 +1,14 @@ + + +package body FLTK.Images.RGB is + + + overriding procedure Finalize + (This : in out RGB_Image) is + begin + Finalize (Image (This)); + end Finalize; + + +end FLTK.Images.RGB; + diff --git a/src/fltk-images-rgb.ads b/src/fltk-images-rgb.ads new file mode 100644 index 0000000..ba47793 --- /dev/null +++ b/src/fltk-images-rgb.ads @@ -0,0 +1,20 @@ + + +package FLTK.Images.RGB is + + + type RGB_Image is new Image with private; + + +private + + + type RGB_Image is new Image with null record; + + + overriding procedure Finalize + (This : in out RGB_Image); + + +end FLTK.Images.RGB; + diff --git a/src/fltk-images.adb b/src/fltk-images.adb new file mode 100644 index 0000000..bbd87c9 --- /dev/null +++ b/src/fltk-images.adb @@ -0,0 +1,96 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Images is + + + function new_fl_image + (W, H, D : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_image, "new_fl_image"); + + procedure free_fl_image + (I : in System.Address); + pragma Import (C, free_fl_image, "free_fl_image"); + + function fl_image_w + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_w, "fl_image_w"); + + function fl_image_h + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_h, "fl_image_h"); + + function fl_image_d + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_d, "fl_image_d"); + + + + + overriding procedure Finalize + (This : in out Image) is + begin + Finalize (Wrapper (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Image then + free_fl_image (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (Width, Height, Depth : in Natural) + return Image is + begin + return This : Image do + This.Void_Ptr := new_fl_image + (Interfaces.C.int (Width), + Interfaces.C.int (Height), + Interfaces.C.int (Depth)); + end return; + end Create; + + + + + function Get_W + (This : in Image) + return Natural is + begin + return Natural (fl_image_w (This.Void_Ptr)); + end Get_W; + + + + + function Get_H + (This : in Image) + return Natural is + begin + return Natural (fl_image_h (This.Void_Ptr)); + end Get_H; + + + + + function Get_D + (This : in Image) + return Natural is + begin + return Natural (fl_image_d (This.Void_Ptr)); + end Get_D; + + +end FLTK.Images; + diff --git a/src/fltk-images.ads b/src/fltk-images.ads new file mode 100644 index 0000000..f005443 --- /dev/null +++ b/src/fltk-images.ads @@ -0,0 +1,40 @@ + + +package FLTK.Images is + + + type Image is new Wrapper with private; + + + function Create + (Width, Height, Depth : in Natural) + return Image; + + + function Get_W + (This : in Image) + return Natural; + + + function Get_H + (This : in Image) + return Natural; + + + function Get_D + (This : in Image) + return Natural; + + +private + + + type Image is new Wrapper with null record; + + + overriding procedure Finalize + (This : in out Image); + + +end FLTK.Images; + diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb new file mode 100644 index 0000000..52f12e0 --- /dev/null +++ b/src/fltk-text_buffers.adb @@ -0,0 +1,540 @@ + + +with Interfaces.C.Strings; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Containers; +with System; +use type System.Address; +use type Interfaces.C.int; +use type Interfaces.C.Strings.chars_ptr; +use type Ada.Containers.Count_Type; + + +package body FLTK.Text_Buffers is + + + function new_fl_text_buffer + (RS, PGS : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); + + procedure free_fl_text_buffer + (TB : in System.Address); + pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); + + procedure fl_text_buffer_add_modify_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_modify_callback, + "fl_text_buffer_add_modify_callback"); + + procedure fl_text_buffer_add_predelete_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_predelete_callback, + "fl_text_buffer_add_predelete_callback"); + + procedure fl_text_buffer_call_modify_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_modify_callbacks, + "fl_text_buffer_call_modify_callbacks"); + + procedure fl_text_buffer_call_predelete_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_predelete_callbacks, + "fl_text_buffer_call_predelete_callbacks"); + + procedure fl_text_buffer_insert + (TB : in System.Address; + P : in Interfaces.C.int; + I : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); + + procedure fl_text_buffer_remove + (TB : in System.Address; + S, F : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); + + function fl_text_buffer_length + (TB : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); + + function fl_text_buffer_loadfile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); + + procedure fl_text_buffer_remove_selection + (TB : in System.Address); + pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); + + function fl_text_buffer_savefile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); + + function fl_text_buffer_search_forward + (TB : in System.Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); + + function fl_text_buffer_search_backward + (TB : in System.Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); + + procedure fl_text_buffer_select + (TB : in System.Address; + S, E : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); + + function fl_text_buffer_selection_position + (TB : in System.Address; + S, E : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); + + function fl_text_buffer_selected + (TB : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); + + function fl_text_buffer_skip_lines + (TB : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); + + function fl_text_buffer_rewind_lines + (TB : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); + + function fl_text_buffer_char_at + (TB : in System.Address; + P : in Interfaces.C.int) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); + + function fl_text_buffer_text_range + (TB : in System.Address; + S, F : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); + + + + + procedure Finalize + (This : in out Text_Buffer) is + begin + if This.Void_Ptr /= System.Null_Address then + if This in Text_Buffer then + free_fl_text_buffer (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + procedure Modify_Callback_Hook + (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address); + pragma Convention (C, Modify_Callback_Hook); + + procedure Modify_Callback_Hook + (Pos : in Interfaces.C.int; + Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address) + is + Action : Modification; + Place : Position := Position (Pos); + Length : Natural; + Deleted_Text : Unbounded_String := To_Unbounded_String (""); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + begin + if Ada_Text_Buffer.CB_Active then + if Inserted > 0 then + Length := Natural (Inserted); + Action := Insert; + elsif Deleted > 0 then + Length := Natural (Deleted); + Action := Delete; + if Text /= Interfaces.C.Strings.Null_Ptr then + Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); + end if; + elsif Restyled > 0 then + Length := Natural (Restyled); + Action := Restyle; + else + Length := 0; + Action := None; + end if; + + for CB of Ada_Text_Buffer.Modify_CBs loop + CB.all (Action, Place, Length, To_String (Deleted_Text)); + end loop; + end if; + end Modify_Callback_Hook; + + + + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address); + pragma Convention (C, Predelete_Callback_Hook); + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address) + is + Place : Position := Position (Pos); + Length : Natural := Natural (Deleted); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + begin + if Ada_Text_Buffer.CB_Active then + for CB of Ada_Text_Buffer.Predelete_CBs loop + CB.all (Place, Length); + end loop; + end if; + end Predelete_Callback_Hook; + + + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer is + begin + return This : Text_Buffer do + This.Void_Ptr := new_fl_text_buffer + (Interfaces.C.int (Requested_Size), + Interfaces.C.int (Preferred_Gap_Size)); + + This.Modify_CBs := Modify_Vectors.Empty_Vector; + This.Predelete_CBs := Predelete_Vectors.Empty_Vector; + This.CB_Active := True; + end return; + end Create; + + + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback) is + begin + if This.Modify_CBs.Length = 0 then + fl_text_buffer_add_modify_callback + (This.Void_Ptr, + Modify_Callback_Hook'Address, + This'Address); + end if; + This.Modify_CBs.Append (Func); + end Add_Modify_Callback; + + + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback) is + begin + if This.Predelete_CBs.Length = 0 then + fl_text_buffer_add_predelete_callback + (This.Void_Ptr, + Predelete_Callback_Hook'Address, + This'Address); + end if; + This.Predelete_CBs.Append (Func); + end Add_Predelete_Callback; + + + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_modify_callbacks (This.Void_Ptr); + end Call_Modify_Callbacks; + + + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); + end Call_Predelete_Callbacks; + + + + + procedure Enable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := True; + end Enable_Callbacks; + + + + + procedure Disable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := False; + end Disable_Callbacks; + + + + + procedure Insert_Text + (This : in out Text_Buffer; + Pos : in Natural; + Item : in String) is + begin + fl_text_buffer_insert + (This.Void_Ptr, + Interfaces.C.int (Pos), + Interfaces.C.To_C (Item)); + end Insert_Text; + + + + + procedure Remove_Text + (This : in out Text_Buffer; + Start, Finish : in Natural) is + begin + fl_text_buffer_remove + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Remove_Text; + + + + + function Length + (This : in Text_Buffer) + return Natural is + begin + return Natural (fl_text_buffer_length (This.Void_Ptr)); + end Length; + + + + + procedure Load_File + (This : in Text_Buffer; + Name : in String) + is + Err_No : Interfaces.C.int := fl_text_buffer_loadfile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Load_File; + + + + + procedure Remove_Selected_Text + (This : in out Text_Buffer) is + begin + fl_text_buffer_remove_selection (This.Void_Ptr); + end Remove_Selected_Text; + + + + + procedure Save_File + (This : in Text_Buffer; + Name : in String) + is + Err_No : Interfaces.C.int := fl_text_buffer_savefile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Save_File; + + + + + function Search_Forward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean + is + Found_Raw, Result : Interfaces.C.int; + begin + Result := fl_text_buffer_search_forward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Found_Raw, + Boolean'Pos (Match_Case)); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; + end Search_Forward; + + + + + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean + is + Found_Raw, Result : Interfaces.C.int; + begin + Result := fl_text_buffer_search_backward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Found_Raw, + Boolean'Pos (Match_Case)); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; + end Search_Backward; + + + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural) is + begin + fl_text_buffer_select + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Selection; + + + + + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean + is + Result, Start_Raw, Finish_Raw : Interfaces.C.int; + begin + Result := fl_text_buffer_selection_position + (This.Void_Ptr, + Start_Raw, + Finish_Raw); + if Result /= 0 then + Start := Natural (Start_Raw); + Finish := Natural (Finish_Raw); + end if; + return Result /= 0; + end Get_Selection; + + + + + function Has_Selection + (This : in Text_Buffer) + return Boolean is + begin + return fl_text_buffer_selected (This.Void_Ptr) /= 0; + end Has_Selection; + + + + + function Skip_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_buffer_skip_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Skip_Lines; + + + + + function Rewind_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_buffer_rewind_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Rewind_Lines; + + + + + function Character_At + (This : in Text_Buffer; + Pos : in Natural) + return Character is + begin + return Character'Val (fl_text_buffer_char_at + (This.Void_Ptr, + Interfaces.C.int (Pos))); + end Character_At; + + + + + function Text_At + (This : in Text_Buffer; + Start, Finish : in Natural) + return String + is + C_Str : Interfaces.C.Strings.chars_ptr := fl_text_buffer_text_range + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + The_Text : String := Interfaces.C.Strings.Value (C_Str); + begin + Interfaces.C.Strings.Free (C_Str); + return The_Text; + end Text_At; + + +end FLTK.Text_Buffers; + diff --git a/src/fltk-text_buffers.ads b/src/fltk-text_buffers.ads new file mode 100644 index 0000000..d3e1bab --- /dev/null +++ b/src/fltk-text_buffers.ads @@ -0,0 +1,180 @@ + + +private with Ada.Containers.Vectors; +private with System.Address_To_Access_Conversions; + + +package FLTK.Text_Buffers is + + + type Text_Buffer is new Wrapper with private; + type Text_Buffer_Cursor (Data : access Text_Buffer'Class) is limited null record + with Implicit_Dereference => Data; + + + type Position is new Natural; + type Modification is (Insert, Restyle, Delete, None); + + + type Modify_Callback is access procedure + (Action : in Modification; + Place : in Position; + Length : in Natural; + Deleted_Text : in String); + + + type Predelete_Callback is access procedure + (Place : in Position; + Length : in Natural); + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer; + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback); + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback); + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer); + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer); + + + procedure Enable_Callbacks + (This : in out Text_Buffer); + + + procedure Disable_Callbacks + (This : in out Text_Buffer); + + + procedure Insert_Text + (This : in out Text_Buffer; + Pos : in Natural; + Item : in String); + + + procedure Remove_Text + (This : in out Text_Buffer; + Start, Finish : in Natural); + + + function Length + (This : in Text_Buffer) + return Natural; + + + procedure Load_File + (This : in Text_Buffer; + Name : in String); + + + procedure Remove_Selected_Text + (This : in out Text_Buffer); + + + procedure Save_File + (This : in Text_Buffer; + Name : in String); + + + function Search_Forward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean; + + + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean; + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural); + + + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean; + + + function Has_Selection + (This : in Text_Buffer) + return Boolean; + + + -- only takes into account newline characters, not word wrap + function Skip_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural; + + + -- only takes into account newline characters, not word wrap + function Rewind_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural; + + + function Character_At + (This : in Text_Buffer; + Pos : in Natural) + return Character; + + + function Text_At + (This : in Text_Buffer; + Start, Finish : in Natural) + return String; + + +private + + + package Modify_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Modify_Callback); + package Predelete_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Predelete_Callback); + + + type Text_Buffer is new Wrapper with + record + CB_Active : Boolean; + Modify_CBs : Modify_Vectors.Vector; + Predelete_CBs : Predelete_Vectors.Vector; + end record; + + + overriding procedure Finalize + (This : in out Text_Buffer); + + + package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); + + +end FLTK.Text_Buffers; + diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb new file mode 100644 index 0000000..7b70f01 --- /dev/null +++ b/src/fltk-widgets-boxes.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Boxes is + + + function new_fl_box + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_box, "new_fl_box"); + + procedure free_fl_box + (B : in System.Address); + pragma Import (C, free_fl_box, "free_fl_box"); + + + + + procedure Finalize + (This : in out Box) is + begin + Finalize (Widget (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Box then + free_fl_box (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Box is + begin + return This : Box do + This.Void_Ptr := new_fl_box + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads new file mode 100644 index 0000000..00f84d4 --- /dev/null +++ b/src/fltk-widgets-boxes.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Boxes is + + + type Box is new Widget with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Box; + + +private + + + type Box is new Widget with null record; + + + overriding procedure Finalize + (This : in out Box); + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb new file mode 100644 index 0000000..bbef830 --- /dev/null +++ b/src/fltk-widgets-buttons-enter.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Enter is + + + function new_fl_return_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_return_button, "new_fl_return_button"); + + procedure free_fl_return_button + (B : in System.Address); + pragma Import (C, free_fl_return_button, "free_fl_return_button"); + + + + + procedure Finalize + (This : in out Enter_Button) is + begin + Finalize (Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Enter_Button then + free_fl_return_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Enter_Button is + begin + return This : Enter_Button do + This.Void_Ptr := new_fl_return_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk-widgets-buttons-enter.ads b/src/fltk-widgets-buttons-enter.ads new file mode 100644 index 0000000..1db7308 --- /dev/null +++ b/src/fltk-widgets-buttons-enter.ads @@ -0,0 +1,29 @@ + + +-- Return Buttons, but return is a reserved word, so they're Enter Buttons instead + + +package FLTK.Widgets.Buttons.Enter is + + + type Enter_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Enter_Button; + + +private + + + type Enter_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Enter_Button); + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb new file mode 100644 index 0000000..7f16c9d --- /dev/null +++ b/src/fltk-widgets-buttons-light-check.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Check is + + + function new_fl_check_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_check_button, "new_fl_check_button"); + + procedure free_fl_check_button + (B : in System.Address); + pragma Import (C, free_fl_check_button, "free_fl_check_button"); + + + + + procedure Finalize + (This : in out Check_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Check_Button then + free_fl_check_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Check_Button is + begin + return This : Check_Button do + This.Void_Ptr := new_fl_check_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk-widgets-buttons-light-check.ads b/src/fltk-widgets-buttons-light-check.ads new file mode 100644 index 0000000..1ab34f0 --- /dev/null +++ b/src/fltk-widgets-buttons-light-check.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Check is + + + type Check_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Check_Button; + + +private + + + type Check_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Check_Button); + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb new file mode 100644 index 0000000..1a741b9 --- /dev/null +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Radio is + + + function new_fl_radio_light_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); + + procedure free_fl_radio_light_button + (B : in System.Address); + pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); + + + + + procedure Finalize + (This : in out Radio_Light_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Radio_Light_Button then + free_fl_radio_light_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Light_Button is + begin + return This : Radio_Light_Button do + This.Void_Ptr := new_fl_radio_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk-widgets-buttons-light-radio.ads b/src/fltk-widgets-buttons-light-radio.ads new file mode 100644 index 0000000..bad0a92 --- /dev/null +++ b/src/fltk-widgets-buttons-light-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Radio is + + + type Radio_Light_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Light_Button; + + +private + + + type Radio_Light_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Light_Button); + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb new file mode 100644 index 0000000..c61430f --- /dev/null +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round.Radio is + + + function new_fl_radio_round_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); + + procedure free_fl_radio_round_button + (B : in System.Address); + pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); + + + + + procedure Finalize + (This : in out Radio_Round_Button) is + begin + Finalize (Round_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Radio_Round_Button then + free_fl_radio_round_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Round_Button is + begin + return This : Radio_Round_Button do + This.Void_Ptr := new_fl_radio_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk-widgets-buttons-light-round-radio.ads b/src/fltk-widgets-buttons-light-round-radio.ads new file mode 100644 index 0000000..ad1eec7 --- /dev/null +++ b/src/fltk-widgets-buttons-light-round-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Round.Radio is + + + type Radio_Round_Button is new Round_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Round_Button; + + +private + + + type Radio_Round_Button is new Round_Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb new file mode 100644 index 0000000..8be6a4e --- /dev/null +++ b/src/fltk-widgets-buttons-light-round.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round is + + + function new_fl_round_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_round_button, "new_fl_round_button"); + + procedure free_fl_round_button + (B : in System.Address); + pragma Import (C, free_fl_round_button, "free_fl_round_button"); + + + + + procedure Finalize + (This : in out Round_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Round_Button then + free_fl_round_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Round_Button is + begin + return This : Round_Button do + This.Void_Ptr := new_fl_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk-widgets-buttons-light-round.ads b/src/fltk-widgets-buttons-light-round.ads new file mode 100644 index 0000000..7cb99b8 --- /dev/null +++ b/src/fltk-widgets-buttons-light-round.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Round is + + + type Round_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Round_Button; + + +private + + + type Round_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb new file mode 100644 index 0000000..cefc9ef --- /dev/null +++ b/src/fltk-widgets-buttons-light.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light is + + + function new_fl_light_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_light_button, "new_fl_light_button"); + + procedure free_fl_light_button + (B : in System.Address); + pragma Import (C, free_fl_light_button, "free_fl_light_button"); + + + + + procedure Finalize + (This : in out Light_Button) is + begin + Finalize (Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Light_Button then + free_fl_light_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Light_Button is + begin + return This : Light_Button do + This.Void_Ptr := new_fl_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk-widgets-buttons-light.ads b/src/fltk-widgets-buttons-light.ads new file mode 100644 index 0000000..6fe7a76 --- /dev/null +++ b/src/fltk-widgets-buttons-light.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light is + + + type Light_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Light_Button; + + +private + + + type Light_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Light_Button); + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb new file mode 100644 index 0000000..d3fd405 --- /dev/null +++ b/src/fltk-widgets-buttons-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Radio is + + + function new_fl_radio_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); + + procedure free_fl_radio_button + (B : in System.Address); + pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); + + + + + procedure Finalize + (This : in out Radio_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Radio_Button then + free_fl_radio_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Button is + begin + return This : Radio_Button do + This.Void_Ptr := new_fl_radio_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk-widgets-buttons-radio.ads b/src/fltk-widgets-buttons-radio.ads new file mode 100644 index 0000000..cf14eeb --- /dev/null +++ b/src/fltk-widgets-buttons-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Radio is + + + type Radio_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Button; + + +private + + + type Radio_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Button); + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb new file mode 100644 index 0000000..8e81a8e --- /dev/null +++ b/src/fltk-widgets-buttons-repeat.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Repeat is + + + function new_fl_repeat_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); + + procedure free_fl_repeat_button + (B : in System.Address); + pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); + + + + + procedure Finalize + (This : in out Repeat_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Repeat_Button then + free_fl_repeat_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Repeat_Button is + begin + return This : Repeat_Button do + This.Void_Ptr := new_fl_repeat_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk-widgets-buttons-repeat.ads b/src/fltk-widgets-buttons-repeat.ads new file mode 100644 index 0000000..5c27b40 --- /dev/null +++ b/src/fltk-widgets-buttons-repeat.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Repeat is + + + type Repeat_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Repeat_Button; + + +private + + + type Repeat_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Repeat_Button); + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb new file mode 100644 index 0000000..9b8ce83 --- /dev/null +++ b/src/fltk-widgets-buttons-toggle.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Toggle is + + + function new_fl_toggle_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); + + procedure free_fl_toggle_button + (B : in System.Address); + pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); + + + + + procedure Finalize + (This : in out Toggle_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Toggle_Button then + free_fl_toggle_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Toggle_Button is + begin + return This : Toggle_Button do + This.Void_Ptr := new_fl_toggle_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk-widgets-buttons-toggle.ads b/src/fltk-widgets-buttons-toggle.ads new file mode 100644 index 0000000..a8f4181 --- /dev/null +++ b/src/fltk-widgets-buttons-toggle.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Toggle is + + + type Toggle_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Toggle_Button; + + +private + + + type Toggle_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Toggle_Button); + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb new file mode 100644 index 0000000..bc79b9c --- /dev/null +++ b/src/fltk-widgets-buttons.adb @@ -0,0 +1,101 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons is + + + function new_fl_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_button, "new_fl_button"); + + procedure free_fl_button + (B : in System.Address); + pragma Import (C, free_fl_button, "free_fl_button"); + + function fl_button_get_state + (B : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_button_get_state, "fl_button_get_state"); + + procedure fl_button_set_state + (B : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_button_set_state, "fl_button_set_state"); + + procedure fl_button_set_only + (B : in System.Address); + pragma Import (C, fl_button_set_only, "fl_button_set_only"); + + + + + procedure Finalize + (This : in out Button) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Button then + free_fl_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Button is + begin + return This : Button do + This.Void_Ptr := new_fl_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_State + (This : in Button) + return State is + begin + return State'Val (fl_button_get_state (This.Void_Ptr)); + end Get_State; + + + + + procedure Set_State + (This : in out Button; + St : in State) is + begin + fl_button_set_state (This.Void_Ptr, State'Pos (St)); + end Set_State; + + + + + procedure Set_Only + (This : in out Button) is + begin + fl_button_set_only (This.Void_Ptr); + end Set_Only; + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads new file mode 100644 index 0000000..403ad1a --- /dev/null +++ b/src/fltk-widgets-buttons.ads @@ -0,0 +1,43 @@ + + +package FLTK.Widgets.Buttons is + + + type Button is new Widget with private; + + + type State is (Off, On); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Button; + + + function Get_State + (This : in Button) + return State; + + + procedure Set_State + (This : in out Button; + St : in State); + + + procedure Set_Only + (This : in out Button); + + +private + + + type Button is new Widget with null record; + + + overriding procedure Finalize + (This : in out Button); + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb new file mode 100644 index 0000000..0172128 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -0,0 +1,145 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + function new_fl_text_editor + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); + + procedure free_fl_text_editor + (TE : in System.Address); + pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + + procedure fl_text_editor_undo + (TE : in System.Address); + pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); + + procedure fl_text_editor_cut + (TE : in System.Address); + pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); + + procedure fl_text_editor_copy + (TE : in System.Address); + pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); + + procedure fl_text_editor_paste + (TE : in System.Address); + pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); + + procedure fl_text_editor_delete + (TE : in System.Address); + pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); + + procedure fl_text_editor_remove_key_binding + (TE : in System.Address; + K : in Interfaces.C.unsigned; + M : in Interfaces.C.unsigned_long); + pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); + + + + + procedure Finalize + (This : in out Text_Editor) is + begin + Finalize (Text_Display (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Text_Editor then + free_fl_text_editor (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Editor is + begin + return This : Text_Editor do + This.Void_Ptr := new_fl_text_editor + (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)); + end return; + end Create; + + + + + procedure Undo + (This : in out Text_Editor) is + begin + fl_text_editor_undo (This.Void_Ptr); + end Undo; + + + + + procedure Cut + (This : in out Text_Editor) is + begin + fl_text_editor_cut (This.Void_Ptr); + end Cut; + + + + + procedure Copy + (This : in out Text_Editor) is + begin + fl_text_editor_copy (This.Void_Ptr); + end Copy; + + + + + procedure Paste + (This : in out Text_Editor) is + begin + fl_text_editor_paste (This.Void_Ptr); + end Paste; + + + + + procedure Delete + (This : in out Text_Editor) is + begin + fl_text_editor_delete (This.Void_Ptr); + end Delete; + + + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key) + is + use type Interfaces.C.unsigned_long; + begin + fl_text_editor_remove_key_binding + (This.Void_Ptr, + Character'Pos (Key.Keypress), + Interfaces.C.unsigned_long (Key.Modifier) * 65536); + end Remove_Key_Binding; + + +end FLTK.Widgets.Groups.Text_Displays.Text_Editors; + diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads new file mode 100644 index 0000000..d4c9b85 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -0,0 +1,54 @@ + + +with FLTK.Enums; use FLTK.Enums; + + +package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + type Text_Editor is new Text_Display with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Editor; + + + procedure Undo + (This : in out Text_Editor); + + + procedure Cut + (This : in out Text_Editor); + + + procedure Copy + (This : in out Text_Editor); + + + procedure Paste + (This : in out Text_Editor); + + + procedure Delete + (This : in out Text_Editor); + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key); + + +private + + + type Text_Editor is new Text_Display with null record; + + + overriding procedure Finalize + (This : in out Text_Editor); + + +end FLTK.Widgets.Groups.Text_Displays.Text_Editors; + diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb new file mode 100644 index 0000000..1aa5962 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays.adb @@ -0,0 +1,327 @@ + + +with Interfaces.C; +with System; +with FLTK.Text_Buffers; +use type System.Address; + + +package body FLTK.Widgets.Groups.Text_Displays is + + + function new_fl_text_display + (X, Y, W, H : in Interfaces.C.int; + Label : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_text_display, "new_fl_text_display"); + + procedure free_fl_text_display + (TD : in System.Address); + pragma Import (C, free_fl_text_display, "free_fl_text_display"); + + function fl_text_display_get_buffer + (TD : in System.Address) + return System.Address; + pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); + + procedure fl_text_display_set_buffer + (TD, TB : in System.Address); + pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); + + function fl_text_display_get_text_color + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); + + procedure fl_text_display_set_text_color + (TD : in System.Address; + C : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); + + function fl_text_display_get_text_font + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); + + procedure fl_text_display_set_text_font + (TD : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); + + function fl_text_display_get_text_size + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); + + procedure fl_text_display_set_text_size + (TD : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); + + function fl_text_display_get_insert_pos + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); + + procedure fl_text_display_set_insert_pos + (TD : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); + + procedure fl_text_display_show_insert_pos + (TD : in System.Address); + pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); + + procedure fl_text_display_next_word + (TD : in System.Address); + pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); + + procedure fl_text_display_previous_word + (TD : in System.Address); + pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); + + procedure fl_text_display_wrap_mode + (TD : in System.Address; + W, M : in Interfaces.C.int); + pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); + + function fl_text_display_skip_lines + (TD : in System.Address; + S, L, P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_skip_lines, "fl_text_display_skip_lines"); + + function fl_text_display_rewind_lines + (TD : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); + + procedure fl_text_display_linenumber_width + (TD : in System.Address; + W : in Interfaces.C.int); + pragma Import (C, fl_text_display_linenumber_width, "fl_text_display_linenumber_width"); + + + + + procedure Finalize + (This : in out Text_Display) is + begin + Finalize (Group (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Text_Display then + free_fl_text_display (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Display is + begin + return This : Text_Display do + This.Void_Ptr := new_fl_text_display + (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)); + end return; + end Create; + + + + + function Get_Buffer + (This : in Text_Display) + return FLTK.Text_Buffers.Text_Buffer_Cursor is + begin + return Ref : FLTK.Text_Buffers.Text_Buffer_Cursor (This.Buffer); + end Get_Buffer; + + + + + procedure Set_Buffer + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer) is + begin + This.Buffer := Buff'Unchecked_Access; + fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr); + end Set_Buffer; + + + + + function Get_Text_Color + (This : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_text_color (This.Void_Ptr)); + end Get_Text_Color; + + + + + procedure Set_Text_Color + (This : in out Text_Display; + Col : in Color) is + begin + fl_text_display_set_text_color (This.Void_Ptr, Interfaces.C.int (Col)); + end Set_Text_Color; + + + + + function Get_Text_Font + (This : in Text_Display) + return Font_Kind is + begin + return Font_Kind'Val (fl_text_display_get_text_font (This.Void_Ptr)); + end Get_Text_Font; + + + + + procedure Set_Text_Font + (This : in out Text_Display; + Font : in Font_Kind) is + begin + fl_text_display_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Text_Font; + + + + + function Get_Text_Size + (This : in Text_Display) + return Font_Size is + begin + return Font_Size (fl_text_display_get_text_size (This.Void_Ptr)); + end Get_Text_Size; + + + + + procedure Set_Text_Size + (This : in out Text_Display; + Size : in Font_Size) is + begin + fl_text_display_set_text_size (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Text_Size; + + + + + function Get_Insert_Position + (This : in Text_Display) + return Natural is + begin + return Natural (fl_text_display_get_insert_pos (This.Void_Ptr)); + end Get_Insert_Position; + + + + + procedure Set_Insert_Position + (This : in out Text_Display; + Pos : in Natural) is + begin + fl_text_display_set_insert_pos (This.Void_Ptr, Interfaces.C.int (Pos)); + end Set_Insert_Position; + + + + + procedure Show_Insert_Position + (This : in out Text_Display) is + begin + fl_text_display_show_insert_pos (This.Void_Ptr); + end Show_Insert_Position; + + + + + procedure Next_Word + (This : in out Text_Display) is + begin + fl_text_display_next_word (This.Void_Ptr); + end Next_Word; + + + + + procedure Previous_Word + (This : in out Text_Display) is + begin + fl_text_display_previous_word (This.Void_Ptr); + end Previous_Word; + + + + + procedure Set_Wrap_Mode + (This : in out Text_Display; + Mode : in Wrap_Mode; + Margin : in Natural := 0) is + begin + fl_text_display_wrap_mode + (This.Void_Ptr, + Wrap_Mode'Pos (Mode), + Interfaces.C.int (Margin)); + end Set_Wrap_Mode; + + + + + function Skip_Lines + (This : in out Text_Display; + Start, Lines : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural is + begin + return Natural (fl_text_display_skip_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines), + Boolean'Pos (Start_Pos_Is_Line_Start))); + end Skip_Lines; + + + + + function Rewind_Lines + (This : in out Text_Display; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_display_rewind_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Rewind_Lines; + + + + + procedure Set_Linenumber_Width + (This : in out Text_Display; + Width : in Natural) is + begin + fl_text_display_linenumber_width + (This.Void_Ptr, + Interfaces.C.int (Width)); + end Set_Linenumber_Width; + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk-widgets-groups-text_displays.ads b/src/fltk-widgets-groups-text_displays.ads new file mode 100644 index 0000000..0e136ff --- /dev/null +++ b/src/fltk-widgets-groups-text_displays.ads @@ -0,0 +1,124 @@ + + +with FLTK.Text_Buffers; +with FLTK.Enums; use FLTK.Enums; + + +package FLTK.Widgets.Groups.Text_Displays is + + + type Text_Display is new Group with private; + + + type Wrap_Mode is (Wrap_None, Wrap_At_Column, Wrap_At_Pixel, Wrap_At_Bounds); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Display; + + + function Get_Buffer + (This : in Text_Display) + return FLTK.Text_Buffers.Text_Buffer_Cursor; + + + procedure Set_Buffer + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer); + + + function Get_Text_Color + (This : in Text_Display) + return Color; + + + procedure Set_Text_Color + (This : in out Text_Display; + Col : in Color); + + + function Get_Text_Font + (This : in Text_Display) + return Font_Kind; + + + procedure Set_Text_Font + (This : in out Text_Display; + Font : in Font_Kind); + + + function Get_Text_Size + (This : in Text_Display) + return Font_Size; + + + procedure Set_Text_Size + (This : in out Text_Display; + Size : in Font_Size); + + + function Get_Insert_Position + (This : in Text_Display) + return Natural; + + + procedure Set_Insert_Position + (This : in out Text_Display; + Pos : in Natural); + + + procedure Show_Insert_Position + (This : in out Text_Display); + + + procedure Next_Word + (This : in out Text_Display); + + + procedure Previous_Word + (This : in out Text_Display); + + + procedure Set_Wrap_Mode + (This : in out Text_Display; + Mode : in Wrap_Mode; + Margin : in Natural := 0); + + + -- takes into account word wrap as well as newline characters + function Skip_Lines + (This : in out Text_Display; + Start, Lines : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural; + + + -- takes into account word wrap as well as newline characters + function Rewind_Lines + (This : in out Text_Display; + Start, Lines : in Natural) + return Natural; + + + procedure Set_Linenumber_Width + (This : in out Text_Display; + Width : in Natural); + + +private + + + type Text_Display is new Group with + record + Buffer : access FLTK.Text_Buffers.Text_Buffer; + end record; + + + overriding procedure Finalize + (This : in out Text_Display); + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb new file mode 100644 index 0000000..407c018 --- /dev/null +++ b/src/fltk-widgets-groups-windows-double.adb @@ -0,0 +1,108 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows.Double is + + + function new_fl_double_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_double_window, "new_fl_double_window"); + + function new_fl_double_window2 + (X, Y : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); + + procedure free_fl_double_window + (W : in System.Address); + pragma Import (C, free_fl_double_window, "free_fl_double_window"); + + procedure fl_double_window_show + (W : in System.Address); + pragma Import (C, fl_double_window_show, "fl_double_window_show"); + + procedure fl_double_window_hide + (W : in System.Address); + pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); + + + + + procedure Finalize + (This : in out Double_Window) is + begin + Finalize (Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Double_Window then + free_fl_double_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Double_Window is + begin + return This : Double_Window do + This.Void_Ptr := new_fl_double_window + (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)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Double_Window is + begin + return This : Double_Window do + This.Void_Ptr := new_fl_double_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Double_Window) is + begin + fl_double_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Double_Window) is + begin + fl_double_window_hide (This.Void_Ptr); + end Hide; + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk-widgets-groups-windows-double.ads b/src/fltk-widgets-groups-windows-double.ads new file mode 100644 index 0000000..214f698 --- /dev/null +++ b/src/fltk-widgets-groups-windows-double.ads @@ -0,0 +1,39 @@ + + +package FLTK.Widgets.Groups.Windows.Double is + + + type Double_Window is new Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Double_Window; + + + function Create + (W, H : in Integer) + return Double_Window; + + + procedure Show + (This : in Double_Window); + + + procedure Hide + (This : in Double_Window); + + +private + + + type Double_Window is new Window with null record; + + + overriding procedure Finalize + (This : in out Double_Window); + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb new file mode 100644 index 0000000..8345308 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -0,0 +1,158 @@ + + +with Interfaces.C; +with System; +use type System.Address; +use type Interfaces.C.unsigned; + + +package body FLTK.Widgets.Groups.Windows.Single.Menu is + + + function new_fl_menu_window + (X, Y, W, H : in Interfaces.C.int; + Label : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_window, "new_fl_menu_window"); + + function new_fl_menu_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2"); + + procedure free_fl_menu_window + (M : in System.Address); + pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); + + procedure fl_menu_window_show + (M : in System.Address); + pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); + + procedure fl_menu_window_hide + (M : in System.Address); + pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide"); + + procedure fl_menu_window_flush + (M : in System.Address); + pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); + + procedure fl_menu_window_set_overlay + (M : in System.Address); + pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay"); + + procedure fl_menu_window_clear_overlay + (M : in System.Address); + pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay"); + + function fl_menu_window_overlay + (M : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); + + + + + procedure Finalize + (This : in out Menu_Window) is + begin + Finalize (Single_Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Window then + free_fl_menu_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Window is + begin + return This : Menu_Window do + This.Void_Ptr := new_fl_menu_window + (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)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Menu_Window is + begin + return This : Menu_Window do + This.Void_Ptr := new_fl_menu_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Menu_Window) is + begin + fl_menu_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Menu_Window) is + begin + fl_menu_window_hide (This.Void_Ptr); + end Hide; + + + + + procedure Flush + (This : in out Menu_Window) is + begin + fl_menu_window_flush (This.Void_Ptr); + end Flush; + + + + + function Get_Overlay + (This : in Menu_Window) + return Boolean is + begin + return fl_menu_window_overlay (This.Void_Ptr) /= 0; + end Get_Overlay; + + + + procedure Set_Overlay + (This : in out Menu_Window; + Value : in Boolean) is + begin + if Value then + fl_menu_window_set_overlay (This.Void_Ptr); + else + fl_menu_window_clear_overlay (This.Void_Ptr); + end if; + end Set_Overlay; + + +end FLTK.Widgets.Groups.Windows.Single.Menu; + diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads new file mode 100644 index 0000000..f5d88e7 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single-menu.ads @@ -0,0 +1,53 @@ + + +package FLTK.Widgets.Groups.Windows.Single.Menu is + + + type Menu_Window is new Single_Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Window; + + + function Create + (W, H : in Integer) + return Menu_Window; + + + procedure Show + (This : in Menu_Window); + + + procedure Hide + (This : in Menu_Window); + + + procedure Flush + (This : in out Menu_Window); + + + function Get_Overlay + (This : in Menu_Window) + return Boolean; + + + procedure Set_Overlay + (This : in out Menu_Window; + Value : in Boolean); + + +private + + + type Menu_Window is new Single_Window with null record; + + + overriding procedure Finalize + (This : in out Menu_Window); + + +end FLTK.Widgets.Groups.Windows.Single.Menu; + diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb new file mode 100644 index 0000000..16c5f44 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single.adb @@ -0,0 +1,108 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows.Single is + + + function new_fl_single_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_single_window, "new_fl_single_window"); + + function new_fl_single_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_single_window2, "new_fl_single_window2"); + + procedure free_fl_single_window + (S : in System.Address); + pragma Import (C, free_fl_single_window, "free_fl_single_window"); + + procedure fl_single_window_show + (S : in System.Address); + pragma Import (C, fl_single_window_show, "fl_single_window_show"); + + procedure fl_single_window_flush + (S : in System.Address); + pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); + + + + + procedure Finalize + (This : in out Single_Window) is + begin + Finalize (Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Single_Window then + free_fl_single_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Single_Window is + begin + return This : Single_Window do + This.Void_Ptr := new_fl_single_window + (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)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Single_Window is + begin + return This : Single_Window do + This.Void_Ptr := new_fl_single_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Single_Window) is + begin + fl_single_window_show (This.Void_Ptr); + end Show; + + + + + procedure Flush + (This : in out Single_Window) is + begin + fl_single_window_flush (This.Void_Ptr); + end Flush; + + +end FLTK.Widgets.Groups.Windows.Single; + diff --git a/src/fltk-widgets-groups-windows-single.ads b/src/fltk-widgets-groups-windows-single.ads new file mode 100644 index 0000000..07a2bca --- /dev/null +++ b/src/fltk-widgets-groups-windows-single.ads @@ -0,0 +1,39 @@ + + +package FLTK.Widgets.Groups.Windows.Single is + + + type Single_Window is new Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Single_Window; + + + function Create + (W, H : in Integer) + return Single_Window; + + + procedure Show + (This : in Single_Window); + + + procedure Flush + (This : in out Single_Window); + + +private + + + type Single_Window is new Window with null record; + + + overriding procedure Finalize + (This : in out Single_Window); + + +end FLTK.Widgets.Groups.Windows.Single; + diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb new file mode 100644 index 0000000..2d93bdd --- /dev/null +++ b/src/fltk-widgets-groups-windows.adb @@ -0,0 +1,191 @@ + + +with Interfaces.C; +with System; +with FLTK.Images.RGB; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows is + + + function new_fl_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_window, "new_fl_window"); + + function new_fl_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_window2, "new_fl_window2"); + + procedure free_fl_window + (W : in System.Address); + pragma Import (C, free_fl_window, "free_fl_window"); + + procedure fl_window_show + (W : in System.Address); + pragma Import (C, fl_window_show, "fl_window_show"); + + procedure fl_window_hide + (W : in System.Address); + pragma Import (C, fl_window_hide, "fl_window_hide"); + + procedure fl_window_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_window_set_label, "fl_window_set_label"); + + procedure fl_window_size_range + (W : in System.Address; + LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); + pragma Import (C, fl_window_size_range, "fl_window_size_range"); + + procedure fl_window_set_icon + (W, P : in System.Address); + pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); + + procedure fl_window_set_modal + (W : in System.Address); + pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); + + procedure fl_window_set_non_modal + (W : in System.Address); + pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); + + + + + procedure Finalize + (This : in out Window) is + begin + Finalize (Group (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Window then + free_fl_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Window is + begin + return This : Window do + This.Void_Ptr := new_fl_window + (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)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Window is + begin + return This : Window do + This.Void_Ptr := new_fl_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Window) is + begin + fl_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Window) is + begin + fl_window_hide (This.Void_Ptr); + end Hide; + + + + + procedure Set_Label + (This : in out Window; + Text : in String) is + begin + fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + + + + procedure Set_Size_Range + (This : in out Window; + Min_W, Min_H : in Integer; + Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; + Keep_Aspect : in Boolean := False) is + begin + fl_window_size_range + (This.Void_Ptr, + Interfaces.C.int (Min_W), + Interfaces.C.int (Min_H), + Interfaces.C.int (Max_W), + Interfaces.C.int (Max_H), + Interfaces.C.int (Incre_W), + Interfaces.C.int (Incre_H), + Boolean'Pos (Keep_Aspect)); + end Set_Size_Range; + + + + + procedure Set_Icon + (This : in out Window; + Pic : in out FLTK.Images.RGB.RGB_Image'Class) is + begin + fl_window_set_icon + (This.Void_Ptr, + Wrapper (Pic).Void_Ptr); + end Set_Icon; + + + + + procedure Set_Modal + (This : in out Window) is + begin + fl_window_set_modal (This.Void_Ptr); + end Set_Modal; + + + + + procedure Set_Non_Modal + (This : in out Window) is + begin + fl_window_set_non_modal (This.Void_Ptr); + end Set_Non_Modal; + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads new file mode 100644 index 0000000..96047ee --- /dev/null +++ b/src/fltk-widgets-groups-windows.ads @@ -0,0 +1,67 @@ + + +with FLTK.Images.RGB; + + +package FLTK.Widgets.Groups.Windows is + + + type Window is new Group with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Window; + + + function Create + (W, H : in Integer) + return Window; + + + procedure Show + (This : in Window); + + + procedure Hide + (This : in Window); + + + procedure Set_Label + (This : in out Window; + Text : in String); + + + procedure Set_Size_Range + (This : in out Window; + Min_W, Min_H : in Integer; + Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; + Keep_Aspect : in Boolean := False); + + + procedure Set_Icon + (This : in out Window; + Pic : in out FLTK.Images.RGB.RGB_Image'Class); + + + procedure Set_Modal + (This : in out Window); + + + procedure Set_Non_Modal + (This : in out Window); + + +private + + + type Window is new Group with null record; + + + overriding procedure Finalize + (This : in out Window); + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb new file mode 100644 index 0000000..067407d --- /dev/null +++ b/src/fltk-widgets-groups.adb @@ -0,0 +1,202 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups is + + + function new_fl_group + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_group, "new_fl_group"); + + procedure free_fl_group + (G : in System.Address); + pragma Import (C, free_fl_group, "free_fl_group"); + + procedure fl_group_add + (G, W : in System.Address); + pragma Import (C, fl_group_add, "fl_group_add"); + + function fl_group_find + (G, W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_find, "fl_group_find"); + + procedure fl_group_insert + (G, W : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_insert, "fl_group_insert"); + + procedure fl_group_remove + (G, W : in System.Address); + pragma Import (C, fl_group_remove, "fl_group_remove"); + + procedure fl_group_remove2 + (G : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_remove2, "fl_group_remove2"); + + function fl_group_children + (G : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_children, "fl_group_children"); + + function fl_group_child + (G : in System.Address; + I : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_group_child, "fl_group_child"); + + procedure fl_group_resizable + (G, W : in System.Address); + pragma Import (C, fl_group_resizable, "fl_group_resizable"); + + + + + procedure Finalize + (This : in out Group) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + This.Clear; + if This in Group then + free_fl_group (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Group is + begin + return This : Group do + This.Void_Ptr := new_fl_group + (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)); + end return; + end Create; + + + + + procedure Add + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_add (This.Void_Ptr, Item.Void_Ptr); + end Add; + + + + + function Child + (This : in Group; + Place : in Index) + return access Widget'Class + is + Widget_Ptr : System.Address := + fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); + + Actual_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + begin + return Actual_Widget; + end Child; + + + + + function Number_Of_Children + (This : in Group) + return Natural is + begin + return Natural (fl_group_children (This.Void_Ptr)); + end Number_Of_Children; + + + + + procedure Clear + (This : in out Group) is + begin + for I in reverse 1 .. This.Number_Of_Children loop + This.Remove (Index (I)); + end loop; + end Clear; + + + + + function Find + (This : in Group; + Item : in out Widget'Class) + return Index is + begin + -- should set this up to throw an exception if not found + return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); + end Find; + + + + + procedure Insert + (This : in out Group; + Item : in out Widget'Class; + Place : in Index) is + begin + fl_group_insert + (This.Void_Ptr, + Item.Void_Ptr, + Interfaces.C.int (Place)); + end Insert; + + + + + procedure Remove + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_remove (This.Void_Ptr, Item.Void_Ptr); + end Remove; + + + + + procedure Remove + (This : in out Group; + Place : in Index) is + begin + fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); + end Remove; + + + + + procedure Set_Resizable + (This : in out Group; + Item : in Widget'Class) is + begin + fl_group_resizable (This.Void_Ptr, Item.Void_Ptr); + end Set_Resizable; + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads new file mode 100644 index 0000000..57faf87 --- /dev/null +++ b/src/fltk-widgets-groups.ads @@ -0,0 +1,82 @@ + + +private with System; + + +package FLTK.Widgets.Groups is + + + type Group is new Widget with private; + type Index is new Positive; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Group; + + + procedure Add + (This : in out Group; + Item : in out Widget'Class); + + + function Child + (This : in Group; + Place : in Index) + return access Widget'Class; + + + function Number_Of_Children + (This : in Group) + return Natural; + + + procedure Clear + (This : in out Group); + + + function Find + (This : in Group; + Item : in out Widget'Class) + return Index; + + + procedure Insert + (This : in out Group; + Item : in out Widget'Class; + Place : in Index); + + + procedure Remove + (This : in out Group; + Item : in out Widget'Class); + + + procedure Remove + (This : in out Group; + Place : in Index); + + + procedure Set_Resizable + (This : in out Group; + Item : in Widget'Class); + + +private + + + type Group is new Widget with null record; + + + overriding procedure Finalize + (This : in out Group); + + + procedure fl_group_end + (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk-widgets-inputs-int.adb b/src/fltk-widgets-inputs-int.adb new file mode 100644 index 0000000..30f3d01 --- /dev/null +++ b/src/fltk-widgets-inputs-int.adb @@ -0,0 +1,75 @@ + + +with Interfaces.C.Strings; +with System; +use type System.Address; + + +package body FLTK.Widgets.Inputs.Int is + + + function new_fl_int_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_int_input, "new_fl_int_input"); + + procedure free_fl_int_input + (F : in System.Address); + pragma Import (C, free_fl_int_input, "free_fl_int_input"); + + function fl_int_input_get_value + (F : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_int_input_get_value, "fl_int_input_get_value"); + + + + + procedure Finalize + (This : in out Integer_Input) is + begin + Finalize (Input (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Integer_Input then + free_fl_int_input (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Integer_Input is + begin + return This : Integer_Input do + This.Void_Ptr := new_fl_int_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_Value + (This : in Integer_Input) + return Integer is + begin + return Integer'Value + (Interfaces.C.Strings.Value + (fl_int_input_get_value (This.Void_Ptr))); + end Get_Value; + + +end FLTK.Widgets.Inputs.Int; + diff --git a/src/fltk-widgets-inputs-int.ads b/src/fltk-widgets-inputs-int.ads new file mode 100644 index 0000000..2777f54 --- /dev/null +++ b/src/fltk-widgets-inputs-int.ads @@ -0,0 +1,31 @@ + + +package FLTK.Widgets.Inputs.Int is + + + type Integer_Input is new Input with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Integer_Input; + + + function Get_Value + (This : in Integer_Input) + return Integer; + + +private + + + type Integer_Input is new Input with null record; + + + overriding procedure Finalize + (This : in out Integer_Input); + + +end FLTK.Widgets.Inputs.Int; + diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb new file mode 100644 index 0000000..9af8e87 --- /dev/null +++ b/src/fltk-widgets-inputs.adb @@ -0,0 +1,74 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +with System; +use type System.Address; + + +package body FLTK.Widgets.Inputs is + + + function new_fl_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_input, "new_fl_input"); + + procedure free_fl_input + (F : in System.Address); + pragma Import (C, free_fl_input, "free_fl_input"); + + function fl_input_get_value + (F : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_input_get_value, "fl_input_get_value"); + + + + + procedure Finalize + (This : in out Input) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Input then + free_fl_input (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Input is + begin + return This : Input do + This.Void_Ptr := new_fl_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_Value + (This : in Input) + return String is + begin + return Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr)); + end Get_Value; + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads new file mode 100644 index 0000000..0f818ac --- /dev/null +++ b/src/fltk-widgets-inputs.ads @@ -0,0 +1,31 @@ + + +package FLTK.Widgets.Inputs is + + + type Input is new Widget with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Input; + + + function Get_Value + (This : in Input) + return String; + + +private + + + type Input is new Widget with null record; + + + overriding procedure Finalize + (This : in out Input); + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb new file mode 100644 index 0000000..19d44e0 --- /dev/null +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Menus.Menu_Bars is + + + function new_fl_menu_bar + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar"); + + procedure free_fl_menu_bar + (M : in System.Address); + pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); + + + + + procedure Finalize + (This : in out Menu_Bar) is + begin + Finalize (Menu (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Bar then + free_fl_menu_bar (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Bar is + begin + return This : Menu_Bar do + This.Void_Ptr := new_fl_menu_bar + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Menus.Menu_Bars; + diff --git a/src/fltk-widgets-menus-menu_bars.ads b/src/fltk-widgets-menus-menu_bars.ads new file mode 100644 index 0000000..0f975b3 --- /dev/null +++ b/src/fltk-widgets-menus-menu_bars.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Menus.Menu_Bars is + + + type Menu_Bar is new Menu with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Bar; + + +private + + + type Menu_Bar is new Menu with null record; + + + overriding procedure Finalize + (This : in out Menu_Bar); + + +end FLTK.Widgets.Menus.Menu_Bars; + diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb new file mode 100644 index 0000000..8347099 --- /dev/null +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -0,0 +1,73 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Menus.Menu_Buttons is + + + function new_fl_menu_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_button, "new_fl_menu_button"); + + procedure free_fl_menu_button + (M : in System.Address); + pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); + + procedure fl_menu_button_type + (M : in System.Address; + T : in Interfaces.C.unsigned); + pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); + + + + + procedure Finalize + (This : in out Menu_Button) is + begin + Finalize (Menu (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Button then + free_fl_menu_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Button is + begin + return This : Menu_Button do + This.Void_Ptr := new_fl_menu_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Set_Popup_Kind + (This : in out Menu_Button; + Pop : in Popup_Buttons) is + begin + fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop)); + end Set_Popup_Kind; + + +end FLTK.Widgets.Menus.Menu_Buttons; + diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads new file mode 100644 index 0000000..5527abc --- /dev/null +++ b/src/fltk-widgets-menus-menu_buttons.ads @@ -0,0 +1,35 @@ + + +package FLTK.Widgets.Menus.Menu_Buttons is + + + type Menu_Button is new Menu with private; + + + -- signifies which mouse buttons cause the menu to appear + type Popup_Buttons is (No_Popup, Popup1, Popup2, Popup12, Popup3, Popup13, Popup23, Popup123); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Button; + + + procedure Set_Popup_Kind + (This : in out Menu_Button; + Pop : in Popup_Buttons); + + +private + + + type Menu_Button is new Menu with null record; + + + overriding procedure Finalize + (This : in out Menu_Button); + + +end FLTK.Widgets.Menus.Menu_Buttons; + diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb new file mode 100644 index 0000000..b92f0a1 --- /dev/null +++ b/src/fltk-widgets-menus.adb @@ -0,0 +1,160 @@ + + +with FLTK.Enums; use FLTK.Enums; +with Interfaces.C; +with System; +use type System.Address; +use type Interfaces.C.int; +use type Interfaces.C.unsigned_long; + + +package body FLTK.Widgets.Menus is + + + function "+" + (Left, Right : in Menu_Flag) + return Menu_Flag is + begin + return Left or Right; + end "+"; + + + + + function fl_menu_add + (M : in System.Address; + T : in Interfaces.C.char_array; + S : in Interfaces.C.unsigned_long; + C, U : in System.Address; + F : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, fl_menu_add, "fl_menu_add"); + + function fl_menu_find_item + (M : in System.Address; + T : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); + + function fl_menu_mvalue + (M : in System.Address) + return System.Address; + pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); + + function fl_menuitem_value + (MI : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menuitem_value, "fl_menuitem_value"); + + procedure fl_menuitem_activate + (MI : in System.Address); + pragma Import (C, fl_menuitem_activate, "fl_menuitem_activate"); + + procedure fl_menuitem_deactivate + (MI : in System.Address); + pragma Import (C, fl_menuitem_deactivate, "fl_menuitem_deactivate"); + + + + + procedure Item_Hook (M, U : in System.Address); + pragma Convention (C, Item_Hook); + + procedure Item_Hook + (M, U : in System.Address) + is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); + Action : Widget_Callback := Callback_Convert.To_Pointer (U); + begin + Action.all (Ada_Widget.all); + end Item_Hook; + + + + + procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal) + is + Place : Interfaces.C.int; + Callback, User_Data : System.Address; + begin + if Action = null then + Callback := System.Null_Address; + User_Data := System.Null_Address; + else + Callback := Item_Hook'Address; + User_Data := Callback_Convert.To_Address (Action); + end if; + + Place := fl_menu_add + (This.Void_Ptr, + Interfaces.C.To_C (Text), + Key_To_C (Shortcut), + Callback, + User_Data, + Interfaces.C.unsigned_long (Flags)); + end Add; + + + + + function Find_Item + (This : in Menu'Class; + Name : in String) + return Menu_Item is + begin + return Item : Menu_Item do + Item.Void_Ptr := fl_menu_find_item + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + end return; + end Find_Item; + + + + + function Chosen + (This : in Menu'Class) + return Menu_Item is + begin + return Item : Menu_Item do + Item.Void_Ptr := fl_menu_mvalue (This.Void_Ptr); + end return; + end Chosen; + + + + + function Value + (Item : in Menu_Item) + return Boolean is + begin + return fl_menuitem_value (Item.Void_Ptr) /= 0; + end Value; + + + + + procedure Activate + (Item : in Menu_Item) is + begin + fl_menuitem_activate (Item.Void_Ptr); + end Activate; + + + + + procedure Deactivate + (Item : in Menu_Item) is + begin + fl_menuitem_deactivate (Item.Void_Ptr); + end Deactivate; + + +end FLTK.Widgets.Menus; + diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads new file mode 100644 index 0000000..d01f02e --- /dev/null +++ b/src/fltk-widgets-menus.ads @@ -0,0 +1,97 @@ + + +with FLTK.Enums; use FLTK.Enums; +private with Interfaces; +private with System; + + +package FLTK.Widgets.Menus is + + + type Menu is abstract new Widget with private; + type Menu_Cursor (Data : access Menu'Class) is limited null record + with Implicit_Dereference => Data; + + + type Menu_Item is tagged limited private; + + + type Index is new Positive; + + + type Menu_Flag is private; + function "+" (Left, Right : in Menu_Flag) return Menu_Flag; + Flag_Normal : constant Menu_Flag; + Flag_Inactive : constant Menu_Flag; + Flag_Toggle : constant Menu_Flag; + Flag_Value : constant Menu_Flag; + Flag_Radio : constant Menu_Flag; + Flag_Invisible : constant Menu_Flag; + Flag_Submenu : constant Menu_Flag; + Flag_Divider : constant Menu_Flag; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu is abstract; + + + procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal); + + + function Find_Item + (This : in Menu'Class; + Name : in String) + return Menu_Item; + + + function Chosen + (This : in Menu'Class) + return Menu_Item; + + + function Value + (Item : in Menu_Item) + return Boolean; + + + procedure Activate + (Item : in Menu_Item); + + + procedure Deactivate + (Item : in Menu_Item); + + +private + + + type Menu is abstract new Widget with null record; + + + type Menu_Item is tagged limited + record + Void_Ptr : System.Address; + end record; + + + type Menu_Flag is new Interfaces.Unsigned_8; + Flag_Normal : constant Menu_Flag := 2#00000000#; + Flag_Inactive : constant Menu_Flag := 2#00000001#; + Flag_Toggle : constant Menu_Flag := 2#00000010#; + Flag_Value : constant Menu_Flag := 2#00000100#; + Flag_Radio : constant Menu_Flag := 2#00001000#; + Flag_Invisible : constant Menu_Flag := 2#00010000#; + -- Flag_Submenu_Pointer unlikely to be used + Flag_Submenu : constant Menu_Flag := 2#01000000#; + Flag_Divider : constant Menu_Flag := 2#10000000#; + + +end FLTK.Widgets.Menus; + diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb new file mode 100644 index 0000000..9ec2350 --- /dev/null +++ b/src/fltk-widgets.adb @@ -0,0 +1,352 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +with System; +with System.Address_To_Access_Conversions; +with FLTK.Widgets.Groups; +with FLTK.Images; +use type System.Address; + + +package body FLTK.Widgets is + + + package Group_Convert is new + System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); + + + + + function fl_widget_get_box + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); + + procedure fl_widget_set_box + (W : in System.Address; + B : in Interfaces.C.int); + pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); + + function fl_widget_get_label + (W : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); + + procedure fl_widget_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); + + function fl_widget_get_label_font + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_font, "fl_widget_get_label_font"); + + procedure fl_widget_set_label_font + (W : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_font, "fl_widget_set_label_font"); + + function fl_widget_get_label_size + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_size, "fl_widget_get_label_size"); + + procedure fl_widget_set_label_size + (W : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_size, "fl_widget_set_label_size"); + + function fl_widget_get_label_type + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_type, "fl_widget_get_label_type"); + + procedure fl_widget_set_label_type + (W : in System.Address; + L : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); + + function fl_widget_get_parent + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); + + procedure fl_widget_set_callback + (W, C : in System.Address); + pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); + + function fl_widget_get_x + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_x, "fl_widget_get_x"); + + function fl_widget_get_y + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_y, "fl_widget_get_y"); + + function fl_widget_get_w + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_w, "fl_widget_get_w"); + + function fl_widget_get_h + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_h, "fl_widget_get_h"); + + procedure fl_widget_size + (W : in System.Address; + D, H : in Interfaces.C.int); + pragma Import (C, fl_widget_size, "fl_widget_size"); + + procedure fl_widget_position + (W : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_widget_position, "fl_widget_position"); + + procedure fl_widget_set_image + (W, I : in System.Address); + pragma Import (C, fl_widget_set_image, "fl_widget_set_image"); + + + + + function Parent + (This : in Widget) + return access FLTK.Widgets.Groups.Group'Class + is + Parent_Ptr : System.Address; + Actual_Parent : access FLTK.Widgets.Groups.Group'Class; + begin + Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); + if Parent_Ptr /= System.Null_Address then + Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); + end if; + return Actual_Parent; + end Parent; + + + + + function Get_Box + (This : in Widget) + return Box_Kind is + begin + return Box_Kind'Val (fl_widget_get_box (This.Void_Ptr)); + end Get_Box; + + + + + procedure Set_Box + (This : in out Widget; + Box : in Box_Kind) is + begin + fl_widget_set_box (This.Void_Ptr, Box_Kind'Pos (Box)); + end Set_Box; + + + + + function Get_Label + (This : in out Widget) + return String is + begin + return Interfaces.C.Strings.Value (fl_widget_get_label (This.Void_Ptr)); + end Get_Label; + + + + + procedure Set_Label + (This : in out Widget; + Text : in String) is + begin + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + + + + function Get_Label_Font + (This : in Widget) + return Font_Kind is + begin + return Font_Kind'Val (fl_widget_get_label_font (This.Void_Ptr)); + end Get_Label_Font; + + + + + procedure Set_Label_Font + (This : in out Widget; + Font : in Font_Kind) is + begin + fl_widget_set_label_font (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Label_Font; + + + + + function Get_Label_Size + (This : in Widget) + return Font_Size is + begin + return Font_Size (fl_widget_get_label_size (This.Void_Ptr)); + end Get_Label_Size; + + + + + procedure Set_Label_Size + (This : in out Widget; + Size : in Font_Size) is + begin + fl_widget_set_label_size (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Label_Size; + + + + + function Get_Label_Type + (This : in Widget) + return Label_Kind is + begin + return Label_Kind'Val (fl_widget_get_label_type (This.Void_Ptr)); + end Get_Label_Type; + + + + + procedure Set_Label_Type + (This : in out Widget; + Label : in Label_Kind) is + begin + fl_widget_set_label_type (This.Void_Ptr, Label_Kind'Pos (Label)); + end Set_Label_Type; + + + + + -- this is the part called by FLTK callbacks + -- note that the user data portion is a reference back to the Ada binding + procedure Callback_Hook (W, U : in System.Address); + pragma Convention (C, Callback_Hook); + + procedure Callback_Hook + (W, U : in System.Address) + is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (U); + begin + Ada_Widget.Callback.all (Ada_Widget.all); + end Callback_Hook; + + + + + procedure Set_Callback + (This : in out Widget; + Func : in Widget_Callback) is + begin + if Func /= null then + This.Callback := Func; + fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); + end if; + end Set_Callback; + + + + + function Get_X + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_x (This.Void_Ptr)); + end Get_X; + + + + + function Get_Y + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_y (This.Void_Ptr)); + end Get_Y; + + + + + function Get_W + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_w (This.Void_Ptr)); + end Get_W; + + + + + function Get_H + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_h (This.Void_Ptr)); + end Get_H; + + + + + procedure Resize + (This : in out Widget; + W, H : in Integer) is + begin + fl_widget_size + (This.Void_Ptr, + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer) is + begin + fl_widget_position + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Reposition; + + + + + function Get_Image + (This : in Widget) + return access FLTK.Images.Image'Class is + begin + return This.Current_Image; + end Get_Image; + + + + + procedure Set_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class) is + begin + This.Current_Image := Pic'Unchecked_Access; + fl_widget_set_image + (This.Void_Ptr, + Wrapper (Pic).Void_Ptr); + end Set_Image; + + +end FLTK.Widgets; + diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads new file mode 100644 index 0000000..d1c4b89 --- /dev/null +++ b/src/fltk-widgets.ads @@ -0,0 +1,162 @@ + + +with FLTK.Enums; use FLTK.Enums; +with FLTK.Images; +limited with FLTK.Widgets.Groups; +private with System; +private with System.Address_To_Access_Conversions; +private with Ada.Unchecked_Conversion; + + +package FLTK.Widgets is + + + type Widget is abstract new Wrapper with private; + + + type Widget_Callback is access procedure + (Item : in out Widget'Class); + + + type Font_Size is new Natural; + Normal_Size : constant Font_Size := 14; + type Color is new Natural; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Widget is abstract; + + + function Parent + (This : in Widget) + return access FLTK.Widgets.Groups.Group'Class; + + + function Get_Box + (This : in Widget) + return Box_Kind; + + + procedure Set_Box + (This : in out Widget; + Box : in Box_Kind); + + + function Get_Label + (This : in out Widget) + return String; + + + procedure Set_Label + (This : in out Widget; + Text : in String); + + + function Get_Label_Font + (This : in Widget) + return Font_Kind; + + + procedure Set_Label_Font + (This : in out Widget; + Font : in Font_Kind); + + + function Get_Label_Size + (This : in Widget) + return Font_Size; + + + procedure Set_Label_Size + (This : in out Widget; + Size : in Font_Size); + + + function Get_Label_Type + (This : in Widget) + return Label_Kind; + + + procedure Set_Label_Type + (This : in out Widget; + Label : in Label_Kind); + + + procedure Set_Callback + (This : in out Widget; + Func : in Widget_Callback); + + + function Get_X + (This : in Widget) + return Integer; + + + function Get_Y + (This : in Widget) + return Integer; + + + function Get_W + (This : in Widget) + return Integer; + + + function Get_H + (This : in Widget) + return Integer; + + + procedure Resize + (This : in out Widget; + W, H : in Integer); + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer); + + + function Get_Image + (This : in Widget) + return access FLTK.Images.Image'Class; + + + procedure Set_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class); + + +private + + + type Widget is abstract new Wrapper with + record + Callback : Widget_Callback; + Current_Image : access FLTK.Images.Image'Class; + end record; + + + package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); + -- package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback); + package Callback_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback); + function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address); + end Callback_Convert; + + + function fl_widget_get_user_data + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); + + + procedure fl_widget_set_user_data + (W, D : in System.Address); + pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); + + +end FLTK.Widgets; + diff --git a/src/fltk.adb b/src/fltk.adb new file mode 100644 index 0000000..983f308 --- /dev/null +++ b/src/fltk.adb @@ -0,0 +1,44 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK is + + + function fl_run return Interfaces.C.int; + pragma Import (C, fl_run, "fl_run"); + + + + + function Run + return Integer is + begin + return Integer (fl_run); + end Run; + + + + + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean is + begin + return This.Void_Ptr /= System.Null_Address; + end Has_Valid_Ptr; + + + + + procedure Initialize + (This : in out Wrapper) is + begin + This.Void_Ptr := System.Null_Address; + end Initialize; + + +end FLTK; + diff --git a/src/fltk.ads b/src/fltk.ads new file mode 100644 index 0000000..490050d --- /dev/null +++ b/src/fltk.ads @@ -0,0 +1,43 @@ + + +with Ada.Finalization; +private with System; + + +package FLTK is + + + function Run return Integer; + + + -- ugly implementation detail, never use this + -- just ignore the hand moving behind the curtain + -- (this is necessary so things like text_buffers and + -- widgets can talk to each other behind the binding) + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with private; + + +private + + + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean; + + + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with + record + Void_Ptr : System.Address; + end record; + -- with Type_Invariant => Has_Valid_Ptr (Wrapper); + + -- unsure if the above invariant is doing what I'm after + -- oh well, something to work on + + + overriding procedure Initialize + (This : in out Wrapper); + + +end FLTK; + |