From 3a9028302447ad84363c580b2152f30417186667 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Wed, 8 Jan 2025 14:33:30 +1300 Subject: Revised Input subhierarchy, separated bindings for Fl_Input and Fl_Input_ widgets --- src/c_fl_file_input.cpp | 87 +++--- src/c_fl_file_input.h | 33 +-- src/c_fl_float_input.cpp | 69 ++--- src/c_fl_float_input.h | 19 +- src/c_fl_input.cpp | 228 ++------------- src/c_fl_input.h | 76 +---- src/c_fl_input_.cpp | 249 ++++++++++++++++ src/c_fl_input_.h | 77 +++++ src/c_fl_int_input.cpp | 69 ++--- src/c_fl_int_input.h | 19 +- src/c_fl_multiline_input.cpp | 69 ++--- src/c_fl_multiline_input.h | 19 +- src/c_fl_multiline_output.cpp | 69 ++--- src/c_fl_multiline_output.h | 19 +- src/c_fl_output.cpp | 69 ++--- src/c_fl_output.h | 13 +- src/c_fl_secret_input.cpp | 69 ++--- src/c_fl_secret_input.h | 19 +- src/c_fl_widget.cpp | 66 +++-- src/c_fl_widget.h | 14 +- src/fltk-widgets-inputs-file.adb | 238 --------------- src/fltk-widgets-inputs-file.ads | 101 ------- src/fltk-widgets-inputs-floating_point.adb | 154 ---------- src/fltk-widgets-inputs-floating_point.ads | 72 ----- src/fltk-widgets-inputs-multiline.adb | 132 --------- src/fltk-widgets-inputs-multiline.ads | 63 ---- src/fltk-widgets-inputs-outputs-multiline.adb | 132 --------- src/fltk-widgets-inputs-outputs-multiline.ads | 63 ---- src/fltk-widgets-inputs-outputs.adb | 130 --------- src/fltk-widgets-inputs-outputs.ads | 63 ---- src/fltk-widgets-inputs-secret.adb | 132 --------- src/fltk-widgets-inputs-secret.ads | 63 ---- src/fltk-widgets-inputs-text-file.adb | 259 +++++++++++++++++ src/fltk-widgets-inputs-text-file.ads | 105 +++++++ src/fltk-widgets-inputs-text-floating_point.adb | 143 +++++++++ src/fltk-widgets-inputs-text-floating_point.ads | 62 ++++ src/fltk-widgets-inputs-text-multiline.adb | 117 ++++++++ src/fltk-widgets-inputs-text-multiline.ads | 52 ++++ src/fltk-widgets-inputs-text-outputs-multiline.adb | 117 ++++++++ src/fltk-widgets-inputs-text-outputs-multiline.ads | 52 ++++ src/fltk-widgets-inputs-text-outputs.adb | 117 ++++++++ src/fltk-widgets-inputs-text-outputs.ads | 52 ++++ src/fltk-widgets-inputs-text-secret.adb | 132 +++++++++ src/fltk-widgets-inputs-text-secret.ads | 63 ++++ src/fltk-widgets-inputs-text-whole_number.adb | 143 +++++++++ src/fltk-widgets-inputs-text-whole_number.ads | 62 ++++ src/fltk-widgets-inputs-text.adb | 139 +++++++++ src/fltk-widgets-inputs-text.ads | 67 +++++ src/fltk-widgets-inputs-whole_number.adb | 152 ---------- src/fltk-widgets-inputs-whole_number.ads | 72 ----- src/fltk-widgets-inputs.adb | 323 ++++++++++++++++----- src/fltk-widgets-inputs.ads | 97 +++++-- src/fltk-widgets.adb | 83 ++++-- src/fltk-widgets.ads | 27 +- 54 files changed, 2762 insertions(+), 2369 deletions(-) create mode 100644 src/c_fl_input_.cpp create mode 100644 src/c_fl_input_.h delete mode 100644 src/fltk-widgets-inputs-file.adb delete mode 100644 src/fltk-widgets-inputs-file.ads delete mode 100644 src/fltk-widgets-inputs-floating_point.adb delete mode 100644 src/fltk-widgets-inputs-floating_point.ads delete mode 100644 src/fltk-widgets-inputs-multiline.adb delete mode 100644 src/fltk-widgets-inputs-multiline.ads delete mode 100644 src/fltk-widgets-inputs-outputs-multiline.adb delete mode 100644 src/fltk-widgets-inputs-outputs-multiline.ads delete mode 100644 src/fltk-widgets-inputs-outputs.adb delete mode 100644 src/fltk-widgets-inputs-outputs.ads delete mode 100644 src/fltk-widgets-inputs-secret.adb delete mode 100644 src/fltk-widgets-inputs-secret.ads create mode 100644 src/fltk-widgets-inputs-text-file.adb create mode 100644 src/fltk-widgets-inputs-text-file.ads create mode 100644 src/fltk-widgets-inputs-text-floating_point.adb create mode 100644 src/fltk-widgets-inputs-text-floating_point.ads create mode 100644 src/fltk-widgets-inputs-text-multiline.adb create mode 100644 src/fltk-widgets-inputs-text-multiline.ads create mode 100644 src/fltk-widgets-inputs-text-outputs-multiline.adb create mode 100644 src/fltk-widgets-inputs-text-outputs-multiline.ads create mode 100644 src/fltk-widgets-inputs-text-outputs.adb create mode 100644 src/fltk-widgets-inputs-text-outputs.ads create mode 100644 src/fltk-widgets-inputs-text-secret.adb create mode 100644 src/fltk-widgets-inputs-text-secret.ads create mode 100644 src/fltk-widgets-inputs-text-whole_number.adb create mode 100644 src/fltk-widgets-inputs-text-whole_number.ads create mode 100644 src/fltk-widgets-inputs-text.adb create mode 100644 src/fltk-widgets-inputs-text.ads delete mode 100644 src/fltk-widgets-inputs-whole_number.adb delete mode 100644 src/fltk-widgets-inputs-whole_number.ads (limited to 'src') diff --git a/src/c_fl_file_input.cpp b/src/c_fl_file_input.cpp index 38b57b5..adf8f37 100644 --- a/src/c_fl_file_input.cpp +++ b/src/c_fl_file_input.cpp @@ -6,99 +6,92 @@ #include #include "c_fl_file_input.h" -#include "c_fl_type.h" -class My_File_Input : public Fl_File_Input { - public: - using Fl_File_Input::Fl_File_Input; - friend void file_input_set_draw_hook(FILE_INPUT i, void * d); - friend void fl_file_input_draw(FILE_INPUT i); - friend void file_input_set_handle_hook(FILE_INPUT i, void * h); - friend int fl_file_input_handle(FILE_INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; +// Exports from Ada -void My_File_Input::draw() { - (*draw_hook)(this->user_data()); -} +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); -void My_File_Input::real_draw() { - Fl_File_Input::draw(); -} -int My_File_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} -int My_File_Input::real_handle(int e) { - return Fl_File_Input::handle(e); -} -void file_input_set_draw_hook(FILE_INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} +// Attaching all relevant hooks and friends -void fl_file_input_draw(FILE_INPUT i) { - reinterpret_cast(i)->real_draw(); -} +class My_File_Input : public Fl_File_Input { +public: + using Fl_File_Input::Fl_File_Input; + + friend void fl_file_input_draw(FILEINPUT i); + friend int fl_file_input_handle(FILEINPUT i, int e); -void file_input_set_handle_hook(FILE_INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); + void draw(); + int handle(int e); +}; + +void My_File_Input::draw() { + widget_draw_hook(this->user_data()); } -int fl_file_input_handle(FILE_INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +int My_File_Input::handle(int e) { + return widget_handle_hook(this->user_data(), e); } -FILE_INPUT new_fl_file_input(int x, int y, int w, int h, char* label) { +// Flattened C API + +FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label) { My_File_Input *i = new My_File_Input(x, y, w, h, label); return i; } -void free_fl_file_input(FILE_INPUT i) { +void free_fl_file_input(FILEINPUT i) { delete reinterpret_cast(i); } -int fl_file_input_get_down_box(FILE_INPUT i) { +int fl_file_input_get_down_box(FILEINPUT i) { return reinterpret_cast(i)->down_box(); } -void fl_file_input_set_down_box(FILE_INPUT i, int t) { +void fl_file_input_set_down_box(FILEINPUT i, int t) { reinterpret_cast(i)->down_box(static_cast(t)); } -unsigned int fl_file_input_get_errorcolor(FILE_INPUT i) { +unsigned int fl_file_input_get_errorcolor(FILEINPUT i) { return reinterpret_cast(i)->errorcolor(); } -void fl_file_input_set_errorcolor(FILE_INPUT i, unsigned int t) { +void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t) { reinterpret_cast(i)->errorcolor(t); } -const char * fl_file_input_get_value(FILE_INPUT i) { +const char * fl_file_input_get_value(FILEINPUT i) { return reinterpret_cast(i)->value(); } -void fl_file_input_set_value(FILE_INPUT i, const char * s, int len) { - reinterpret_cast(i)->value(s,len); +int fl_file_input_set_value(FILEINPUT i, const char * s, int len) { + return reinterpret_cast(i)->value(s,len); +} + + + + +void fl_file_input_draw(FILEINPUT i) { + reinterpret_cast(i)->Fl_File_Input::draw(); +} + +int fl_file_input_handle(FILEINPUT i, int e) { + return reinterpret_cast(i)->Fl_File_Input::handle(e); } diff --git a/src/c_fl_file_input.h b/src/c_fl_file_input.h index 0601a2b..df05cbb 100644 --- a/src/c_fl_file_input.h +++ b/src/c_fl_file_input.h @@ -8,36 +8,27 @@ #define FL_FILE_INPUT_GUARD +typedef void* FILEINPUT; -typedef void* FILE_INPUT; +extern "C" FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_file_input(FILEINPUT i); +extern "C" int fl_file_input_get_down_box(FILEINPUT i); +extern "C" void fl_file_input_set_down_box(FILEINPUT i, int t); +extern "C" unsigned int fl_file_input_get_errorcolor(FILEINPUT i); +extern "C" void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t); -extern "C" void file_input_set_draw_hook(FILE_INPUT i, void * d); -extern "C" void fl_file_input_draw(FILE_INPUT i); -extern "C" void file_input_set_handle_hook(FILE_INPUT i, void * h); -extern "C" int fl_file_input_handle(FILE_INPUT i, int e); +extern "C" const char * fl_file_input_get_value(FILEINPUT i); +extern "C" int fl_file_input_set_value(FILEINPUT i, const char * s, int len); - - -extern "C" FILE_INPUT new_fl_file_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_file_input(FILE_INPUT i); - - - - -extern "C" int fl_file_input_get_down_box(FILE_INPUT i); -extern "C" void fl_file_input_set_down_box(FILE_INPUT i, int t); -extern "C" unsigned int fl_file_input_get_errorcolor(FILE_INPUT i); -extern "C" void fl_file_input_set_errorcolor(FILE_INPUT i, unsigned int t); - - -extern "C" const char * fl_file_input_get_value(FILE_INPUT i); -extern "C" void fl_file_input_set_value(FILE_INPUT i, const char * s, int len); +extern "C" void fl_file_input_draw(FILEINPUT i); +extern "C" int fl_file_input_handle(FILEINPUT i, int e); #endif + diff --git a/src/c_fl_float_input.cpp b/src/c_fl_float_input.cpp index 304f250..c5ce3e1 100644 --- a/src/c_fl_float_input.cpp +++ b/src/c_fl_float_input.cpp @@ -6,69 +6,62 @@ #include #include "c_fl_float_input.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + class My_Float_Input : public Fl_Float_Input { - public: - using Fl_Float_Input::Fl_Float_Input; - friend void float_input_set_draw_hook(FLOAT_INPUT i, void * d); - friend void fl_float_input_draw(FLOAT_INPUT i); - friend void float_input_set_handle_hook(FLOAT_INPUT i, void * h); - friend int fl_float_input_handle(FLOAT_INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Float_Input::Fl_Float_Input; + + friend void fl_float_input_draw(FLOATINPUT i); + friend int fl_float_input_handle(FLOATINPUT i, int e); + + void draw(); + int handle(int e); }; void My_Float_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Float_Input::real_draw() { - Fl_Float_Input::draw(); + widget_draw_hook(this->user_data()); } int My_Float_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); + return widget_handle_hook(this->user_data(), e); } -int My_Float_Input::real_handle(int e) { - return Fl_Float_Input::handle(e); -} -void float_input_set_draw_hook(FLOAT_INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} -void fl_float_input_draw(FLOAT_INPUT i) { - reinterpret_cast(i)->real_draw(); -} -void float_input_set_handle_hook(FLOAT_INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +// Flattened C API + +FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label) { + My_Float_Input *i = new My_Float_Input(x, y, w, h, label); + return i; } -int fl_float_input_handle(FLOAT_INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +void free_fl_float_input(FLOATINPUT i) { + delete reinterpret_cast(i); } -FLOAT_INPUT new_fl_float_input(int x, int y, int w, int h, char* label) { - My_Float_Input *i = new My_Float_Input(x, y, w, h, label); - return i; +void fl_float_input_draw(FLOATINPUT i) { + reinterpret_cast(i)->Fl_Float_Input::draw(); } -void free_fl_float_input(FLOAT_INPUT i) { - delete reinterpret_cast(i); +int fl_float_input_handle(FLOATINPUT i, int e) { + return reinterpret_cast(i)->Fl_Float_Input::handle(e); } diff --git a/src/c_fl_float_input.h b/src/c_fl_float_input.h index 095b02e..5ee1689 100644 --- a/src/c_fl_float_input.h +++ b/src/c_fl_float_input.h @@ -8,24 +8,17 @@ #define FL_FLOAT_INPUT_GUARD +typedef void* FLOATINPUT; -typedef void* FLOAT_INPUT; +extern "C" FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_float_input(FLOATINPUT i); - - -extern "C" void float_input_set_draw_hook(FLOAT_INPUT i, void * d); -extern "C" void fl_float_input_draw(FLOAT_INPUT i); -extern "C" void float_input_set_handle_hook(FLOAT_INPUT i, void * h); -extern "C" int fl_float_input_handle(FLOAT_INPUT i, int e); - - - - -extern "C" FLOAT_INPUT new_fl_float_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_float_input(FLOAT_INPUT i); +extern "C" void fl_float_input_draw(FLOATINPUT i); +extern "C" int fl_float_input_handle(FLOATINPUT i, int e); #endif + diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp index ea81472..daccda0 100644 --- a/src/c_fl_input.cpp +++ b/src/c_fl_input.cpp @@ -6,238 +6,62 @@ #include #include "c_fl_input.h" -#include "c_fl_type.h" -class My_Input : public Fl_Input { - public: - using Fl_Input::Fl_Input; - friend void input_set_draw_hook(INPUT i, void * d); - friend void fl_input_draw(INPUT i); - friend void input_set_handle_hook(INPUT i, void * h); - friend int fl_input_handle(INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; - -void My_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Input::real_draw() { - Fl_Input::draw(); -} - -int My_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Input::real_handle(int e) { - return Fl_Input::handle(e); -} - -void input_set_draw_hook(INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} - -void fl_input_draw(INPUT i) { - reinterpret_cast(i)->real_draw(); -} - -void input_set_handle_hook(INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); -} - -int fl_input_handle(INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); -} - +// Exports from Ada +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); -INPUT new_fl_input(int x, int y, int w, int h, char* label) { - My_Input *i = new My_Input(x, y, w, h, label); - return i; -} - -void free_fl_input(INPUT i) { - delete reinterpret_cast(i); -} +// Attaching all relevant hooks and friends +class My_Text_Input : public Fl_Input { +public: + using Fl_Input::Fl_Input; -int fl_input_copy(INPUT i) { - return reinterpret_cast(i)->copy(1); -} - -int fl_input_cut(INPUT i) { - return reinterpret_cast(i)->cut(); -} - -int fl_input_cut2(INPUT i, int b) { - return reinterpret_cast(i)->cut(b); -} - -int fl_input_cut3(INPUT i, int a, int b) { - return reinterpret_cast(i)->cut(a,b); -} - -int fl_input_copy_cuts(INPUT i) { - return reinterpret_cast(i)->copy_cuts(); -} - -int fl_input_undo(INPUT i) { - return reinterpret_cast(i)->undo(); -} - - - - -int fl_input_get_readonly(INPUT i) { - return reinterpret_cast(i)->readonly(); -} - -void fl_input_set_readonly(INPUT i, int t) { - reinterpret_cast(i)->readonly(t); -} - -int fl_input_get_tab_nav(INPUT i) { - return reinterpret_cast(i)->tab_nav(); -} - -void fl_input_set_tab_nav(INPUT i, int t) { - reinterpret_cast(i)->tab_nav(t); -} - -int fl_input_get_wrap(INPUT i) { - return reinterpret_cast(i)->wrap(); -} - -void fl_input_set_wrap(INPUT i, int t) { - reinterpret_cast(i)->wrap(t); -} + friend void fl_text_input_draw(TEXTINPUT t); + friend int fl_text_input_handle(TEXTINPUT t, int e); + void draw(); + int handle(int e); +}; - - -int fl_input_get_input_type(INPUT i) { - return reinterpret_cast(i)->input_type(); -} - -void fl_input_set_input_type(INPUT i, int t) { - reinterpret_cast(i)->input_type(t); -} - -unsigned long fl_input_get_shortcut(INPUT i) { - return reinterpret_cast(i)->shortcut(); -} - -void fl_input_set_shortcut(INPUT i, unsigned long t) { - reinterpret_cast(i)->shortcut(t); -} - -int fl_input_get_mark(INPUT i) { - return reinterpret_cast(i)->mark(); -} - -int fl_input_set_mark(INPUT i, int t) { - return reinterpret_cast(i)->mark(t); -} - -int fl_input_get_position(INPUT i) { - return reinterpret_cast(i)->position(); -} - -int fl_input_set_position(INPUT i, int t) { - return reinterpret_cast(i)->position(t); -} - - - - -unsigned int fl_input_index(INPUT i, int p) { - return reinterpret_cast(i)->index(p); -} - -int fl_input_insert(INPUT i, const char * s, int l) { - return reinterpret_cast(i)->insert(s,l); -} - -int fl_input_replace(INPUT i, int b, int e, const char * s, int l) { - return reinterpret_cast(i)->replace(b,e,s,l); -} - -const char * fl_input_get_value(INPUT i) { - return reinterpret_cast(i)->value(); -} - -void fl_input_set_value(INPUT i, char * s, int len) { - reinterpret_cast(i)->value(s,len); -} - - - - -int fl_input_get_maximum_size(INPUT i) { - return reinterpret_cast(i)->maximum_size(); -} - -void fl_input_set_maximum_size(INPUT i, int t) { - reinterpret_cast(i)->maximum_size(t); +void My_Text_Input::draw() { + widget_draw_hook(this->user_data()); } -int fl_input_get_size(INPUT i) { - return reinterpret_cast(i)->size(); +int My_Text_Input::handle(int e) { + return widget_handle_hook(this->user_data(), e); } -unsigned int fl_input_get_cursor_color(INPUT i) { - return reinterpret_cast(i)->cursor_color(); -} +// Flattened C API -void fl_input_set_cursor_color(INPUT i, unsigned int t) { - reinterpret_cast(i)->cursor_color(t); +TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label) { + My_Text_Input * t = new My_Text_Input(x, y, w, h, label); + return t; } -unsigned int fl_input_get_textcolor(INPUT i) { - return reinterpret_cast(i)->textcolor(); +void free_fl_text_input(TEXTINPUT t) { + delete reinterpret_cast(t); } -void fl_input_set_textcolor(INPUT i, unsigned int t) { - reinterpret_cast(i)->textcolor(t); -} -int fl_input_get_textfont(INPUT i) { - return reinterpret_cast(i)->textfont(); -} -void fl_input_set_textfont(INPUT i, int t) { - reinterpret_cast(i)->textfont(t); -} -int fl_input_get_textsize(INPUT i) { - return reinterpret_cast(i)->textsize(); +void fl_text_input_draw(TEXTINPUT t) { + reinterpret_cast(t)->Fl_Input::draw(); } -void fl_input_set_textsize(INPUT i, int t) { - reinterpret_cast(i)->textsize(t); -} - - - - -void fl_input_set_size(INPUT i, int w, int h) { - reinterpret_cast(i)->size(w,h); +int fl_text_input_handle(TEXTINPUT t, int e) { + return reinterpret_cast(t)->Fl_Input::handle(e); } diff --git a/src/c_fl_input.h b/src/c_fl_input.h index dd7ec25..6af00e8 100644 --- a/src/c_fl_input.h +++ b/src/c_fl_input.h @@ -4,81 +4,21 @@ // Released into the public domain -#ifndef FL_INPUT_GUARD -#define FL_INPUT_GUARD +#ifndef FL_TEXT_INPUT_GUARD +#define FL_TEXT_INPUT_GUARD +typedef void* TEXTINPUT; -typedef void* INPUT; +extern "C" TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label); +extern "C" void free_fl_text_input(TEXTINPUT t); - - -extern "C" void input_set_draw_hook(INPUT n, void * d); -extern "C" void fl_input_draw(INPUT n); -extern "C" void input_set_handle_hook(INPUT i, void * h); -extern "C" int fl_input_handle(INPUT i, int e); - - - - -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" int fl_input_copy(INPUT i); -extern "C" int fl_input_cut(INPUT i); -extern "C" int fl_input_cut2(INPUT i, int b); -extern "C" int fl_input_cut3(INPUT i, int a, int b); -extern "C" int fl_input_copy_cuts(INPUT i); -extern "C" int fl_input_undo(INPUT i); - - -extern "C" int fl_input_get_readonly(INPUT i); -extern "C" void fl_input_set_readonly(INPUT i, int t); -extern "C" int fl_input_get_tab_nav(INPUT i); -extern "C" void fl_input_set_tab_nav(INPUT i, int t); -extern "C" int fl_input_get_wrap(INPUT i); -extern "C" void fl_input_set_wrap(INPUT i, int t); - - -extern "C" int fl_input_get_input_type(INPUT i); -extern "C" void fl_input_set_input_type(INPUT i, int t); -extern "C" unsigned long fl_input_get_shortcut(INPUT i); -extern "C" void fl_input_set_shortcut(INPUT i, unsigned long t); -extern "C" int fl_input_get_mark(INPUT i); -extern "C" int fl_input_set_mark(INPUT i, int t); -extern "C" int fl_input_get_position(INPUT i); -extern "C" int fl_input_set_position(INPUT i, int t); - - -extern "C" unsigned int fl_input_index(INPUT i, int p); -extern "C" int fl_input_insert(INPUT i, const char * s, int l); -extern "C" int fl_input_replace(INPUT i, int b, int e, const char * s, int l); -extern "C" const char * fl_input_get_value(INPUT i); -extern "C" void fl_input_set_value(INPUT i, char * s, int len); - - -extern "C" int fl_input_get_maximum_size(INPUT i); -extern "C" void fl_input_set_maximum_size(INPUT i, int t); -extern "C" int fl_input_get_size(INPUT i); - - -extern "C" unsigned int fl_input_get_cursor_color(INPUT i); -extern "C" void fl_input_set_cursor_color(INPUT i, unsigned int t); -extern "C" unsigned int fl_input_get_textcolor(INPUT i); -extern "C" void fl_input_set_textcolor(INPUT i, unsigned int t); -extern "C" int fl_input_get_textfont(INPUT i); -extern "C" void fl_input_set_textfont(INPUT i, int t); -extern "C" int fl_input_get_textsize(INPUT i); -extern "C" void fl_input_set_textsize(INPUT i, int t); - - -extern "C" void fl_input_set_size(INPUT i, int w, int h); +extern "C" void fl_text_input_draw(TEXTINPUT t); +extern "C" int fl_text_input_handle(TEXTINPUT t, int e); #endif + diff --git a/src/c_fl_input_.cpp b/src/c_fl_input_.cpp new file mode 100644 index 0000000..0971d1d --- /dev/null +++ b/src/c_fl_input_.cpp @@ -0,0 +1,249 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_fl_input_.h" + + + + +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + +class My_Input : public Fl_Input_ { +public: + using Fl_Input_::Fl_Input_; + + friend void fl_input_draw(INPUT i); + friend int fl_input_handle(INPUT i, int e); + + void draw(); + int handle(int e); +}; + +void My_Input::draw() { + widget_draw_hook(this->user_data()); +} + +int My_Input::handle(int e) { + return widget_handle_hook(this->user_data(), e); +} + + + + +// Flattened C API + +INPUT new_fl_input(int x, int y, int w, int h, char* label) { + My_Input *i = new My_Input(x, y, w, h, label); + return i; +} + +void free_fl_input(INPUT i) { + delete reinterpret_cast(i); +} + + + + +int fl_input_copy(INPUT i, int c) { + return reinterpret_cast(i)->copy(c); +} + +int fl_input_cut(INPUT i) { + return reinterpret_cast(i)->cut(); +} + +int fl_input_cut2(INPUT i, int b) { + return reinterpret_cast(i)->cut(b); +} + +int fl_input_cut3(INPUT i, int a, int b) { + return reinterpret_cast(i)->cut(a,b); +} + +int fl_input_copy_cuts(INPUT i) { + return reinterpret_cast(i)->copy_cuts(); +} + +int fl_input_undo(INPUT i) { + return reinterpret_cast(i)->undo(); +} + + + + +int fl_input_get_readonly(INPUT i) { + return reinterpret_cast(i)->readonly(); +} + +void fl_input_set_readonly(INPUT i, int t) { + reinterpret_cast(i)->readonly(t); +} + +int fl_input_get_tab_nav(INPUT i) { + return reinterpret_cast(i)->tab_nav(); +} + +void fl_input_set_tab_nav(INPUT i, int t) { + reinterpret_cast(i)->tab_nav(t); +} + +int fl_input_get_wrap(INPUT i) { + return reinterpret_cast(i)->wrap(); +} + +void fl_input_set_wrap(INPUT i, int t) { + reinterpret_cast(i)->wrap(t); +} + + + + +int fl_input_get_input_type(INPUT i) { + return reinterpret_cast(i)->input_type(); +} + +void fl_input_set_input_type(INPUT i, int t) { + reinterpret_cast(i)->input_type(t); +} + +unsigned long fl_input_get_shortcut(INPUT i) { + return reinterpret_cast(i)->shortcut(); +} + +void fl_input_set_shortcut(INPUT i, unsigned long t) { + reinterpret_cast(i)->shortcut(t); +} + +int fl_input_get_mark(INPUT i) { + return reinterpret_cast(i)->mark(); +} + +int fl_input_set_mark(INPUT i, int t) { + return reinterpret_cast(i)->mark(t); +} + +int fl_input_get_position(INPUT i) { + return reinterpret_cast(i)->position(); +} + +int fl_input_set_position(INPUT i, int t) { + return reinterpret_cast(i)->position(t); +} + +int fl_input_set_position2(INPUT i, int p, int m) { + return reinterpret_cast(i)->position(p, m); +} + + + + +unsigned int fl_input_index(INPUT i, int p) { + return reinterpret_cast(i)->index(p); +} + +int fl_input_insert(INPUT i, const char * s, int l) { + return reinterpret_cast(i)->insert(s,l); +} + +int fl_input_replace(INPUT i, int b, int e, const char * s, int l) { + return reinterpret_cast(i)->replace(b,e,s,l); +} + +const char * fl_input_get_value(INPUT i) { + return reinterpret_cast(i)->value(); +} + +int fl_input_set_value(INPUT i, char * s, int len) { + return reinterpret_cast(i)->value(s,len); +} + + + + +int fl_input_get_maximum_size(INPUT i) { + return reinterpret_cast(i)->maximum_size(); +} + +void fl_input_set_maximum_size(INPUT i, int t) { + reinterpret_cast(i)->maximum_size(t); +} + +int fl_input_get_size(INPUT i) { + return reinterpret_cast(i)->size(); +} + + + + +unsigned int fl_input_get_cursor_color(INPUT i) { + return reinterpret_cast(i)->cursor_color(); +} + +void fl_input_set_cursor_color(INPUT i, unsigned int t) { + reinterpret_cast(i)->cursor_color(t); +} + +unsigned int fl_input_get_textcolor(INPUT i) { + return reinterpret_cast(i)->textcolor(); +} + +void fl_input_set_textcolor(INPUT i, unsigned int t) { + reinterpret_cast(i)->textcolor(t); +} + +int fl_input_get_textfont(INPUT i) { + return reinterpret_cast(i)->textfont(); +} + +void fl_input_set_textfont(INPUT i, int t) { + reinterpret_cast(i)->textfont(t); +} + +int fl_input_get_textsize(INPUT i) { + return reinterpret_cast(i)->textsize(); +} + +void fl_input_set_textsize(INPUT i, int t) { + reinterpret_cast(i)->textsize(t); +} + + + + +void fl_input_set_size(INPUT i, int w, int h) { + reinterpret_cast(i)->size(w,h); +} + +void fl_input_resize(INPUT i, int x, int y, int w, int h) { + reinterpret_cast(i)->Fl_Input_::resize(x, y, w, h); +} + + + + +void fl_input_draw(INPUT i) { + // This inherits directly from Fl_Widget::draw, and + // the Fl_Widget draw method doesn't technically exist, so... + (void)(i); + // It is more convenient for this function to exist, however, + // even though it will likely never be called, because it simplifies + // and makes uniform the implementation of the Ada Input Draw subprogram. +} + +int fl_input_handle(INPUT i, int e) { + return reinterpret_cast(i)->Fl_Input_::handle(e); +} + + diff --git a/src/c_fl_input_.h b/src/c_fl_input_.h new file mode 100644 index 0000000..eec03c2 --- /dev/null +++ b/src/c_fl_input_.h @@ -0,0 +1,77 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#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" int fl_input_copy(INPUT i, int c); +extern "C" int fl_input_cut(INPUT i); +extern "C" int fl_input_cut2(INPUT i, int b); +extern "C" int fl_input_cut3(INPUT i, int a, int b); +extern "C" int fl_input_copy_cuts(INPUT i); +extern "C" int fl_input_undo(INPUT i); + + +extern "C" int fl_input_get_readonly(INPUT i); +extern "C" void fl_input_set_readonly(INPUT i, int t); +extern "C" int fl_input_get_tab_nav(INPUT i); +extern "C" void fl_input_set_tab_nav(INPUT i, int t); +extern "C" int fl_input_get_wrap(INPUT i); +extern "C" void fl_input_set_wrap(INPUT i, int t); + + +extern "C" int fl_input_get_input_type(INPUT i); +extern "C" void fl_input_set_input_type(INPUT i, int t); +extern "C" unsigned long fl_input_get_shortcut(INPUT i); +extern "C" void fl_input_set_shortcut(INPUT i, unsigned long t); +extern "C" int fl_input_get_mark(INPUT i); +extern "C" int fl_input_set_mark(INPUT i, int t); +extern "C" int fl_input_get_position(INPUT i); +extern "C" int fl_input_set_position(INPUT i, int t); +extern "C" int fl_input_set_position2(INPUT i, int p, int m); + + +extern "C" unsigned int fl_input_index(INPUT i, int p); +extern "C" int fl_input_insert(INPUT i, const char * s, int l); +extern "C" int fl_input_replace(INPUT i, int b, int e, const char * s, int l); +extern "C" const char * fl_input_get_value(INPUT i); +extern "C" int fl_input_set_value(INPUT i, char * s, int len); + + +extern "C" int fl_input_get_maximum_size(INPUT i); +extern "C" void fl_input_set_maximum_size(INPUT i, int t); +extern "C" int fl_input_get_size(INPUT i); + + +extern "C" unsigned int fl_input_get_cursor_color(INPUT i); +extern "C" void fl_input_set_cursor_color(INPUT i, unsigned int t); +extern "C" unsigned int fl_input_get_textcolor(INPUT i); +extern "C" void fl_input_set_textcolor(INPUT i, unsigned int t); +extern "C" int fl_input_get_textfont(INPUT i); +extern "C" void fl_input_set_textfont(INPUT i, int t); +extern "C" int fl_input_get_textsize(INPUT i); +extern "C" void fl_input_set_textsize(INPUT i, int t); + + +extern "C" void fl_input_set_size(INPUT i, int w, int h); +extern "C" void fl_input_resize(INPUT i, int x, int y, int w, int h); + + +extern "C" void fl_input_draw(INPUT n); +extern "C" int fl_input_handle(INPUT i, int e); + + +#endif + + diff --git a/src/c_fl_int_input.cpp b/src/c_fl_int_input.cpp index 393af90..0f90cf2 100644 --- a/src/c_fl_int_input.cpp +++ b/src/c_fl_int_input.cpp @@ -6,69 +6,62 @@ #include #include "c_fl_int_input.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + class My_Int_Input : public Fl_Int_Input { - public: - using Fl_Int_Input::Fl_Int_Input; - friend void int_input_set_draw_hook(INT_INPUT i, void * d); - friend void fl_int_input_draw(INT_INPUT i); - friend void int_input_set_handle_hook(INT_INPUT i, void * h); - friend int fl_int_input_handle(INT_INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Int_Input::Fl_Int_Input; + + friend void fl_int_input_draw(INTINPUT i); + friend int fl_int_input_handle(INTINPUT i, int e); + + void draw(); + int handle(int e); }; void My_Int_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Int_Input::real_draw() { - Fl_Int_Input::draw(); + widget_draw_hook(this->user_data()); } int My_Int_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); + return widget_handle_hook(this->user_data(), e); } -int My_Int_Input::real_handle(int e) { - return Fl_Int_Input::handle(e); -} -void int_input_set_draw_hook(INT_INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} -void fl_int_input_draw(INT_INPUT i) { - reinterpret_cast(i)->real_draw(); -} -void int_input_set_handle_hook(INT_INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +// Flattened C API + +INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label) { + My_Int_Input *i = new My_Int_Input(x, y, w, h, label); + return i; } -int fl_int_input_handle(INT_INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +void free_fl_int_input(INTINPUT i) { + delete reinterpret_cast(i); } -INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label) { - My_Int_Input *i = new My_Int_Input(x, y, w, h, label); - return i; +void fl_int_input_draw(INTINPUT i) { + reinterpret_cast(i)->Fl_Int_Input::draw(); } -void free_fl_int_input(INT_INPUT i) { - delete reinterpret_cast(i); +int fl_int_input_handle(INTINPUT i, int e) { + return reinterpret_cast(i)->Fl_Int_Input::handle(e); } diff --git a/src/c_fl_int_input.h b/src/c_fl_int_input.h index e807191..e36cfaa 100644 --- a/src/c_fl_int_input.h +++ b/src/c_fl_int_input.h @@ -8,24 +8,17 @@ #define FL_INT_INPUT_GUARD +typedef void* INTINPUT; -typedef void* INT_INPUT; +extern "C" INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_int_input(INTINPUT i); - - -extern "C" void int_input_set_draw_hook(INT_INPUT i, void * d); -extern "C" void fl_int_input_draw(INT_INPUT i); -extern "C" void int_input_set_handle_hook(INT_INPUT i, void * h); -extern "C" int fl_int_input_handle(INT_INPUT i, int e); - - - - -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" void fl_int_input_draw(INTINPUT i); +extern "C" int fl_int_input_handle(INTINPUT i, int e); #endif + diff --git a/src/c_fl_multiline_input.cpp b/src/c_fl_multiline_input.cpp index a329ab8..46d0a33 100644 --- a/src/c_fl_multiline_input.cpp +++ b/src/c_fl_multiline_input.cpp @@ -6,69 +6,62 @@ #include #include "c_fl_multiline_input.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + class My_Multiline_Input : public Fl_Multiline_Input { - public: - using Fl_Multiline_Input::Fl_Multiline_Input; - friend void multiline_input_set_draw_hook(MULTILINE_INPUT i, void * d); - friend void fl_multiline_input_draw(MULTILINE_INPUT i); - friend void multiline_input_set_handle_hook(MULTILINE_INPUT i, void * h); - friend int fl_multiline_input_handle(MULTILINE_INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Multiline_Input::Fl_Multiline_Input; + + friend void fl_multiline_input_draw(MULTILINEINPUT i); + friend int fl_multiline_input_handle(MULTILINEINPUT i, int e); + + void draw(); + int handle(int e); }; void My_Multiline_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Multiline_Input::real_draw() { - Fl_Multiline_Input::draw(); + widget_draw_hook(this->user_data()); } int My_Multiline_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); + return widget_handle_hook(this->user_data(), e); } -int My_Multiline_Input::real_handle(int e) { - return Fl_Multiline_Input::handle(e); -} -void multiline_input_set_draw_hook(MULTILINE_INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} -void fl_multiline_input_draw(MULTILINE_INPUT i) { - reinterpret_cast(i)->real_draw(); -} -void multiline_input_set_handle_hook(MULTILINE_INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +// Flattened C API + +MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label) { + My_Multiline_Input *i = new My_Multiline_Input(x, y, w, h, label); + return i; } -int fl_multiline_input_handle(MULTILINE_INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +void free_fl_multiline_input(MULTILINEINPUT i) { + delete reinterpret_cast(i); } -MULTILINE_INPUT new_fl_multiline_input(int x, int y, int w, int h, char* label) { - My_Multiline_Input *i = new My_Multiline_Input(x, y, w, h, label); - return i; +void fl_multiline_input_draw(MULTILINEINPUT i) { + reinterpret_cast(i)->Fl_Multiline_Input::draw(); } -void free_fl_multiline_input(MULTILINE_INPUT i) { - delete reinterpret_cast(i); +int fl_multiline_input_handle(MULTILINEINPUT i, int e) { + return reinterpret_cast(i)->Fl_Multiline_Input::handle(e); } diff --git a/src/c_fl_multiline_input.h b/src/c_fl_multiline_input.h index 773b180..ba4e723 100644 --- a/src/c_fl_multiline_input.h +++ b/src/c_fl_multiline_input.h @@ -8,24 +8,17 @@ #define FL_MULTILINE_INPUT_GUARD +typedef void* MULTILINEINPUT; -typedef void* MULTILINE_INPUT; +extern "C" MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_multiline_input(MULTILINEINPUT i); - - -extern "C" void multiline_input_set_draw_hook(MULTILINE_INPUT i, void * d); -extern "C" void fl_multiline_input_draw(MULTILINE_INPUT i); -extern "C" void multiline_input_set_handle_hook(MULTILINE_INPUT i, void * h); -extern "C" int fl_multiline_input_handle(MULTILINE_INPUT i, int e); - - - - -extern "C" MULTILINE_INPUT new_fl_multiline_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_multiline_input(MULTILINE_INPUT i); +extern "C" void fl_multiline_input_draw(MULTILINEINPUT i); +extern "C" int fl_multiline_input_handle(MULTILINEINPUT i, int e); #endif + diff --git a/src/c_fl_multiline_output.cpp b/src/c_fl_multiline_output.cpp index 1b44e58..6be13a2 100644 --- a/src/c_fl_multiline_output.cpp +++ b/src/c_fl_multiline_output.cpp @@ -6,69 +6,62 @@ #include #include "c_fl_multiline_output.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + class My_Multiline_Output : public Fl_Multiline_Output { - public: - using Fl_Multiline_Output::Fl_Multiline_Output; - friend void multiline_output_set_draw_hook(MULTILINE_OUTPUT i, void * d); - friend void fl_multiline_output_draw(MULTILINE_OUTPUT i); - friend void multiline_output_set_handle_hook(MULTILINE_OUTPUT i, void * h); - friend int fl_multiline_output_handle(MULTILINE_OUTPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Multiline_Output::Fl_Multiline_Output; + + friend void fl_multiline_output_draw(MULTILINEOUTPUT i); + friend int fl_multiline_output_handle(MULTILINEOUTPUT i, int e); + + void draw(); + int handle(int e); }; void My_Multiline_Output::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Multiline_Output::real_draw() { - Fl_Multiline_Output::draw(); + widget_draw_hook(this->user_data()); } int My_Multiline_Output::handle(int e) { - return (*handle_hook)(this->user_data(), e); + return widget_handle_hook(this->user_data(), e); } -int My_Multiline_Output::real_handle(int e) { - return Fl_Multiline_Output::handle(e); -} -void multiline_output_set_draw_hook(MULTILINE_OUTPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} -void fl_multiline_output_draw(MULTILINE_OUTPUT i) { - reinterpret_cast(i)->real_draw(); -} -void multiline_output_set_handle_hook(MULTILINE_OUTPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +// Flattened C API + +MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label) { + My_Multiline_Output *i = new My_Multiline_Output(x, y, w, h, label); + return i; } -int fl_multiline_output_handle(MULTILINE_OUTPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +void free_fl_multiline_output(MULTILINEOUTPUT i) { + delete reinterpret_cast(i); } -MULTILINE_OUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label) { - My_Multiline_Output *i = new My_Multiline_Output(x, y, w, h, label); - return i; +void fl_multiline_output_draw(MULTILINEOUTPUT i) { + reinterpret_cast(i)->Fl_Multiline_Output::draw(); } -void free_fl_multiline_output(MULTILINE_OUTPUT i) { - delete reinterpret_cast(i); +int fl_multiline_output_handle(MULTILINEOUTPUT i, int e) { + return reinterpret_cast(i)->Fl_Multiline_Output::handle(e); } diff --git a/src/c_fl_multiline_output.h b/src/c_fl_multiline_output.h index 6517e21..43fee90 100644 --- a/src/c_fl_multiline_output.h +++ b/src/c_fl_multiline_output.h @@ -8,24 +8,17 @@ #define FL_MULTILINE_OUTPUT_GUARD +typedef void* MULTILINEOUTPUT; -typedef void* MULTILINE_OUTPUT; +extern "C" MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label); +extern "C" void free_fl_multiline_output(MULTILINEOUTPUT i); - - -extern "C" void multiline_output_set_draw_hook(MULTILINE_OUTPUT i, void * d); -extern "C" void fl_multiline_output_draw(MULTILINE_OUTPUT i); -extern "C" void multiline_output_set_handle_hook(MULTILINE_OUTPUT i, void * h); -extern "C" int fl_multiline_output_handle(MULTILINE_OUTPUT i, int e); - - - - -extern "C" MULTILINE_OUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_multiline_output(MULTILINE_OUTPUT i); +extern "C" void fl_multiline_output_draw(MULTILINEOUTPUT i); +extern "C" int fl_multiline_output_handle(MULTILINEOUTPUT i, int e); #endif + diff --git a/src/c_fl_output.cpp b/src/c_fl_output.cpp index d591c59..2251f8d 100644 --- a/src/c_fl_output.cpp +++ b/src/c_fl_output.cpp @@ -6,62 +6,44 @@ #include #include "c_fl_output.h" -#include "c_fl_type.h" -class My_Output : public Fl_Output { - public: - using Fl_Output::Fl_Output; - friend void output_set_draw_hook(OUTPUTT i, void * d); - friend void fl_output_draw(OUTPUTT i); - friend void output_set_handle_hook(OUTPUTT i, void * h); - friend int fl_output_handle(OUTPUTT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; +// Exports from Ada -void My_Output::draw() { - (*draw_hook)(this->user_data()); -} +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); -void My_Output::real_draw() { - Fl_Output::draw(); -} -int My_Output::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} -int My_Output::real_handle(int e) { - return Fl_Output::handle(e); -} -void output_set_draw_hook(OUTPUTT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} +// Attaching all relevant hooks and friends -void fl_output_draw(OUTPUTT i) { - reinterpret_cast(i)->real_draw(); -} +class My_Output : public Fl_Output { +public: + using Fl_Output::Fl_Output; + + friend void fl_output_draw(OUTPUTT i); + friend int fl_output_handle(OUTPUTT i, int e); + + void draw(); + int handle(int e); +}; -void output_set_handle_hook(OUTPUTT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +void My_Output::draw() { + widget_draw_hook(this->user_data()); } -int fl_output_handle(OUTPUTT i, int e) { - return reinterpret_cast(i)->real_handle(e); +int My_Output::handle(int e) { + return widget_handle_hook(this->user_data(), e); } +// Flattened C API + OUTPUTT new_fl_output(int x, int y, int w, int h, char* label) { My_Output *i = new My_Output(x, y, w, h, label); return i; @@ -72,3 +54,14 @@ void free_fl_output(OUTPUTT i) { } + + +void fl_output_draw(OUTPUTT i) { + reinterpret_cast(i)->Fl_Output::draw(); +} + +int fl_output_handle(OUTPUTT i, int e) { + return reinterpret_cast(i)->Fl_Output::handle(e); +} + + diff --git a/src/c_fl_output.h b/src/c_fl_output.h index dba1b8a..174c32e 100644 --- a/src/c_fl_output.h +++ b/src/c_fl_output.h @@ -8,26 +8,19 @@ #define FL_OUTPUT_GUARD - - // using just "OUTPUT" doesn't compile for some reason // some sort of name clash? typedef void* OUTPUTT; +extern "C" OUTPUTT new_fl_output(int x, int y, int w, int h, char* label); +extern "C" void free_fl_output(OUTPUTT i); -extern "C" void output_set_draw_hook(OUTPUTT i, void * d); extern "C" void fl_output_draw(OUTPUTT i); -extern "C" void output_set_handle_hook(OUTPUTT i, void * h); extern "C" int fl_output_handle(OUTPUTT i, int e); - - -extern "C" OUTPUTT new_fl_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_output(OUTPUTT i); - - #endif + diff --git a/src/c_fl_secret_input.cpp b/src/c_fl_secret_input.cpp index ddff53d..9bf1753 100644 --- a/src/c_fl_secret_input.cpp +++ b/src/c_fl_secret_input.cpp @@ -6,69 +6,62 @@ #include #include "c_fl_secret_input.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + class My_Secret_Input : public Fl_Secret_Input { - public: - using Fl_Secret_Input::Fl_Secret_Input; - friend void secret_input_set_draw_hook(SECRET_INPUT i, void * d); - friend void fl_secret_input_draw(SECRET_INPUT i); - friend void secret_input_set_handle_hook(SECRET_INPUT i, void * h); - friend int fl_secret_input_handle(SECRET_INPUT i, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Secret_Input::Fl_Secret_Input; + + friend void fl_secret_input_draw(SECRETINPUT i); + friend int fl_secret_input_handle(SECRETINPUT i, int e); + + void draw(); + int handle(int e); }; void My_Secret_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Secret_Input::real_draw() { - Fl_Secret_Input::draw(); + widget_draw_hook(this->user_data()); } int My_Secret_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); + return widget_handle_hook(this->user_data(), e); } -int My_Secret_Input::real_handle(int e) { - return Fl_Secret_Input::handle(e); -} -void secret_input_set_draw_hook(SECRET_INPUT i, void * d) { - reinterpret_cast(i)->draw_hook = reinterpret_cast(d); -} -void fl_secret_input_draw(SECRET_INPUT i) { - reinterpret_cast(i)->real_draw(); -} -void secret_input_set_handle_hook(SECRET_INPUT i, void * h) { - reinterpret_cast(i)->handle_hook = reinterpret_cast(h); +// Flattened C API + +SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label) { + My_Secret_Input *i = new My_Secret_Input(x, y, w, h, label); + return i; } -int fl_secret_input_handle(SECRET_INPUT i, int e) { - return reinterpret_cast(i)->real_handle(e); +void free_fl_secret_input(SECRETINPUT i) { + delete reinterpret_cast(i); } -SECRET_INPUT new_fl_secret_input(int x, int y, int w, int h, char* label) { - My_Secret_Input *i = new My_Secret_Input(x, y, w, h, label); - return i; +void fl_secret_input_draw(SECRETINPUT i) { + reinterpret_cast(i)->Fl_Secret_Input::draw(); } -void free_fl_secret_input(SECRET_INPUT i) { - delete reinterpret_cast(i); +int fl_secret_input_handle(SECRETINPUT i, int e) { + return reinterpret_cast(i)->Fl_Secret_Input::handle(e); } diff --git a/src/c_fl_secret_input.h b/src/c_fl_secret_input.h index 58fc88a..ea171d8 100644 --- a/src/c_fl_secret_input.h +++ b/src/c_fl_secret_input.h @@ -8,24 +8,17 @@ #define FL_SECRET_INPUT_GUARD +typedef void* SECRETINPUT; -typedef void* SECRET_INPUT; +extern "C" SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_secret_input(SECRETINPUT i); - - -extern "C" void secret_input_set_draw_hook(SECRET_INPUT i, void * d); -extern "C" void fl_secret_input_draw(SECRET_INPUT i); -extern "C" void secret_input_set_handle_hook(SECRET_INPUT i, void * h); -extern "C" int fl_secret_input_handle(SECRET_INPUT i, int e); - - - - -extern "C" SECRET_INPUT new_fl_secret_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_secret_input(SECRET_INPUT i); +extern "C" void fl_secret_input_draw(SECRETINPUT i); +extern "C" int fl_secret_input_handle(SECRETINPUT i, int e); #endif + diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp index 44c5939..61e5a96 100644 --- a/src/c_fl_widget.cpp +++ b/src/c_fl_widget.cpp @@ -7,38 +7,49 @@ #include #include #include "c_fl_widget.h" -#include "c_fl_type.h" +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Non-friend protected access + +class Friend_Widget : Fl_Widget { +public: + // probably expand this later when doing a pass for protected methods + using Fl_Widget::draw_box; +}; + + + + +// Attaching all relevant hooks and friends + class My_Widget : public Fl_Widget { - public: - using Fl_Widget::Fl_Widget; - friend void widget_set_draw_hook(WIDGET w, void * d); - friend void widget_set_handle_hook(WIDGET w, void * h); - friend WIDGET new_fl_widget(int x, int y, int w, int h, char* label); - protected: - void draw(); - int handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; +public: + using Fl_Widget::Fl_Widget; + friend WIDGET new_fl_widget(int x, int y, int w, int h, char* label); + + friend void fl_widget_draw(WIDGET w); + friend int fl_widget_handle(WIDGET w, int e); + + void draw(); + int handle(int e); }; void My_Widget::draw() { - (*draw_hook)(this->user_data()); + widget_draw_hook(this->user_data()); } int My_Widget::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -void widget_set_draw_hook(WIDGET w, void * d) { - reinterpret_cast(w)->draw_hook = reinterpret_cast(d); -} - -void widget_set_handle_hook(WIDGET w, void * h) { - reinterpret_cast(w)->handle_hook = reinterpret_cast(h); + return widget_handle_hook(this->user_data(), e); } @@ -349,6 +360,14 @@ void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h) { } } +void fl_widget_draw(WIDGET w) { + // The Fl_Widget draw method doesn't technically exist, so... + (void)(w); + // It is more convenient for this function to exist, however, + // even though it will likely never be called, because it simplifies + // and makes uniform the implementation of the Ada Widget Draw subprogram. +} + void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a) { reinterpret_cast(w)->draw_label(x,y,d,h,a); } @@ -361,3 +380,8 @@ void fl_widget_redraw_label(WIDGET w) { reinterpret_cast(w)->redraw_label(); } +int fl_widget_handle(WIDGET w, int e) { + return reinterpret_cast(w)->Fl_Widget::handle(e); +} + + diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h index bdf6715..669ccda 100644 --- a/src/c_fl_widget.h +++ b/src/c_fl_widget.h @@ -8,25 +8,13 @@ #define FL_WIDGET_GUARD - - typedef void* WIDGET; - - -extern "C" void widget_set_draw_hook(WIDGET w, void * d); -extern "C" void widget_set_handle_hook(WIDGET w, void * h); - - - - extern "C" WIDGET new_fl_widget(int x, int y, int w, int h, char* label); extern "C" void free_fl_widget(WIDGET w); - - extern "C" void * fl_widget_get_user_data(WIDGET w); extern "C" void fl_widget_set_user_data(WIDGET w, void * d); @@ -112,9 +100,11 @@ extern "C" void fl_widget_set_deimage(WIDGET w, void * img); extern "C" int fl_widget_damage(WIDGET w); extern "C" void fl_widget_set_damage(WIDGET w, int t); extern "C" void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h); +extern "C" void fl_widget_draw(WIDGET w); extern "C" void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a); extern "C" void fl_widget_redraw(WIDGET w); extern "C" void fl_widget_redraw_label(WIDGET w); +extern "C" int fl_widget_handle(WIDGET w, int e); #endif diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb deleted file mode 100644 index b8aa4f3..0000000 --- a/src/fltk-widgets-inputs-file.adb +++ /dev/null @@ -1,238 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.File is - - - procedure file_input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, file_input_set_draw_hook, "file_input_set_draw_hook"); - pragma Inline (file_input_set_draw_hook); - - procedure file_input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, file_input_set_handle_hook, "file_input_set_handle_hook"); - pragma Inline (file_input_set_handle_hook); - - - - - function new_fl_file_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_file_input, "new_fl_file_input"); - pragma Inline (new_fl_file_input); - - procedure free_fl_file_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_file_input, "free_fl_file_input"); - pragma Inline (free_fl_file_input); - - - - - function fl_file_input_get_down_box - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_input_get_down_box, "fl_file_input_get_down_box"); - pragma Inline (fl_file_input_get_down_box); - - procedure fl_file_input_set_down_box - (F : in Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_file_input_set_down_box, "fl_file_input_set_down_box"); - pragma Inline (fl_file_input_set_down_box); - - function fl_file_input_get_errorcolor - (F : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_file_input_get_errorcolor, "fl_file_input_get_errorcolor"); - pragma Inline (fl_file_input_get_errorcolor); - - procedure fl_file_input_set_errorcolor - (F : in Storage.Integer_Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_file_input_set_errorcolor, "fl_file_input_set_errorcolor"); - pragma Inline (fl_file_input_set_errorcolor); - - - - - function fl_file_input_get_value - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_input_get_value, "fl_file_input_get_value"); - pragma Inline (fl_file_input_get_value); - - procedure fl_file_input_set_value - (I : in Storage.Integer_Address; - T : in Interfaces.C.char_array; - L : in Interfaces.C.int); - pragma Import (C, fl_file_input_set_value, "fl_file_input_set_value"); - pragma Inline (fl_file_input_set_value); - - - - - procedure fl_file_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); - pragma Inline (fl_file_input_draw); - - function fl_file_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); - pragma Inline (fl_file_input_handle); - - - - - procedure Extra_Final - (This : in out File_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out File_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_file_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out File_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Input is - begin - return This : File_Input do - This.Void_Ptr := new_fl_file_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - file_input_set_draw_hook - (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - file_input_set_handle_hook - (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - function Get_Down_Box - (This : in File_Input) - return Box_Kind is - begin - return Box_Kind'Val (fl_file_input_get_down_box (This.Void_Ptr)); - end Get_Down_Box; - - - procedure Set_Down_Box - (This : in out File_Input; - To : in Box_Kind) is - begin - fl_file_input_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Down_Box; - - - function Get_Error_Color - (This : in File_Input) - return Color is - begin - return Color (fl_file_input_get_errorcolor (This.Void_Ptr)); - end Get_Error_Color; - - - procedure Set_Error_Color - (This : in out File_Input; - To : in Color) is - begin - fl_file_input_set_errorcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Error_Color; - - - - - function Get_Value - (This : in Input) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Value; - - - procedure Set_Value - (This : in out Input; - To : in String) is - begin - fl_file_input_set_value (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); - end Set_Value; - - - - - procedure Draw - (This : in out File_Input) is - begin - fl_file_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out File_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_file_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.File; - diff --git a/src/fltk-widgets-inputs-file.ads b/src/fltk-widgets-inputs-file.ads deleted file mode 100644 index fc6d845..0000000 --- a/src/fltk-widgets-inputs-file.ads +++ /dev/null @@ -1,101 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.File is - - - type File_Input is new Input with private; - - type File_Input_Reference (Data : not null access File_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Input; - - end Forge; - - - - - function Get_Down_Box - (This : in File_Input) - return Box_Kind; - - procedure Set_Down_Box - (This : in out File_Input; - To : in Box_Kind); - - function Get_Error_Color - (This : in File_Input) - return Color; - - procedure Set_Error_Color - (This : in out File_Input; - To : in Color); - - - - - function Get_Value - (This : in Input) - return String; - - procedure Set_Value - (This : in out Input; - To : in String); - - - - - procedure Draw - (This : in out File_Input); - - function Handle - (This : in out File_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type File_Input is new Input with null record; - - overriding procedure Finalize - (This : in out File_Input); - - procedure Extra_Init - (This : in out File_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out File_Input) - with Inline; - - - pragma Inline (Get_Down_Box); - pragma Inline (Set_Down_Box); - pragma Inline (Get_Error_Color); - pragma Inline (Set_Error_Color); - - pragma Inline (Get_Value); - pragma Inline (Set_Value); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.File; - diff --git a/src/fltk-widgets-inputs-floating_point.adb b/src/fltk-widgets-inputs-floating_point.adb deleted file mode 100644 index 68b7fe6..0000000 --- a/src/fltk-widgets-inputs-floating_point.adb +++ /dev/null @@ -1,154 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.Floating_Point is - - - procedure float_input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, float_input_set_draw_hook, "float_input_set_draw_hook"); - pragma Inline (float_input_set_draw_hook); - - procedure float_input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, float_input_set_handle_hook, "float_input_set_handle_hook"); - pragma Inline (float_input_set_handle_hook); - - - - - function new_fl_float_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_float_input, "new_fl_float_input"); - pragma Inline (new_fl_float_input); - - procedure free_fl_float_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_float_input, "free_fl_float_input"); - pragma Inline (free_fl_float_input); - - - - - procedure fl_float_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); - pragma Inline (fl_float_input_draw); - - function fl_float_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); - pragma Inline (fl_float_input_handle); - - - - - procedure Extra_Final - (This : in out Float_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Float_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_float_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Float_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Float_Input is - begin - return This : Float_Input do - This.Void_Ptr := new_fl_float_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - float_input_set_draw_hook - (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - float_input_set_handle_hook - (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - function Get_Value - (This : in Float_Input) - return Long_Float - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr or else - Interfaces.C.Strings.Value (Ptr) = "" - then - return 0.0; - else - return Long_Float'Value (Interfaces.C.Strings.Value (Ptr)); - end if; - end Get_Value; - - - - - procedure Draw - (This : in out Float_Input) is - begin - fl_float_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Float_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_float_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Floating_Point; - diff --git a/src/fltk-widgets-inputs-floating_point.ads b/src/fltk-widgets-inputs-floating_point.ads deleted file mode 100644 index dcc19de..0000000 --- a/src/fltk-widgets-inputs-floating_point.ads +++ /dev/null @@ -1,72 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Floating_Point is - - - type Float_Input is new Input with private; - - type Float_Input_Reference (Data : not null access Float_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Float_Input; - - end Forge; - - - - - function Get_Value - (This : in Float_Input) - return Long_Float; - - - - - procedure Draw - (This : in out Float_Input); - - function Handle - (This : in out Float_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Float_Input is new Input with null record; - - overriding procedure Finalize - (This : in out Float_Input); - - procedure Extra_Init - (This : in out Float_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Float_Input) - with Inline; - - - pragma Inline (Get_Value); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Floating_Point; - diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb deleted file mode 100644 index 3c33ef9..0000000 --- a/src/fltk-widgets-inputs-multiline.adb +++ /dev/null @@ -1,132 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Multiline is - - - procedure multiline_input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, multiline_input_set_draw_hook, "multiline_input_set_draw_hook"); - pragma Inline (multiline_input_set_draw_hook); - - procedure multiline_input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, multiline_input_set_handle_hook, "multiline_input_set_handle_hook"); - pragma Inline (multiline_input_set_handle_hook); - - - - - function new_fl_multiline_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_multiline_input, "new_fl_multiline_input"); - pragma Inline (new_fl_multiline_input); - - procedure free_fl_multiline_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input"); - pragma Inline (free_fl_multiline_input); - - - - - procedure fl_multiline_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); - pragma Inline (fl_multiline_input_draw); - - function fl_multiline_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); - pragma Inline (fl_multiline_input_handle); - - - - - procedure Extra_Final - (This : in out Multiline_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Multiline_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_multiline_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Multiline_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Input is - begin - return This : Multiline_Input do - This.Void_Ptr := new_fl_multiline_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - multiline_input_set_draw_hook - (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - multiline_input_set_handle_hook - (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Multiline_Input) is - begin - fl_multiline_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Multiline_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_multiline_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Multiline; - diff --git a/src/fltk-widgets-inputs-multiline.ads b/src/fltk-widgets-inputs-multiline.ads deleted file mode 100644 index 4b7d596..0000000 --- a/src/fltk-widgets-inputs-multiline.ads +++ /dev/null @@ -1,63 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Multiline is - - - type Multiline_Input is new Input with private; - - type Multiline_Input_Reference (Data : not null access Multiline_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Input; - - end Forge; - - - - - procedure Draw - (This : in out Multiline_Input); - - function Handle - (This : in out Multiline_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Multiline_Input is new Input with null record; - - overriding procedure Finalize - (This : in out Multiline_Input); - - procedure Extra_Init - (This : in out Multiline_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Multiline_Input) - with Inline; - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Multiline; - diff --git a/src/fltk-widgets-inputs-outputs-multiline.adb b/src/fltk-widgets-inputs-outputs-multiline.adb deleted file mode 100644 index 626a4ee..0000000 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ /dev/null @@ -1,132 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Outputs.Multiline is - - - procedure multiline_output_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, multiline_output_set_draw_hook, "multiline_output_set_draw_hook"); - pragma Inline (multiline_output_set_draw_hook); - - procedure multiline_output_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, multiline_output_set_handle_hook, "multiline_output_set_handle_hook"); - pragma Inline (multiline_output_set_handle_hook); - - - - - function new_fl_multiline_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_multiline_output, "new_fl_multiline_output"); - pragma Inline (new_fl_multiline_output); - - procedure free_fl_multiline_output - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output"); - pragma Inline (free_fl_multiline_output); - - - - - procedure fl_multiline_output_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); - pragma Inline (fl_multiline_output_draw); - - function fl_multiline_output_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); - pragma Inline (fl_multiline_output_handle); - - - - - procedure Extra_Final - (This : in out Multiline_Output) is - begin - Extra_Final (Output (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Multiline_Output) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_multiline_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Multiline_Output; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Output (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Output is - begin - return This : Multiline_Output do - This.Void_Ptr := new_fl_multiline_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - multiline_output_set_draw_hook - (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - multiline_output_set_handle_hook - (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Multiline_Output) is - begin - fl_multiline_output_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Multiline_Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_multiline_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Outputs.Multiline; - diff --git a/src/fltk-widgets-inputs-outputs-multiline.ads b/src/fltk-widgets-inputs-outputs-multiline.ads deleted file mode 100644 index 23e2725..0000000 --- a/src/fltk-widgets-inputs-outputs-multiline.ads +++ /dev/null @@ -1,63 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Outputs.Multiline is - - - type Multiline_Output is new Output with private; - - type Multiline_Output_Reference (Data : not null access Multiline_Output'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Output; - - end Forge; - - - - - procedure Draw - (This : in out Multiline_Output); - - function Handle - (This : in out Multiline_Output; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Multiline_Output is new Output with null record; - - overriding procedure Finalize - (This : in out Multiline_Output); - - procedure Extra_Init - (This : in out Multiline_Output; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Multiline_Output) - with Inline; - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Outputs.Multiline; - diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb deleted file mode 100644 index 924e60b..0000000 --- a/src/fltk-widgets-inputs-outputs.adb +++ /dev/null @@ -1,130 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Outputs is - - - procedure output_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, output_set_draw_hook, "output_set_draw_hook"); - pragma Inline (output_set_draw_hook); - - procedure output_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, output_set_handle_hook, "output_set_handle_hook"); - pragma Inline (output_set_handle_hook); - - - - - function new_fl_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_output, "new_fl_output"); - pragma Inline (new_fl_output); - - procedure free_fl_output - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_output, "free_fl_output"); - pragma Inline (free_fl_output); - - - - - procedure fl_output_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_output_draw, "fl_output_draw"); - pragma Inline (fl_output_draw); - - function fl_output_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_output_handle, "fl_output_handle"); - pragma Inline (fl_output_handle); - - - - - procedure Extra_Final - (This : in out Output) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Output) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Output; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Output is - begin - return This : Output do - This.Void_Ptr := new_fl_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Output) is - begin - fl_output_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Outputs; - diff --git a/src/fltk-widgets-inputs-outputs.ads b/src/fltk-widgets-inputs-outputs.ads deleted file mode 100644 index d9c060d..0000000 --- a/src/fltk-widgets-inputs-outputs.ads +++ /dev/null @@ -1,63 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Outputs is - - - type Output is new Input with private; - - type Output_Reference (Data : not null access Output'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Output; - - end Forge; - - - - - procedure Draw - (This : in out Output); - - function Handle - (This : in out Output; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Output is new Input with null record; - - overriding procedure Finalize - (This : in out Output); - - procedure Extra_Init - (This : in out Output; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Output) - with Inline; - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Outputs; - diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb deleted file mode 100644 index 2cd59eb..0000000 --- a/src/fltk-widgets-inputs-secret.adb +++ /dev/null @@ -1,132 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Secret is - - - procedure secret_input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, secret_input_set_draw_hook, "secret_input_set_draw_hook"); - pragma Inline (secret_input_set_draw_hook); - - procedure secret_input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, secret_input_set_handle_hook, "secret_input_set_handle_hook"); - pragma Inline (secret_input_set_handle_hook); - - - - - function new_fl_secret_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_secret_input, "new_fl_secret_input"); - pragma Inline (new_fl_secret_input); - - procedure free_fl_secret_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_secret_input, "free_fl_secret_input"); - pragma Inline (free_fl_secret_input); - - - - - procedure fl_secret_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); - pragma Inline (fl_secret_input_draw); - - function fl_secret_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); - pragma Inline (fl_secret_input_handle); - - - - - procedure Extra_Final - (This : in out Secret_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Secret_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_secret_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Secret_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Secret_Input is - begin - return This : Secret_Input do - This.Void_Ptr := new_fl_secret_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - secret_input_set_draw_hook - (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - secret_input_set_handle_hook - (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Secret_Input) is - begin - fl_secret_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Secret_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_secret_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Secret; - diff --git a/src/fltk-widgets-inputs-secret.ads b/src/fltk-widgets-inputs-secret.ads deleted file mode 100644 index 2f419b7..0000000 --- a/src/fltk-widgets-inputs-secret.ads +++ /dev/null @@ -1,63 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Secret is - - - type Secret_Input is new Input with private; - - type Secret_Input_Reference (Data : not null access Secret_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Secret_Input; - - end Forge; - - - - - procedure Draw - (This : in out Secret_Input); - - function Handle - (This : in out Secret_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Secret_Input is new Input with null record; - - overriding procedure Finalize - (This : in out Secret_Input); - - procedure Extra_Init - (This : in out Secret_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Secret_Input) - with Inline; - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Secret; - diff --git a/src/fltk-widgets-inputs-text-file.adb b/src/fltk-widgets-inputs-text-file.adb new file mode 100644 index 0000000..ce4a625 --- /dev/null +++ b/src/fltk-widgets-inputs-text-file.adb @@ -0,0 +1,259 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + Interfaces.C.Strings; + +use type + + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Widgets.Inputs.Text.File is + + + package Chk renames Ada.Assertions; + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_file_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_file_input, "new_fl_file_input"); + pragma Inline (new_fl_file_input); + + procedure free_fl_file_input + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_file_input, "free_fl_file_input"); + pragma Inline (free_fl_file_input); + + + + + function fl_file_input_get_down_box + (F : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_file_input_get_down_box, "fl_file_input_get_down_box"); + pragma Inline (fl_file_input_get_down_box); + + procedure fl_file_input_set_down_box + (F : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_file_input_set_down_box, "fl_file_input_set_down_box"); + pragma Inline (fl_file_input_set_down_box); + + function fl_file_input_get_errorcolor + (F : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_file_input_get_errorcolor, "fl_file_input_get_errorcolor"); + pragma Inline (fl_file_input_get_errorcolor); + + procedure fl_file_input_set_errorcolor + (F : in Storage.Integer_Address; + T : in Interfaces.C.unsigned); + pragma Import (C, fl_file_input_set_errorcolor, "fl_file_input_set_errorcolor"); + pragma Inline (fl_file_input_set_errorcolor); + + + + + function fl_file_input_get_value + (F : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_file_input_get_value, "fl_file_input_get_value"); + pragma Inline (fl_file_input_get_value); + + function fl_file_input_set_value + (I : in Storage.Integer_Address; + T : in Interfaces.C.char_array; + L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_file_input_set_value, "fl_file_input_set_value"); + pragma Inline (fl_file_input_set_value); + + + + + procedure fl_file_input_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); + pragma Inline (fl_file_input_draw); + + function fl_file_input_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); + pragma Inline (fl_file_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out File_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out File_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_file_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out File_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out File_Input) is + begin + This.Draw_Ptr := fl_file_input_draw'Address; + This.Handle_Ptr := fl_file_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return File_Input is + begin + return This : File_Input do + This.Void_Ptr := new_fl_file_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Down_Box + (This : in File_Input) + return Box_Kind is + begin + return Box_Kind'Val (fl_file_input_get_down_box (This.Void_Ptr)); + end Get_Down_Box; + + + procedure Set_Down_Box + (This : in out File_Input; + To : in Box_Kind) is + begin + fl_file_input_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); + end Set_Down_Box; + + + function Get_Error_Color + (This : in File_Input) + return Color is + begin + return Color (fl_file_input_get_errorcolor (This.Void_Ptr)); + end Get_Error_Color; + + + procedure Set_Error_Color + (This : in out File_Input; + To : in Color) is + begin + fl_file_input_set_errorcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); + end Set_Error_Color; + + + + + function Get_Value + (This : in File_Input) + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); + begin + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer only, so no Free required + return Interfaces.C.Strings.Value (Ptr); + end if; + end Get_Value; + + + procedure Set_Value + (This : in out File_Input; + To : in String) + is + Result : Interfaces.C.int := fl_file_input_set_value + (This.Void_Ptr, + Interfaces.C.To_C (To), To'Length); + begin + pragma Assert (Result /= 0); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; + end Set_Value; + + + + + procedure Draw + (This : in out File_Input) is + begin + Text_Input (This).Draw; + end Draw; + + + function Handle + (This : in out File_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Text_Input (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Inputs.Text.File; + + diff --git a/src/fltk-widgets-inputs-text-file.ads b/src/fltk-widgets-inputs-text-file.ads new file mode 100644 index 0000000..74ea7e1 --- /dev/null +++ b/src/fltk-widgets-inputs-text-file.ads @@ -0,0 +1,105 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.File is + + + type File_Input is new Text_Input with private; + + type File_Input_Reference (Data : not null access File_Input'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return File_Input; + + end Forge; + + + + + function Get_Down_Box + (This : in File_Input) + return Box_Kind; + + procedure Set_Down_Box + (This : in out File_Input; + To : in Box_Kind); + + function Get_Error_Color + (This : in File_Input) + return Color; + + procedure Set_Error_Color + (This : in out File_Input; + To : in Color); + + + + + function Get_Value + (This : in File_Input) + return String; + + procedure Set_Value + (This : in out File_Input; + To : in String); + + + + + procedure Draw + (This : in out File_Input); + + function Handle + (This : in out File_Input; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type File_Input is new Text_Input with null record; + + overriding procedure Initialize + (This : in out File_Input); + + overriding procedure Finalize + (This : in out File_Input); + + procedure Extra_Init + (This : in out File_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out File_Input) + with Inline; + + + pragma Inline (Get_Down_Box); + pragma Inline (Set_Down_Box); + pragma Inline (Get_Error_Color); + pragma Inline (Set_Error_Color); + + pragma Inline (Get_Value); + pragma Inline (Set_Value); + + pragma Inline (Draw); + pragma Inline (Handle); + + +end FLTK.Widgets.Inputs.Text.File; + + diff --git a/src/fltk-widgets-inputs-text-floating_point.adb b/src/fltk-widgets-inputs-text-floating_point.adb new file mode 100644 index 0000000..61ea531 --- /dev/null +++ b/src/fltk-widgets-inputs-text-floating_point.adb @@ -0,0 +1,143 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + +use type + + Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Widgets.Inputs.Text.Floating_Point is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_float_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_float_input, "new_fl_float_input"); + pragma Inline (new_fl_float_input); + + procedure free_fl_float_input + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_float_input, "free_fl_float_input"); + pragma Inline (free_fl_float_input); + + + + + procedure fl_float_input_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); + pragma Inline (fl_float_input_draw); + + function fl_float_input_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); + pragma Inline (fl_float_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Float_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Float_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_float_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Float_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Float_Input) is + begin + This.Draw_Ptr := fl_float_input_draw'Address; + This.Handle_Ptr := fl_float_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Float_Input is + begin + return This : Float_Input do + This.Void_Ptr := new_fl_float_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Value + (This : in Float_Input) + return Long_Float + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); + begin + if Ptr = Interfaces.C.Strings.Null_Ptr or else + Interfaces.C.Strings.Value (Ptr) = "" + then + return 0.0; + else + return Long_Float'Value (Interfaces.C.Strings.Value (Ptr)); + end if; + end Get_Value; + + +end FLTK.Widgets.Inputs.Text.Floating_Point; + + diff --git a/src/fltk-widgets-inputs-text-floating_point.ads b/src/fltk-widgets-inputs-text-floating_point.ads new file mode 100644 index 0000000..a6bc600 --- /dev/null +++ b/src/fltk-widgets-inputs-text-floating_point.ads @@ -0,0 +1,62 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Floating_Point is + + + type Float_Input is new Text_Input with private; + + type Float_Input_Reference (Data : not null access Float_Input'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Float_Input; + + end Forge; + + + + + function Get_Value + (This : in Float_Input) + return Long_Float; + + +private + + + type Float_Input is new Text_Input with null record; + + overriding procedure Initialize + (This : in out Float_Input); + + overriding procedure Finalize + (This : in out Float_Input); + + procedure Extra_Init + (This : in out Float_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Float_Input) + with Inline; + + + pragma Inline (Get_Value); + + +end FLTK.Widgets.Inputs.Text.Floating_Point; + + diff --git a/src/fltk-widgets-inputs-text-multiline.adb b/src/fltk-widgets-inputs-text-multiline.adb new file mode 100644 index 0000000..2bed66d --- /dev/null +++ b/src/fltk-widgets-inputs-text-multiline.adb @@ -0,0 +1,117 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Widgets.Inputs.Text.Multiline is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_multiline_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_multiline_input, "new_fl_multiline_input"); + pragma Inline (new_fl_multiline_input); + + procedure free_fl_multiline_input + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input"); + pragma Inline (free_fl_multiline_input); + + + + + procedure fl_multiline_input_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); + pragma Inline (fl_multiline_input_draw); + + function fl_multiline_input_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); + pragma Inline (fl_multiline_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Multiline_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Multiline_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_multiline_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Multiline_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Multiline_Input) is + begin + This.Draw_Ptr := fl_multiline_input_draw'Address; + This.Handle_Ptr := fl_multiline_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Multiline_Input is + begin + return This : Multiline_Input do + This.Void_Ptr := new_fl_multiline_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + +end FLTK.Widgets.Inputs.Text.Multiline; + + diff --git a/src/fltk-widgets-inputs-text-multiline.ads b/src/fltk-widgets-inputs-text-multiline.ads new file mode 100644 index 0000000..0a51992 --- /dev/null +++ b/src/fltk-widgets-inputs-text-multiline.ads @@ -0,0 +1,52 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Multiline is + + + type Multiline_Input is new Text_Input with private; + + type Multiline_Input_Reference (Data : not null access Multiline_Input'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Multiline_Input; + + end Forge; + + +private + + + type Multiline_Input is new Text_Input with null record; + + overriding procedure Initialize + (This : in out Multiline_Input); + + overriding procedure Finalize + (This : in out Multiline_Input); + + procedure Extra_Init + (This : in out Multiline_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Multiline_Input) + with Inline; + + +end FLTK.Widgets.Inputs.Text.Multiline; + + diff --git a/src/fltk-widgets-inputs-text-outputs-multiline.adb b/src/fltk-widgets-inputs-text-outputs-multiline.adb new file mode 100644 index 0000000..021377e --- /dev/null +++ b/src/fltk-widgets-inputs-text-outputs-multiline.adb @@ -0,0 +1,117 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Widgets.Inputs.Text.Outputs.Multiline is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_multiline_output + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_multiline_output, "new_fl_multiline_output"); + pragma Inline (new_fl_multiline_output); + + procedure free_fl_multiline_output + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output"); + pragma Inline (free_fl_multiline_output); + + + + + procedure fl_multiline_output_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); + pragma Inline (fl_multiline_output_draw); + + function fl_multiline_output_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); + pragma Inline (fl_multiline_output_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Multiline_Output) is + begin + Extra_Final (Output (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Multiline_Output) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_multiline_output (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Multiline_Output; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Output (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Multiline_Output) is + begin + This.Draw_Ptr := fl_multiline_output_draw'Address; + This.Handle_Ptr := fl_multiline_output_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Multiline_Output is + begin + return This : Multiline_Output do + This.Void_Ptr := new_fl_multiline_output + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + +end FLTK.Widgets.Inputs.Text.Outputs.Multiline; + + diff --git a/src/fltk-widgets-inputs-text-outputs-multiline.ads b/src/fltk-widgets-inputs-text-outputs-multiline.ads new file mode 100644 index 0000000..4600616 --- /dev/null +++ b/src/fltk-widgets-inputs-text-outputs-multiline.ads @@ -0,0 +1,52 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Outputs.Multiline is + + + type Multiline_Output is new Output with private; + + type Multiline_Output_Reference (Data : not null access Multiline_Output'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Multiline_Output; + + end Forge; + + +private + + + type Multiline_Output is new Output with null record; + + overriding procedure Initialize + (This : in out Multiline_Output); + + overriding procedure Finalize + (This : in out Multiline_Output); + + procedure Extra_Init + (This : in out Multiline_Output; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Multiline_Output) + with Inline; + + +end FLTK.Widgets.Inputs.Text.Outputs.Multiline; + + diff --git a/src/fltk-widgets-inputs-text-outputs.adb b/src/fltk-widgets-inputs-text-outputs.adb new file mode 100644 index 0000000..07f9294 --- /dev/null +++ b/src/fltk-widgets-inputs-text-outputs.adb @@ -0,0 +1,117 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Widgets.Inputs.Text.Outputs is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_output + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_output, "new_fl_output"); + pragma Inline (new_fl_output); + + procedure free_fl_output + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_output, "free_fl_output"); + pragma Inline (free_fl_output); + + + + + procedure fl_output_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_output_draw, "fl_output_draw"); + pragma Inline (fl_output_draw); + + function fl_output_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_output_handle, "fl_output_handle"); + pragma Inline (fl_output_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Output) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Output) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_output (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Output; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Output) is + begin + This.Draw_Ptr := fl_output_draw'Address; + This.Handle_Ptr := fl_output_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Output is + begin + return This : Output do + This.Void_Ptr := new_fl_output + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + +end FLTK.Widgets.Inputs.Text.Outputs; + + diff --git a/src/fltk-widgets-inputs-text-outputs.ads b/src/fltk-widgets-inputs-text-outputs.ads new file mode 100644 index 0000000..7e003e6 --- /dev/null +++ b/src/fltk-widgets-inputs-text-outputs.ads @@ -0,0 +1,52 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Outputs is + + + type Output is new Text_Input with private; + + type Output_Reference (Data : not null access Output'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Output; + + end Forge; + + +private + + + type Output is new Text_Input with null record; + + overriding procedure Initialize + (This : in out Output); + + overriding procedure Finalize + (This : in out Output); + + procedure Extra_Init + (This : in out Output; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Output) + with Inline; + + +end FLTK.Widgets.Inputs.Text.Outputs; + + diff --git a/src/fltk-widgets-inputs-text-secret.adb b/src/fltk-widgets-inputs-text-secret.adb new file mode 100644 index 0000000..242d872 --- /dev/null +++ b/src/fltk-widgets-inputs-text-secret.adb @@ -0,0 +1,132 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Widgets.Inputs.Text.Secret is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_secret_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_secret_input, "new_fl_secret_input"); + pragma Inline (new_fl_secret_input); + + procedure free_fl_secret_input + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_secret_input, "free_fl_secret_input"); + pragma Inline (free_fl_secret_input); + + + + + procedure fl_secret_input_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); + pragma Inline (fl_secret_input_draw); + + function fl_secret_input_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); + pragma Inline (fl_secret_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Secret_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Secret_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_secret_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Secret_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Secret_Input) is + begin + This.Draw_Ptr := fl_secret_input_draw'Address; + This.Handle_Ptr := fl_secret_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Secret_Input is + begin + return This : Secret_Input do + This.Void_Ptr := new_fl_secret_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Handle + (This : in out Secret_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Text_Input (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Inputs.Text.Secret; + + diff --git a/src/fltk-widgets-inputs-text-secret.ads b/src/fltk-widgets-inputs-text-secret.ads new file mode 100644 index 0000000..375ebfb --- /dev/null +++ b/src/fltk-widgets-inputs-text-secret.ads @@ -0,0 +1,63 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Secret is + + + type Secret_Input is new Text_Input with private; + + type Secret_Input_Reference (Data : not null access Secret_Input'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Secret_Input; + + end Forge; + + + + + function Handle + (This : in out Secret_Input; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Secret_Input is new Text_Input with null record; + + overriding procedure Initialize + (This : in out Secret_Input); + + overriding procedure Finalize + (This : in out Secret_Input); + + procedure Extra_Init + (This : in out Secret_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Secret_Input) + with Inline; + + + pragma Inline (Handle); + + +end FLTK.Widgets.Inputs.Text.Secret; + + diff --git a/src/fltk-widgets-inputs-text-whole_number.adb b/src/fltk-widgets-inputs-text-whole_number.adb new file mode 100644 index 0000000..4d71d44 --- /dev/null +++ b/src/fltk-widgets-inputs-text-whole_number.adb @@ -0,0 +1,143 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + +use type + + Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Widgets.Inputs.Text.Whole_Number is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_int_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_int_input, "new_fl_int_input"); + pragma Inline (new_fl_int_input); + + procedure free_fl_int_input + (F : in Storage.Integer_Address); + pragma Import (C, free_fl_int_input, "free_fl_int_input"); + pragma Inline (free_fl_int_input); + + + + + procedure fl_int_input_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); + pragma Inline (fl_int_input_draw); + + function fl_int_input_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); + pragma Inline (fl_int_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Integer_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Integer_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_int_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Integer_Input; + X, Y, W, H : in Standard.Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Integer_Input) is + begin + This.Draw_Ptr := fl_int_input_draw'Address; + This.Handle_Ptr := fl_int_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Standard.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)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Value + (This : in Integer_Input) + return Long_Integer + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); + begin + if Ptr = Interfaces.C.Strings.Null_Ptr or else + Interfaces.C.Strings.Value (Ptr) = "" + then + return 0; + else + return Long_Integer'Value (Interfaces.C.Strings.Value (Ptr)); + end if; + end Get_Value; + + +end FLTK.Widgets.Inputs.Text.Whole_Number; + + diff --git a/src/fltk-widgets-inputs-text-whole_number.ads b/src/fltk-widgets-inputs-text-whole_number.ads new file mode 100644 index 0000000..0b774a6 --- /dev/null +++ b/src/fltk-widgets-inputs-text-whole_number.ads @@ -0,0 +1,62 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text.Whole_Number is + + + type Integer_Input is new Text_Input with private; + + type Integer_Input_Reference (Data : not null access Integer_Input'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Standard.Integer; + Text : in String := "") + return Integer_Input; + + end Forge; + + + + + function Get_Value + (This : in Integer_Input) + return Long_Integer; + + +private + + + type Integer_Input is new Text_Input with null record; + + overriding procedure Initialize + (This : in out Integer_Input); + + overriding procedure Finalize + (This : in out Integer_Input); + + procedure Extra_Init + (This : in out Integer_Input; + X, Y, W, H : in Standard.Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Integer_Input) + with Inline; + + + pragma Inline (Get_Value); + + +end FLTK.Widgets.Inputs.Text.Whole_Number; + + diff --git a/src/fltk-widgets-inputs-text.adb b/src/fltk-widgets-inputs-text.adb new file mode 100644 index 0000000..64e2e0f --- /dev/null +++ b/src/fltk-widgets-inputs-text.adb @@ -0,0 +1,139 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C; + + +package body FLTK.Widgets.Inputs.Text is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_text_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_text_input, "new_fl_text_input"); + pragma Inline (new_fl_text_input); + + procedure free_fl_text_input + (T : in Storage.Integer_Address); + pragma Import (C, free_fl_text_input, "free_fl_text_input"); + pragma Inline (free_fl_text_input); + + + + + procedure fl_text_input_draw + (T : in Storage.Integer_Address); + pragma Import (C, fl_text_input_draw, "fl_text_input_draw"); + pragma Inline (fl_text_input_draw); + + function fl_text_input_handle + (T : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_input_handle, "fl_text_input_handle"); + pragma Inline (fl_text_input_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Text_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Text_Input) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_text_input (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Text_Input; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Input (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Text_Input) is + begin + This.Draw_Ptr := fl_text_input_draw'Address; + This.Handle_Ptr := fl_text_input_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Text_Input is + begin + return This : Text_Input do + This.Void_Ptr := new_fl_text_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + procedure Draw + (This : in out Text_Input) is + begin + Input (This).Draw; + end Draw; + + + function Handle + (This : in out Text_Input; + Event : in Event_Kind) + return Event_Outcome is + begin + return Input (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Inputs.Text; + + diff --git a/src/fltk-widgets-inputs-text.ads b/src/fltk-widgets-inputs-text.ads new file mode 100644 index 0000000..7f0f695 --- /dev/null +++ b/src/fltk-widgets-inputs-text.ads @@ -0,0 +1,67 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Inputs.Text is + + + type Text_Input is new Input with private; + + type Text_Input_Reference (Data : not null access Text_Input'Class) is limited null record + with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Text_Input; + + end Forge; + + + + + procedure Draw + (This : in out Text_Input); + + function Handle + (This : in out Text_Input; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Text_Input is new Input with null record; + + overriding procedure Initialize + (This : in out Text_Input); + + overriding procedure Finalize + (This : in out Text_Input); + + procedure Extra_Init + (This : in out Text_Input; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Text_Input) + with Inline; + + + pragma Inline (Draw); + pragma Inline (Handle); + + +end FLTK.Widgets.Inputs.Text; + + diff --git a/src/fltk-widgets-inputs-whole_number.adb b/src/fltk-widgets-inputs-whole_number.adb deleted file mode 100644 index 0709506..0000000 --- a/src/fltk-widgets-inputs-whole_number.adb +++ /dev/null @@ -1,152 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.Whole_Number is - - - procedure int_input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, int_input_set_draw_hook, "int_input_set_draw_hook"); - pragma Inline (int_input_set_draw_hook); - - procedure int_input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, int_input_set_handle_hook, "int_input_set_handle_hook"); - pragma Inline (int_input_set_handle_hook); - - - - - function new_fl_int_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_int_input, "new_fl_int_input"); - pragma Inline (new_fl_int_input); - - procedure free_fl_int_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_int_input, "free_fl_int_input"); - pragma Inline (free_fl_int_input); - - - - - procedure fl_int_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); - pragma Inline (fl_int_input_draw); - - function fl_int_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); - pragma Inline (fl_int_input_handle); - - - - - procedure Extra_Final - (This : in out Integer_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Integer_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_int_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - procedure Extra_Init - (This : in out Integer_Input; - X, Y, W, H : in Standard.Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - package body Forge is - - function Create - (X, Y, W, H : in Standard.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)); - Extra_Init (This, X, Y, W, H, Text); - int_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - int_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); - end return; - end Create; - - end Forge; - - - - - function Get_Value - (This : in Integer_Input) - return Long_Integer - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr or else - Interfaces.C.Strings.Value (Ptr) = "" - then - return 0; - else - return Long_Integer'Value (Interfaces.C.Strings.Value (Ptr)); - end if; - end Get_Value; - - - - - procedure Draw - (This : in out Integer_Input) is - begin - fl_int_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Integer_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_int_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Inputs.Whole_Number; - diff --git a/src/fltk-widgets-inputs-whole_number.ads b/src/fltk-widgets-inputs-whole_number.ads deleted file mode 100644 index d9a9787..0000000 --- a/src/fltk-widgets-inputs-whole_number.ads +++ /dev/null @@ -1,72 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Whole_Number is - - - type Integer_Input is new Input with private; - - type Integer_Input_Reference (Data : not null access Integer_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Standard.Integer; - Text : in String := "") - return Integer_Input; - - end Forge; - - - - - function Get_Value - (This : in Integer_Input) - return Long_Integer; - - - - - procedure Draw - (This : in out Integer_Input); - - function Handle - (This : in out Integer_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Integer_Input is new Input with null record; - - overriding procedure Finalize - (This : in out Integer_Input); - - procedure Extra_Init - (This : in out Integer_Input; - X, Y, W, H : in Standard.Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Integer_Input) - with Inline; - - - pragma Inline (Get_Value); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Whole_Number; - diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 254712a..15c7964 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -17,18 +18,14 @@ use type package body FLTK.Widgets.Inputs is - procedure input_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, input_set_draw_hook, "input_set_draw_hook"); - pragma Inline (input_set_draw_hook); + package Chk renames Ada.Assertions; - procedure input_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, input_set_handle_hook, "input_set_handle_hook"); - pragma Inline (input_set_handle_hook); + ------------------------ + -- Functions From C -- + ------------------------ function new_fl_input (X, Y, W, H : in Interfaces.C.int; @@ -46,7 +43,8 @@ package body FLTK.Widgets.Inputs is function fl_input_copy - (I : in Storage.Integer_Address) + (I : in Storage.Integer_Address; + C : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_copy, "fl_input_copy"); pragma Inline (fl_input_copy); @@ -175,6 +173,13 @@ package body FLTK.Widgets.Inputs is pragma Import (C, fl_input_set_position, "fl_input_set_position"); pragma Inline (fl_input_set_position); + function fl_input_set_position2 + (I : in Storage.Integer_Address; + P, M : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_set_position2, "fl_input_set_position2"); + pragma Inline (fl_input_set_position2); + @@ -202,10 +207,11 @@ package body FLTK.Widgets.Inputs is pragma Import (C, fl_input_replace, "fl_input_replace"); pragma Inline (fl_input_replace); - procedure fl_input_set_value + function fl_input_set_value (I : in Storage.Integer_Address; T : in Interfaces.C.char_array; - L : in Interfaces.C.int); + L : in Interfaces.C.int) + return Interfaces.C.int; pragma Import (C, fl_input_set_value, "fl_input_set_value"); pragma Inline (fl_input_set_value); @@ -290,6 +296,12 @@ package body FLTK.Widgets.Inputs is pragma Import (C, fl_input_set_size, "fl_input_set_size"); pragma Inline (fl_input_set_size); + procedure fl_input_resize + (I : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_input_resize, "fl_input_resize"); + pragma Inline (fl_input_resize); + @@ -308,6 +320,10 @@ package body FLTK.Widgets.Inputs is + ------------------- + -- Destructors -- + ------------------- + procedure Extra_Final (This : in out Input) is begin @@ -328,6 +344,10 @@ package body FLTK.Widgets.Inputs is + -------------------- + -- Constructors -- + -------------------- + procedure Extra_Init (This : in out Input; X, Y, W, H : in Integer; @@ -337,6 +357,14 @@ package body FLTK.Widgets.Inputs is end Extra_Init; + procedure Initialize + (This : in out Input) is + begin + This.Draw_Ptr := fl_input_draw'Address; + This.Handle_Ptr := fl_input_handle'Address; + end Initialize; + + package body Forge is function Create @@ -352,8 +380,6 @@ package body FLTK.Widgets.Inputs is Interfaces.C.int (H), Interfaces.C.To_C (Text)); Extra_Init (This, X, Y, W, H, Text); - input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); end return; end Create; @@ -362,25 +388,73 @@ package body FLTK.Widgets.Inputs is + ----------------------- + -- API Subprograms -- + ----------------------- + procedure Copy - (This : in out Input) is + (This : in out Input; + Destination : in Clipboard_Kind := Cut_Paste_Board) + is + Result : Interfaces.C.int := fl_input_copy + (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); begin - This.Was_Changed := fl_input_copy (This.Void_Ptr) /= 0; + pragma Assert (Result in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; + end Copy; + + + function Copy + (This : in out Input; + Destination : in Clipboard_Kind := Cut_Paste_Board) + return Boolean + is + Result : Interfaces.C.int := fl_input_copy + (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); + begin + pragma Assert (Result in 0 .. 1); + return Boolean'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Copy; procedure Cut - (This : in out Input) is + (This : in out Input) + is + Result : Interfaces.C.int := fl_input_cut (This.Void_Ptr); begin - This.Was_Changed := fl_input_cut (This.Void_Ptr) /= 0; + null; + end Cut; + + + function Cut + (This : in out Input) + return Boolean is + begin + return fl_input_cut (This.Void_Ptr) /= 0; end Cut; procedure Cut (This : in out Input; - Num_Bytes : in Integer) is + Num_Bytes : in Integer) + is + Result : Interfaces.C.int := fl_input_cut2 + (This.Void_Ptr, + Interfaces.C.int (Num_Bytes)); begin - This.Was_Changed := fl_input_cut2 + null; + end Cut; + + + function Cut + (This : in out Input; + Num_Bytes : in Integer) + return Boolean is + begin + return fl_input_cut2 (This.Void_Ptr, Interfaces.C.int (Num_Bytes)) /= 0; end Cut; @@ -388,9 +462,23 @@ package body FLTK.Widgets.Inputs is procedure Cut (This : in out Input; - Start, Finish : in Integer) is + Start, Finish : in Integer) + is + Result : Interfaces.C.int := fl_input_cut3 + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); begin - This.Was_Changed := fl_input_cut3 + null; + end Cut; + + + function Cut + (This : in out Input; + Start, Finish : in Integer) + return Boolean is + begin + return fl_input_cut3 (This.Void_Ptr, Interfaces.C.int (Start), Interfaces.C.int (Finish)) /= 0; @@ -398,34 +486,41 @@ package body FLTK.Widgets.Inputs is procedure Copy_Cuts - (This : in out Input) is + (This : in out Input) + is + Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); begin - This.Was_Changed := fl_input_copy_cuts (This.Void_Ptr) /= 0; + null; end Copy_Cuts; - procedure Undo - (This : in out Input) is + function Copy_Cuts + (This : in out Input) + return Boolean + is + Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); begin - This.Was_Changed := fl_input_undo (This.Void_Ptr) /= 0; - end Undo; + return Result /= 0; + end Copy_Cuts; + procedure Undo + (This : in out Input) + is + Result : Interfaces.C.int := fl_input_undo (This.Void_Ptr); + begin + null; + end Undo; - function Has_Changed - (This : in Input) + function Undo + (This : in out Input) return Boolean is begin - return This.Was_Changed; - end Has_Changed; + return fl_input_undo (This.Void_Ptr) /= 0; + end Undo; - procedure Clear_Changed - (This : in out Input) is - begin - This.Was_Changed := False; - end Clear_Changed; function Is_Readonly @@ -519,10 +614,24 @@ package body FLTK.Widgets.Inputs is procedure Set_Mark (This : in out Input; - To : in Natural) is + To : in Natural) + is + Result : Interfaces.C.int := fl_input_set_mark + (This.Void_Ptr, + Interfaces.C.int (To)); + begin + null; + end Set_Mark; + + + function Set_Mark + (This : in out Input; + To : in Natural) + return Boolean is begin - This.Was_Changed := fl_input_set_mark - (This.Void_Ptr, Interfaces.C.int (To)) /= 0; + return fl_input_set_mark + (This.Void_Ptr, + Interfaces.C.int (To)) /= 0; end Set_Mark; @@ -536,13 +645,54 @@ package body FLTK.Widgets.Inputs is procedure Set_Position (This : in out Input; - To : in Natural) is + To : in Natural) + is + Result : Interfaces.C.int := fl_input_set_position + (This.Void_Ptr, + Interfaces.C.int (To)); begin - This.Was_Changed := fl_input_set_position - (This.Void_Ptr, Interfaces.C.int (To)) /= 0; + null; end Set_Position; + function Set_Position + (This : in out Input; + To : in Natural) + return Boolean is + begin + return fl_input_set_position + (This.Void_Ptr, + Interfaces.C.int (To)) /= 0; + end Set_Position; + + + procedure Set_Position_Mark + (This : in out Input; + Place : in Natural; + Mark : in Natural) + is + Result : Interfaces.C.int := fl_input_set_position2 + (This.Void_Ptr, + Interfaces.C.int (Place), + Interfaces.C.int (Mark)); + begin + null; + end Set_Position_Mark; + + + function Set_Position_Mark + (This : in out Input; + Place : in Natural; + Mark : in Natural) + return Boolean is + begin + return fl_input_set_position2 + (This.Void_Ptr, + Interfaces.C.int (Place), + Interfaces.C.int (Mark)) /= 0; + end Set_Position_Mark; + + function Index @@ -556,11 +706,25 @@ package body FLTK.Widgets.Inputs is procedure Insert (This : in out Input; - Str : in String) is + Str : in String) + is + Result : Interfaces.C.int := fl_input_insert + (This.Void_Ptr, + Interfaces.C.To_C (Str, False), + Str'Length); + begin + null; + end Insert; + + + function Insert + (This : in out Input; + Str : in String) + return Boolean is begin - This.Was_Changed := fl_input_insert + return fl_input_insert (This.Void_Ptr, - Interfaces.C.To_C (Str), + Interfaces.C.To_C (Str, False), Str'Length) /= 0; end Insert; @@ -568,13 +732,30 @@ package body FLTK.Widgets.Inputs is procedure Replace (This : in out Input; From, To : in Natural; - New_Text : in String) is - begin - This.Was_Changed := fl_input_replace + New_Text : in String) + is + Result : Interfaces.C.int := fl_input_replace (This.Void_Ptr, Interfaces.C.int (From), Interfaces.C.int (To), Interfaces.C.To_C (New_Text), + New_Text'Length); + begin + null; + end Replace; + + + function Replace + (This : in out Input; + From, To : in Natural; + New_Text : in String) + return Boolean is + begin + return fl_input_replace + (This.Void_Ptr, + Interfaces.C.int (From), + Interfaces.C.int (To), + Interfaces.C.To_C (New_Text, False), New_Text'Length) /= 0; end Replace; @@ -596,9 +777,24 @@ package body FLTK.Widgets.Inputs is procedure Set_Value (This : in out Input; - To : in String) is + To : in String) + is + Result : Interfaces.C.int := fl_input_set_value + (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); begin - fl_input_set_value (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); + null; + end Set_Value; + + + function Set_Value + (This : in out Input; + To : in String) + return Boolean is + begin + return fl_input_set_value + (This.Void_Ptr, + Interfaces.C.To_C (To, False), + To'Length) /= 0; end Set_Value; @@ -704,23 +900,17 @@ package body FLTK.Widgets.Inputs is end Resize; - - - procedure Draw - (This : in out Input) is - begin - fl_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Input; - Event : in Event_Kind) - return Event_Outcome is + procedure Resize + (This : in out Input; + X, Y, W, H : in Integer) is begin - return Event_Outcome'Val - (fl_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + fl_input_resize + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; @@ -741,3 +931,4 @@ package body FLTK.Widgets.Inputs is end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index 76d6848..7fc436b 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -22,6 +22,8 @@ package FLTK.Widgets.Inputs is (Normal_Kind, Float_Kind, Integer_Kind, Multiline_Kind, Secret_Kind, Readonly_Kind, Wrap_Kind); + type Clipboard_Kind is (Selection_Buffer, Cut_Paste_Board); + @@ -38,34 +40,55 @@ package FLTK.Widgets.Inputs is procedure Copy - (This : in out Input); + (This : in out Input; + Destination : in Clipboard_Kind := Cut_Paste_Board); + + function Copy + (This : in out Input; + Destination : in Clipboard_Kind := Cut_Paste_Board) + return Boolean; procedure Cut (This : in out Input); + function Cut + (This : in out Input) + return Boolean; + procedure Cut (This : in out Input; Num_Bytes : in Integer); + function Cut + (This : in out Input; + Num_Bytes : in Integer) + return Boolean; + procedure Cut (This : in out Input; Start, Finish : in Integer); + function Cut + (This : in out Input; + Start, Finish : in Integer) + return Boolean; + procedure Copy_Cuts (This : in out Input); + function Copy_Cuts + (This : in out Input) + return Boolean; + procedure Undo (This : in out Input); + function Undo + (This : in out Input) + return Boolean; - function Has_Changed - (This : in Input) - return Boolean; - - procedure Clear_Changed - (This : in out Input); function Is_Readonly (This : in Input) @@ -114,6 +137,11 @@ package FLTK.Widgets.Inputs is (This : in out Input; To : in Natural); + function Set_Mark + (This : in out Input; + To : in Natural) + return Boolean; + function Get_Position (This : in Input) return Natural; @@ -122,6 +150,22 @@ package FLTK.Widgets.Inputs is (This : in out Input; To : in Natural); + function Set_Position + (This : in out Input; + To : in Natural) + return Boolean; + + procedure Set_Position_Mark + (This : in out Input; + Place : in Natural; + Mark : in Natural); + + function Set_Position_Mark + (This : in out Input; + Place : in Natural; + Mark : in Natural) + return Boolean; + @@ -134,11 +178,22 @@ package FLTK.Widgets.Inputs is (This : in out Input; Str : in String); + function Insert + (This : in out Input; + Str : in String) + return Boolean; + procedure Replace (This : in out Input; From, To : in Natural; New_Text : in String); + function Replace + (This : in out Input; + From, To : in Natural; + New_Text : in String) + return Boolean; + function Get_Value (This : in Input) return String; @@ -147,6 +202,11 @@ package FLTK.Widgets.Inputs is (This : in out Input; To : in String); + function Set_Value + (This : in out Input; + To : in String) + return Boolean; + @@ -204,16 +264,9 @@ package FLTK.Widgets.Inputs is (This : in out Input; W, H : in Integer); - - - - procedure Draw - (This : in out Input); - - function Handle - (This : in out Input; - Event : in Event_Kind) - return Event_Outcome; + procedure Resize + (This : in out Input; + X, Y, W, H : in Integer); @@ -230,9 +283,10 @@ package FLTK.Widgets.Inputs is private - type Input is new Widget with record - Was_Changed : Boolean := False; - end record; + type Input is new Widget with null record; + + overriding procedure Initialize + (This : in out Input); overriding procedure Finalize (This : in out Input); @@ -253,8 +307,6 @@ private pragma Inline (Copy_Cuts); pragma Inline (Undo); - pragma Inline (Has_Changed); - pragma Inline (Clear_Changed); pragma Inline (Is_Readonly); pragma Inline (Set_Readonly); pragma Inline (Is_Tab_Nav); @@ -314,3 +366,4 @@ private end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index b4b8a67..870eade 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -40,18 +40,9 @@ package body FLTK.Widgets is - procedure widget_set_draw_hook - (W, D : in Storage.Integer_Address); - pragma Import (C, widget_set_draw_hook, "widget_set_draw_hook"); - pragma Inline (widget_set_draw_hook); - - procedure widget_set_handle_hook - (W, H : in Storage.Integer_Address); - pragma Import (C, widget_set_handle_hook, "widget_set_handle_hook"); - pragma Inline (widget_set_handle_hook); - - - + ------------------------ + -- Functions From C -- + ------------------------ function new_fl_widget (X, Y, W, H : in Interfaces.C.int; @@ -467,6 +458,25 @@ package body FLTK.Widgets is + procedure fl_widget_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_widget_draw, "fl_widget_draw"); + pragma Inline (fl_widget_draw); + + function fl_widget_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_widget_handle, "fl_widget_handle"); + pragma Inline (fl_widget_handle); + + + + + ---------------------- + -- Exported Hooks -- + ---------------------- + procedure Callback_Hook (W, U : in Storage.Integer_Address) is @@ -501,6 +511,10 @@ package body FLTK.Widgets is + ------------------- + -- Destructors -- + ------------------- + procedure Extra_Final (This : in out Widget) is begin @@ -521,6 +535,10 @@ package body FLTK.Widgets is + -------------------- + -- Constructors -- + -------------------- + procedure Extra_Init (This : in out Widget; X, Y, W, H : in Integer; @@ -533,6 +551,14 @@ package body FLTK.Widgets is end Extra_Init; + procedure Initialize + (This : in out Widget) is + begin + This.Draw_Ptr := fl_widget_draw'Address; + This.Handle_Ptr := fl_widget_handle'Address; + end Initialize; + + package body Forge is function Create @@ -548,8 +574,6 @@ package body FLTK.Widgets is Interfaces.C.int (H), Interfaces.C.To_C (Text)); Extra_Init (This, X, Y, W, H, Text); - widget_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); - widget_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); end return; end Create; @@ -558,6 +582,10 @@ package body FLTK.Widgets is + ----------------------- + -- API Subprograms -- + ----------------------- + procedure Activate (This : in out Widget) is begin @@ -1157,6 +1185,18 @@ package body FLTK.Widgets is end Set_Damaged; + procedure Draw + (This : in out Widget) + is + procedure my_draw + (V : in Storage.Integer_Address); + for my_draw'Address use This.Draw_Ptr; + pragma Import (Ada, my_draw); + begin + my_draw (This.Void_Ptr); + end Draw; + + procedure Draw_Label (This : in Widget; X, Y, W, H : in Integer; @@ -1189,9 +1229,18 @@ package body FLTK.Widgets is function Handle (This : in out Widget; Event : in Event_Kind) - return Event_Outcome is - begin - return Not_Handled; + return Event_Outcome + is + function my_handle + (V : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + for my_handle'Address use This.Handle_Ptr; + pragma Import (Ada, my_handle); + begin + return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + exception + when Constraint_Error => raise Internal_FLTK_Error; end Handle; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 9a8537b..46e5733 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -329,7 +329,7 @@ package FLTK.Widgets is X, Y, W, H : in Integer); procedure Draw - (This : in out Widget) is null; + (This : in out Widget); procedure Draw_Label (This : in Widget; @@ -360,6 +360,9 @@ private Handle_Ptr : System.Address; end record; + overriding procedure Initialize + (This : in out Widget); + overriding procedure Finalize (This : in out Widget); @@ -386,8 +389,6 @@ private with Inline; - - type Callback_Flag is new Interfaces.C.unsigned; Call_Never : constant Callback_Flag := 0; @@ -397,8 +398,6 @@ private When_Enter_Key : constant Callback_Flag := 8; - - -- the user data portion should always be a reference back to the Ada binding procedure Callback_Hook (W, U : in Storage.Integer_Address); @@ -415,14 +414,10 @@ private pragma Export (C, Handle_Hook, "widget_handle_hook"); - - package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); package Callback_Convert renames FLTK.Widget_Callback_Conversions; - - function fl_widget_get_user_data (W : in Storage.Integer_Address) return Storage.Integer_Address; @@ -435,8 +430,6 @@ private pragma Inline (fl_widget_set_user_data); - - procedure fl_widget_set_label (W : in Storage.Integer_Address; T : in Interfaces.C.char_array); @@ -444,15 +437,12 @@ private pragma Inline (fl_widget_set_label); - - pragma Inline (Activate); pragma Inline (Deactivate); pragma Inline (Is_Active); pragma Inline (Is_Tree_Active); pragma Inline (Set_Active); - pragma Inline (Has_Changed); pragma Inline (Set_Changed); pragma Inline (Is_Output_Only); @@ -460,19 +450,16 @@ private pragma Inline (Is_Visible); pragma Inline (Set_Visible); - pragma Inline (Has_Visible_Focus); pragma Inline (Set_Visible_Focus); pragma Inline (Take_Focus); pragma Inline (Takes_Events); - pragma Inline (Get_Background_Color); pragma Inline (Set_Background_Color); pragma Inline (Get_Selection_Color); pragma Inline (Set_Selection_Color); - pragma Inline (Parent); pragma Inline (Contains); pragma Inline (Inside); @@ -480,7 +467,6 @@ private pragma Inline (Top_Window); pragma Inline (Top_Window_Offset); - pragma Inline (Get_Alignment); pragma Inline (Set_Alignment); pragma Inline (Get_Box); @@ -488,7 +474,6 @@ private pragma Inline (Get_Tooltip); pragma Inline (Set_Tooltip); - pragma Inline (Get_Label); pragma Inline (Set_Label); pragma Inline (Get_Label_Color); @@ -501,14 +486,12 @@ private pragma Inline (Set_Label_Type); pragma Inline (Measure_Label); - pragma Inline (Get_Callback); pragma Inline (Set_Callback); pragma Inline (Do_Callback); pragma Inline (Get_When); pragma Inline (Set_When); - pragma Inline (Get_X); pragma Inline (Get_Y); pragma Inline (Get_W); @@ -516,13 +499,11 @@ private pragma Inline (Resize); pragma Inline (Reposition); - pragma Inline (Get_Image); pragma Inline (Set_Image); pragma Inline (Get_Inactive_Image); pragma Inline (Set_Inactive_Image); - pragma Inline (Is_Damaged); pragma Inline (Set_Damaged); pragma Inline (Draw); -- cgit