summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-04-27 10:40:48 +1000
committerJed Barber <jjbarber@y7mail.com>2017-04-27 10:40:48 +1000
commit0d842f0423ba0754fb3675c7468397a8da5f6e1b (patch)
treed5da172bc7af2f7f48a3415eceac67ed67542787 /src
parent5d88963cd203f30b79433e34e5c89bfcf8abfe60 (diff)
Organising source
Diffstat (limited to 'src')
-rw-r--r--src/c_fl.cpp10
-rw-r--r--src/c_fl.h11
-rw-r--r--src/c_fl_box.cpp16
-rw-r--r--src/c_fl_box.h15
-rw-r--r--src/c_fl_button.cpp31
-rw-r--r--src/c_fl_button.h19
-rw-r--r--src/c_fl_check_button.cpp16
-rw-r--r--src/c_fl_check_button.h15
-rw-r--r--src/c_fl_dialog.cpp32
-rw-r--r--src/c_fl_dialog.h15
-rw-r--r--src/c_fl_double_window.cpp32
-rw-r--r--src/c_fl_double_window.h19
-rw-r--r--src/c_fl_group.cpp69
-rw-r--r--src/c_fl_group.h29
-rw-r--r--src/c_fl_image.cpp33
-rw-r--r--src/c_fl_image.h20
-rw-r--r--src/c_fl_input.cpp21
-rw-r--r--src/c_fl_input.h18
-rw-r--r--src/c_fl_int_input.cpp21
-rw-r--r--src/c_fl_int_input.h18
-rw-r--r--src/c_fl_light_button.cpp16
-rw-r--r--src/c_fl_light_button.h15
-rw-r--r--src/c_fl_menu.cpp38
-rw-r--r--src/c_fl_menu.h22
-rw-r--r--src/c_fl_menu_bar.cpp16
-rw-r--r--src/c_fl_menu_bar.h15
-rw-r--r--src/c_fl_menu_button.cpp21
-rw-r--r--src/c_fl_menu_button.h18
-rw-r--r--src/c_fl_menu_window.cpp52
-rw-r--r--src/c_fl_menu_window.h23
-rw-r--r--src/c_fl_png_image.cpp16
-rw-r--r--src/c_fl_png_image.h15
-rw-r--r--src/c_fl_radio_button.cpp16
-rw-r--r--src/c_fl_radio_button.h15
-rw-r--r--src/c_fl_radio_light_button.cpp16
-rw-r--r--src/c_fl_radio_light_button.h15
-rw-r--r--src/c_fl_radio_round_button.cpp16
-rw-r--r--src/c_fl_radio_round_button.h15
-rw-r--r--src/c_fl_repeat_button.cpp16
-rw-r--r--src/c_fl_repeat_button.h15
-rw-r--r--src/c_fl_return_button.cpp16
-rw-r--r--src/c_fl_return_button.h15
-rw-r--r--src/c_fl_round_button.cpp16
-rw-r--r--src/c_fl_round_button.h15
-rw-r--r--src/c_fl_single_window.cpp32
-rw-r--r--src/c_fl_single_window.h19
-rw-r--r--src/c_fl_text_buffer.cpp111
-rw-r--r--src/c_fl_text_buffer.h36
-rw-r--r--src/c_fl_text_display.cpp105
-rw-r--r--src/c_fl_text_display.h35
-rw-r--r--src/c_fl_text_editor.cpp48
-rw-r--r--src/c_fl_text_editor.h23
-rw-r--r--src/c_fl_toggle_button.cpp16
-rw-r--r--src/c_fl_toggle_button.h15
-rw-r--r--src/c_fl_widget.cpp119
-rw-r--r--src/c_fl_widget.h40
-rw-r--r--src/c_fl_window.cpp58
-rw-r--r--src/c_fl_window.h24
-rw-r--r--src/fltk-dialogs.adb111
-rw-r--r--src/fltk-dialogs.ads33
-rw-r--r--src/fltk-enum_values.ads7
-rw-r--r--src/fltk-enums.adb71
-rw-r--r--src/fltk-enums.ads146
-rw-r--r--src/fltk-images-rgb-png.adb49
-rw-r--r--src/fltk-images-rgb-png.ads25
-rw-r--r--src/fltk-images-rgb.adb14
-rw-r--r--src/fltk-images-rgb.ads20
-rw-r--r--src/fltk-images.adb96
-rw-r--r--src/fltk-images.ads40
-rw-r--r--src/fltk-text_buffers.adb540
-rw-r--r--src/fltk-text_buffers.ads180
-rw-r--r--src/fltk-widgets-boxes.adb58
-rw-r--r--src/fltk-widgets-boxes.ads26
-rw-r--r--src/fltk-widgets-buttons-enter.adb58
-rw-r--r--src/fltk-widgets-buttons-enter.ads29
-rw-r--r--src/fltk-widgets-buttons-light-check.adb58
-rw-r--r--src/fltk-widgets-buttons-light-check.ads26
-rw-r--r--src/fltk-widgets-buttons-light-radio.adb58
-rw-r--r--src/fltk-widgets-buttons-light-radio.ads26
-rw-r--r--src/fltk-widgets-buttons-light-round-radio.adb58
-rw-r--r--src/fltk-widgets-buttons-light-round-radio.ads26
-rw-r--r--src/fltk-widgets-buttons-light-round.adb58
-rw-r--r--src/fltk-widgets-buttons-light-round.ads26
-rw-r--r--src/fltk-widgets-buttons-light.adb58
-rw-r--r--src/fltk-widgets-buttons-light.ads26
-rw-r--r--src/fltk-widgets-buttons-radio.adb58
-rw-r--r--src/fltk-widgets-buttons-radio.ads26
-rw-r--r--src/fltk-widgets-buttons-repeat.adb58
-rw-r--r--src/fltk-widgets-buttons-repeat.ads26
-rw-r--r--src/fltk-widgets-buttons-toggle.adb58
-rw-r--r--src/fltk-widgets-buttons-toggle.ads26
-rw-r--r--src/fltk-widgets-buttons.adb101
-rw-r--r--src/fltk-widgets-buttons.ads43
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.adb145
-rw-r--r--src/fltk-widgets-groups-text_displays-text_editors.ads54
-rw-r--r--src/fltk-widgets-groups-text_displays.adb327
-rw-r--r--src/fltk-widgets-groups-text_displays.ads124
-rw-r--r--src/fltk-widgets-groups-windows-double.adb108
-rw-r--r--src/fltk-widgets-groups-windows-double.ads39
-rw-r--r--src/fltk-widgets-groups-windows-single-menu.adb158
-rw-r--r--src/fltk-widgets-groups-windows-single-menu.ads53
-rw-r--r--src/fltk-widgets-groups-windows-single.adb108
-rw-r--r--src/fltk-widgets-groups-windows-single.ads39
-rw-r--r--src/fltk-widgets-groups-windows.adb191
-rw-r--r--src/fltk-widgets-groups-windows.ads67
-rw-r--r--src/fltk-widgets-groups.adb202
-rw-r--r--src/fltk-widgets-groups.ads82
-rw-r--r--src/fltk-widgets-inputs-int.adb75
-rw-r--r--src/fltk-widgets-inputs-int.ads31
-rw-r--r--src/fltk-widgets-inputs.adb74
-rw-r--r--src/fltk-widgets-inputs.ads31
-rw-r--r--src/fltk-widgets-menus-menu_bars.adb58
-rw-r--r--src/fltk-widgets-menus-menu_bars.ads26
-rw-r--r--src/fltk-widgets-menus-menu_buttons.adb73
-rw-r--r--src/fltk-widgets-menus-menu_buttons.ads35
-rw-r--r--src/fltk-widgets-menus.adb160
-rw-r--r--src/fltk-widgets-menus.ads97
-rw-r--r--src/fltk-widgets.adb352
-rw-r--r--src/fltk-widgets.ads162
-rw-r--r--src/fltk.adb44
-rw-r--r--src/fltk.ads43
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;
+