diff options
Diffstat (limited to 'src')
378 files changed, 0 insertions, 53749 deletions
diff --git a/src/c_fl.cpp b/src/c_fl.cpp deleted file mode 100644 index 237c33a..0000000 --- a/src/c_fl.cpp +++ /dev/null @@ -1,82 +0,0 @@ - - -#include <FL/Fl.H> -#include "c_fl.h" - - - - -int fl_abi_check(int v) { - return Fl::abi_check(v); -} - -int fl_abi_version() { - return Fl::abi_version(); -} - -int fl_api_version() { - return Fl::api_version(); -} - -double fl_version() { - return Fl::version(); -} - - - - -void fl_awake() { - Fl::awake(); -} - -void fl_lock() { - Fl::lock(); -} - -void fl_unlock() { - Fl::unlock(); -} - - - - -int fl_get_damage() { - return Fl::damage(); -} - -void fl_set_damage(int v) { - Fl::damage(v); -} - -void fl_flush() { - Fl::flush(); -} - -void fl_redraw() { - Fl::redraw(); -} - - - - -int fl_check() { - return Fl::check(); -} - -int fl_ready() { - return Fl::ready(); -} - -int fl_wait() { - return Fl::wait(); -} - -int fl_wait2(double s) { - return Fl::wait(s); -} - -int fl_run() { - return Fl::run(); -} - - diff --git a/src/c_fl.h b/src/c_fl.h deleted file mode 100644 index b310d11..0000000 --- a/src/c_fl.h +++ /dev/null @@ -1,34 +0,0 @@ - - -#ifndef FL_GUARD -#define FL_GUARD - - - - -extern "C" int fl_abi_check(int v); -extern "C" int fl_abi_version(); -extern "C" int fl_api_version(); -extern "C" double fl_version(); - - -extern "C" void fl_awake(); -extern "C" void fl_lock(); -extern "C" void fl_unlock(); - - -extern "C" int fl_get_damage(); -extern "C" void fl_set_damage(int v); -extern "C" void fl_flush(); -extern "C" void fl_redraw(); - - -extern "C" int fl_check(); -extern "C" int fl_ready(); -extern "C" int fl_wait(); -extern "C" int fl_wait2(double s); -extern "C" int fl_run(); - - -#endif - diff --git a/src/c_fl_adjuster.cpp b/src/c_fl_adjuster.cpp deleted file mode 100644 index 209058c..0000000 --- a/src/c_fl_adjuster.cpp +++ /dev/null @@ -1,80 +0,0 @@ - - -#include <FL/Fl_Adjuster.H> -#include "c_fl_adjuster.h" -#include "c_fl_type.h" - - - - -class My_Adjuster : public Fl_Adjuster { - public: - using Fl_Adjuster::Fl_Adjuster; - friend void adjuster_set_draw_hook(ADJUSTER a, void * d); - friend void fl_adjuster_draw(ADJUSTER a); - friend void adjuster_set_handle_hook(ADJUSTER a, void * h); - friend int fl_adjuster_handle(ADJUSTER a, 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_Adjuster::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Adjuster::real_draw() { - Fl_Adjuster::draw(); -} - -int My_Adjuster::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Adjuster::real_handle(int e) { - return Fl_Adjuster::handle(e); -} - -void adjuster_set_draw_hook(ADJUSTER a, void * d) { - reinterpret_cast<My_Adjuster*>(a)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_adjuster_draw(ADJUSTER a) { - reinterpret_cast<My_Adjuster*>(a)->real_draw(); -} - -void adjuster_set_handle_hook(ADJUSTER a, void * h) { - reinterpret_cast<My_Adjuster*>(a)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_adjuster_handle(ADJUSTER a, int e) { - return reinterpret_cast<My_Adjuster*>(a)->real_handle(e); -} - - - - -ADJUSTER new_fl_adjuster(int x, int y, int w, int h, char* label) { - My_Adjuster *a = new My_Adjuster(x, y, w, h, label); - return a; -} - -void free_fl_adjuster(ADJUSTER a) { - delete reinterpret_cast<My_Adjuster*>(a); -} - - - - -int fl_adjuster_is_soft(ADJUSTER a) { - return reinterpret_cast<Fl_Adjuster*>(a)->soft(); -} - -void fl_adjuster_set_soft(ADJUSTER a, int t) { - reinterpret_cast<Fl_Adjuster*>(a)->soft(t); -} - diff --git a/src/c_fl_adjuster.h b/src/c_fl_adjuster.h deleted file mode 100644 index 53a84eb..0000000 --- a/src/c_fl_adjuster.h +++ /dev/null @@ -1,33 +0,0 @@ - - -#ifndef FL_ADJUSTER_GUARD -#define FL_ADJUSTER_GUARD - - - - -typedef void* ADJUSTER; - - - - -extern "C" void adjuster_set_draw_hook(ADJUSTER a, void * d); -extern "C" void fl_adjuster_draw(ADJUSTER a); -extern "C" void adjuster_set_handle_hook(ADJUSTER a, void * h); -extern "C" int fl_adjuster_handle(ADJUSTER a, int e); - - - - -extern "C" ADJUSTER new_fl_adjuster(int x, int y, int w, int h, char* label); -extern "C" void free_fl_adjuster(ADJUSTER a); - - - - -extern "C" int fl_adjuster_is_soft(ADJUSTER a); -extern "C" void fl_adjuster_set_soft(ADJUSTER a, int t); - - -#endif - diff --git a/src/c_fl_bitmap.cpp b/src/c_fl_bitmap.cpp deleted file mode 100644 index 6a38b1e..0000000 --- a/src/c_fl_bitmap.cpp +++ /dev/null @@ -1,46 +0,0 @@ - - -#include <FL/Fl_Bitmap.H> -#include "c_fl_bitmap.h" - - - - -BITMAP new_fl_bitmap(void *data, int w, int h) { - Fl_Bitmap *b = new Fl_Bitmap(reinterpret_cast<uchar*>(data), w, h); - return b; -} - -void free_fl_bitmap(BITMAP b) { - delete reinterpret_cast<Fl_Bitmap*>(b); -} - -BITMAP fl_bitmap_copy(BITMAP b, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Bitmap*>(b)->Fl_Bitmap::copy(w, h); -} - -BITMAP fl_bitmap_copy2(BITMAP b) { - return reinterpret_cast<Fl_Bitmap*>(b)->copy(); -} - - - - -void fl_bitmap_uncache(BITMAP b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Bitmap*>(b)->Fl_Bitmap::uncache(); -} - - - - -void fl_bitmap_draw2(BITMAP b, int x, int y) { - reinterpret_cast<Fl_Bitmap*>(b)->draw(x, y); -} - -void fl_bitmap_draw(BITMAP b, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Bitmap*>(b)->Fl_Bitmap::draw(x, y, w, h, cx, cy); -} - diff --git a/src/c_fl_bitmap.h b/src/c_fl_bitmap.h deleted file mode 100644 index f2290dd..0000000 --- a/src/c_fl_bitmap.h +++ /dev/null @@ -1,28 +0,0 @@ - - -#ifndef FL_BITMAP_GUARD -#define FL_BITMAP_GUARD - - - - -typedef void* BITMAP; - - - - -extern "C" BITMAP new_fl_bitmap(void *data, int w, int h); -extern "C" void free_fl_bitmap(BITMAP b); -extern "C" BITMAP fl_bitmap_copy(BITMAP b, int w, int h); -extern "C" BITMAP fl_bitmap_copy2(BITMAP b); - - -extern "C" void fl_bitmap_uncache(BITMAP b); - - -extern "C" void fl_bitmap_draw2(BITMAP b, int x, int y); -extern "C" void fl_bitmap_draw(BITMAP b, int x, int y, int w, int h, int cx, int cy); - - -#endif - diff --git a/src/c_fl_bmp_image.cpp b/src/c_fl_bmp_image.cpp deleted file mode 100644 index fe12cc7..0000000 --- a/src/c_fl_bmp_image.cpp +++ /dev/null @@ -1,15 +0,0 @@ - - -#include <FL/Fl_BMP_Image.H> -#include "c_fl_bmp_image.h" - - -BMP_IMAGE new_fl_bmp_image(const char * f) { - Fl_BMP_Image *b = new Fl_BMP_Image(f); - return b; -} - -void free_fl_bmp_image(BMP_IMAGE b) { - delete reinterpret_cast<Fl_BMP_Image*>(b); -} - diff --git a/src/c_fl_bmp_image.h b/src/c_fl_bmp_image.h deleted file mode 100644 index 1f9b8df..0000000 --- a/src/c_fl_bmp_image.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_BMP_IMAGE_GUARD -#define FL_BMP_IMAGE_GUARD - - - - -typedef void* BMP_IMAGE; - - - - -extern "C" BMP_IMAGE new_fl_bmp_image(const char * f); -extern "C" void free_fl_bmp_image(BMP_IMAGE b); - - -#endif - diff --git a/src/c_fl_box.cpp b/src/c_fl_box.cpp deleted file mode 100644 index 3af626f..0000000 --- a/src/c_fl_box.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Box.H> -#include "c_fl_box.h" -#include "c_fl_type.h" - - - - -class My_Box : public Fl_Box { - public: - using Fl_Box::Fl_Box; - friend void box_set_draw_hook(BOX n, void * d); - friend void fl_box_draw(BOX n); - friend void box_set_handle_hook(BOX n, void * h); - friend int fl_box_handle(BOX n, 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_Box::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Box::real_draw() { - Fl_Box::draw(); -} - -int My_Box::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Box::real_handle(int e) { - return Fl_Box::handle(e); -} - -void box_set_draw_hook(BOX n, void * d) { - reinterpret_cast<My_Box*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_box_draw(BOX n) { - reinterpret_cast<My_Box*>(n)->real_draw(); -} - -void box_set_handle_hook(BOX n, void * h) { - reinterpret_cast<My_Box*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_box_handle(BOX n, int e) { - return reinterpret_cast<My_Box*>(n)->real_handle(e); -} - - - - -BOX new_fl_box(int x, int y, int w, int h, char* label) { - My_Box *b = new My_Box(x, y, w, h, label); - return b; -} - -void free_fl_box(BOX b) { - delete reinterpret_cast<My_Box*>(b); -} - diff --git a/src/c_fl_box.h b/src/c_fl_box.h deleted file mode 100644 index 4c61c4e..0000000 --- a/src/c_fl_box.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_BOX_GUARD -#define FL_BOX_GUARD - - - - -typedef void* BOX; - - - - -extern "C" void box_set_draw_hook(BOX n, void * d); -extern "C" void fl_box_draw(BOX n); -extern "C" void box_set_handle_hook(BOX n, void * h); -extern "C" int fl_box_handle(BOX n, int e); - - - - -extern "C" BOX new_fl_box(int x, int y, int w, int h, char * label); -extern "C" void free_fl_box(BOX b); - - -#endif - diff --git a/src/c_fl_button.cpp b/src/c_fl_button.cpp deleted file mode 100644 index 749913d..0000000 --- a/src/c_fl_button.cpp +++ /dev/null @@ -1,104 +0,0 @@ - - -#include <FL/Fl_Button.H> -#include "c_fl_button.h" -#include "c_fl_type.h" - - - - -class My_Button : public Fl_Button { - public: - using Fl_Button::Fl_Button; - friend void button_set_draw_hook(BUTTON b, void * d); - friend void fl_button_draw(BUTTON b); - friend void button_set_handle_hook(BUTTON b, void * h); - friend int fl_button_handle(BUTTON b, 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_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Button::real_draw() { - Fl_Button::draw(); -} - -int My_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Button::real_handle(int e) { - return Fl_Button::handle(e); -} - -void button_set_draw_hook(BUTTON b, void * d) { - reinterpret_cast<My_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_button_draw(BUTTON b) { - reinterpret_cast<My_Button*>(b)->real_draw(); -} - -void button_set_handle_hook(BUTTON b, void * h) { - reinterpret_cast<My_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_button_handle(BUTTON b, int e) { - return reinterpret_cast<My_Button*>(b)->real_handle(e); -} - - - - -BUTTON new_fl_button(int x, int y, int w, int h, char* label) { - My_Button *b = new My_Button(x, y, w, h, label); - return b; -} - -void free_fl_button(BUTTON b) { - delete reinterpret_cast<My_Button*>(b); -} - - - - -int fl_button_get_state(BUTTON b) { - return reinterpret_cast<Fl_Button*>(b)->Fl_Button::value(); -} - -void fl_button_set_state(BUTTON b, int s) { - reinterpret_cast<Fl_Button*>(b)->Fl_Button::value(s); -} - -void fl_button_set_only(BUTTON b) { - reinterpret_cast<Fl_Button*>(b)->Fl_Button::setonly(); -} - - - - -int fl_button_get_down_box(BUTTON b) { - return reinterpret_cast<Fl_Button*>(b)->Fl_Button::down_box(); -} - -void fl_button_set_down_box(BUTTON b, int t) { - reinterpret_cast<Fl_Button*>(b)->Fl_Button::down_box(static_cast<Fl_Boxtype>(t)); -} - -int fl_button_get_shortcut(BUTTON b) { - return reinterpret_cast<Fl_Button*>(b)->Fl_Button::shortcut(); -} - -void fl_button_set_shortcut(BUTTON b, int k) { - reinterpret_cast<Fl_Button*>(b)->Fl_Button::shortcut(k); -} - - diff --git a/src/c_fl_button.h b/src/c_fl_button.h deleted file mode 100644 index 33120ad..0000000 --- a/src/c_fl_button.h +++ /dev/null @@ -1,40 +0,0 @@ - - -#ifndef FL_BUTTON_GUARD -#define FL_BUTTON_GUARD - - - - -typedef void* BUTTON; - - - - -extern "C" void button_set_draw_hook(BUTTON b, void * d); -extern "C" void fl_button_draw(BUTTON b); -extern "C" void button_set_handle_hook(BUTTON b, void * h); -extern "C" int fl_button_handle(BUTTON b, int e); - - - - -extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_button(BUTTON b); - - - - -extern "C" int fl_button_get_state(BUTTON b); -extern "C" void fl_button_set_state(BUTTON b, int s); -extern "C" void fl_button_set_only(BUTTON b); - - -extern "C" int fl_button_get_down_box(BUTTON b); -extern "C" void fl_button_set_down_box(BUTTON b, int t); -extern "C" int fl_button_get_shortcut(BUTTON b); -extern "C" void fl_button_set_shortcut(BUTTON b, int k); - - -#endif - diff --git a/src/c_fl_chart.cpp b/src/c_fl_chart.cpp deleted file mode 100644 index 0389b6e..0000000 --- a/src/c_fl_chart.cpp +++ /dev/null @@ -1,154 +0,0 @@ - - -#include <FL/Fl_Chart.H> -#include "c_fl_chart.h" -#include "c_fl_type.h" - - - - -class My_Chart : public Fl_Chart { - public: - using Fl_Chart::Fl_Chart; - friend void chart_set_draw_hook(CHART n, void * d); - friend void fl_chart_draw(CHART n); - friend void chart_set_handle_hook(CHART n, void * h); - friend int fl_chart_handle(CHART n, 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_Chart::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Chart::real_draw() { - Fl_Chart::draw(); -} - -int My_Chart::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Chart::real_handle(int e) { - return Fl_Chart::handle(e); -} - -void chart_set_draw_hook(CHART n, void * d) { - reinterpret_cast<My_Chart*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_chart_draw(CHART n) { - reinterpret_cast<My_Chart*>(n)->real_draw(); -} - -void chart_set_handle_hook(CHART n, void * h) { - reinterpret_cast<My_Chart*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_chart_handle(CHART n, int e) { - return reinterpret_cast<My_Chart*>(n)->real_handle(e); -} - - - - -CHART new_fl_chart(int x, int y, int w, int h, char* label) { - My_Chart *b = new My_Chart(x, y, w, h, label); - return b; -} - -void free_fl_chart(CHART b) { - delete reinterpret_cast<My_Chart*>(b); -} - - - - -void fl_chart_add(CHART b, double v, char * s, unsigned int c) { - reinterpret_cast<Fl_Chart*>(b)->add(v,s,c); -} - -void fl_chart_insert(CHART b, int i, double v, char * s, unsigned int c) { - reinterpret_cast<Fl_Chart*>(b)->insert(i,v,s,c); -} - -void fl_chart_replace(CHART b, int i, double v, char * s, unsigned int c) { - reinterpret_cast<Fl_Chart*>(b)->replace(i,v,s,c); -} - -void fl_chart_clear(CHART b) { - reinterpret_cast<Fl_Chart*>(b)->clear(); -} - - - - -int fl_chart_get_autosize(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->autosize(); -} - -void fl_chart_set_autosize(CHART b, int a) { - reinterpret_cast<Fl_Chart*>(b)->autosize(a); -} - -void fl_chart_get_bounds(CHART b, double * l, double * u) { - reinterpret_cast<Fl_Chart*>(b)->bounds(l,u); -} - -void fl_chart_set_bounds(CHART b, double l, double u) { - reinterpret_cast<Fl_Chart*>(b)->bounds(l,u); -} - -int fl_chart_get_maxsize(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->maxsize(); -} - -void fl_chart_set_maxsize(CHART b, int m) { - reinterpret_cast<Fl_Chart*>(b)->maxsize(m); -} - -int fl_chart_size(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->size(); -} - - - - -void fl_chart_size2(CHART b, int w, int h) { - reinterpret_cast<Fl_Chart*>(b)->size(w, h); -} - - - - -unsigned int fl_chart_get_textcolor(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->textcolor(); -} - -void fl_chart_set_textcolor(CHART b, unsigned int c) { - reinterpret_cast<Fl_Chart*>(b)->textcolor(c); -} - -int fl_chart_get_textfont(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->textfont(); -} - -void fl_chart_set_textfont(CHART b, int f) { - reinterpret_cast<Fl_Chart*>(b)->textfont(f); -} - -int fl_chart_get_textsize(CHART b) { - return reinterpret_cast<Fl_Chart*>(b)->textsize(); -} - -void fl_chart_set_textsize(CHART b, int s) { - reinterpret_cast<Fl_Chart*>(b)->textsize(s); -} - - diff --git a/src/c_fl_chart.h b/src/c_fl_chart.h deleted file mode 100644 index 83bcc00..0000000 --- a/src/c_fl_chart.h +++ /dev/null @@ -1,55 +0,0 @@ - - -#ifndef FL_CHART_GUARD -#define FL_CHART_GUARD - - - - -typedef void* CHART; - - - - -extern "C" void chart_set_draw_hook(CHART n, void * d); -extern "C" void fl_chart_draw(CHART n); -extern "C" void chart_set_handle_hook(CHART n, void * h); -extern "C" int fl_chart_handle(CHART n, int e); - - - - -extern "C" CHART new_fl_chart(int x, int y, int w, int h, char * label); -extern "C" void free_fl_chart(CHART b); - - - - -extern "C" void fl_chart_add(CHART b, double v, char * s, unsigned int c); -extern "C" void fl_chart_insert(CHART b, int i, double v, char * s, unsigned int c); -extern "C" void fl_chart_replace(CHART b, int i, double v, char * s, unsigned int c); -extern "C" void fl_chart_clear(CHART b); - - -extern "C" int fl_chart_get_autosize(CHART b); -extern "C" void fl_chart_set_autosize(CHART b, int a); -extern "C" void fl_chart_get_bounds(CHART b, double * l, double * u); -extern "C" void fl_chart_set_bounds(CHART b, double l, double u); -extern "C" int fl_chart_get_maxsize(CHART b); -extern "C" void fl_chart_set_maxsize(CHART b, int m); -extern "C" int fl_chart_size(CHART b); - - -extern "C" void fl_chart_size2(CHART b, int w, int h); - - -extern "C" unsigned int fl_chart_get_textcolor(CHART b); -extern "C" void fl_chart_set_textcolor(CHART b, unsigned int c); -extern "C" int fl_chart_get_textfont(CHART b); -extern "C" void fl_chart_set_textfont(CHART b, int f); -extern "C" int fl_chart_get_textsize(CHART b); -extern "C" void fl_chart_set_textsize(CHART b, int s); - - -#endif - diff --git a/src/c_fl_check_button.cpp b/src/c_fl_check_button.cpp deleted file mode 100644 index 8c576f6..0000000 --- a/src/c_fl_check_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Check_Button.H> -#include "c_fl_check_button.h" -#include "c_fl_type.h" - - - - -class My_Check_Button : public Fl_Check_Button { - public: - using Fl_Check_Button::Fl_Check_Button; - friend void check_button_set_draw_hook(CHECKBUTTON b, void * d); - friend void fl_check_button_draw(CHECKBUTTON b); - friend void check_button_set_handle_hook(CHECKBUTTON b, void * h); - friend int fl_check_button_handle(CHECKBUTTON b, 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_Check_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Check_Button::real_draw() { - Fl_Check_Button::draw(); -} - -int My_Check_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Check_Button::real_handle(int e) { - return Fl_Check_Button::handle(e); -} - -void check_button_set_draw_hook(CHECKBUTTON b, void * d) { - reinterpret_cast<My_Check_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_check_button_draw(CHECKBUTTON b) { - reinterpret_cast<My_Check_Button*>(b)->real_draw(); -} - -void check_button_set_handle_hook(CHECKBUTTON b, void * h) { - reinterpret_cast<My_Check_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_check_button_handle(CHECKBUTTON b, int e) { - return reinterpret_cast<My_Check_Button*>(b)->real_handle(e); -} - - - - -CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label) { - My_Check_Button *b = new My_Check_Button(x, y, w, h, label); - return b; -} - -void free_fl_check_button(CHECKBUTTON b) { - delete reinterpret_cast<My_Check_Button*>(b); -} - diff --git a/src/c_fl_check_button.h b/src/c_fl_check_button.h deleted file mode 100644 index 24fff48..0000000 --- a/src/c_fl_check_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_CHECK_BUTTON_GUARD -#define FL_CHECK_BUTTON_GUARD - - - - -typedef void* CHECKBUTTON; - - - - -extern "C" void check_button_set_draw_hook(CHECKBUTTON b, void * d); -extern "C" void fl_check_button_draw(CHECKBUTTON b); -extern "C" void check_button_set_handle_hook(CHECKBUTTON b, void * h); -extern "C" int fl_check_button_handle(CHECKBUTTON b, int e); - - - - -extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_check_button(CHECKBUTTON b); - - -#endif - diff --git a/src/c_fl_choice.cpp b/src/c_fl_choice.cpp deleted file mode 100644 index f45ceed..0000000 --- a/src/c_fl_choice.cpp +++ /dev/null @@ -1,85 +0,0 @@ - - -#include <FL/Fl_Choice.H> -#include "c_fl_choice.h" -#include "c_fl_type.h" - - - - -class My_Choice : public Fl_Choice { - public: - using Fl_Choice::Fl_Choice; - friend void choice_set_draw_hook(CHOICE n, void * d); - friend void fl_choice_draw(CHOICE n); - friend void choice_set_handle_hook(CHOICE n, void * h); - friend int fl_choice_handle(CHOICE n, 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_Choice::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Choice::real_draw() { - Fl_Choice::draw(); -} - -int My_Choice::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Choice::real_handle(int e) { - return Fl_Choice::handle(e); -} - -void choice_set_draw_hook(CHOICE n, void * d) { - reinterpret_cast<My_Choice*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_choice_draw(CHOICE n) { - reinterpret_cast<My_Choice*>(n)->real_draw(); -} - -void choice_set_handle_hook(CHOICE n, void * h) { - reinterpret_cast<My_Choice*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_choice_handle(CHOICE n, int e) { - return reinterpret_cast<My_Choice*>(n)->real_handle(e); -} - - - - -CHOICE new_fl_choice(int x, int y, int w, int h, char* label) { - My_Choice *b = new My_Choice(x, y, w, h, label); - return b; -} - -void free_fl_choice(CHOICE b) { - delete reinterpret_cast<My_Choice*>(b); -} - - - - -int fl_choice_value(CHOICE c) { - return reinterpret_cast<Fl_Choice*>(c)->value(); -} - -int fl_choice_set_value(CHOICE c, int p) { - return reinterpret_cast<Fl_Choice*>(c)->value(p); -} - -int fl_choice_set_value2(CHOICE c, void * i) { - return reinterpret_cast<Fl_Choice*>(c)->value(reinterpret_cast<Fl_Menu_Item*>(i)); -} - - diff --git a/src/c_fl_choice.h b/src/c_fl_choice.h deleted file mode 100644 index 05515bb..0000000 --- a/src/c_fl_choice.h +++ /dev/null @@ -1,34 +0,0 @@ - - -#ifndef FL_CHOICE_GUARD -#define FL_CHOICE_GUARD - - - - -typedef void* CHOICE; - - - - -extern "C" void choice_set_draw_hook(CHOICE n, void * d); -extern "C" void fl_choice_draw(CHOICE n); -extern "C" void choice_set_handle_hook(CHOICE n, void * h); -extern "C" int fl_choice_handle(CHOICE n, int e); - - - - -extern "C" CHOICE new_fl_choice(int x, int y, int w, int h, char * label); -extern "C" void free_fl_choice(CHOICE b); - - - - -extern "C" int fl_choice_value(CHOICE c); -extern "C" int fl_choice_set_value(CHOICE c, int p); -extern "C" int fl_choice_set_value2(CHOICE c, void * i); - - -#endif - diff --git a/src/c_fl_clock.cpp b/src/c_fl_clock.cpp deleted file mode 100644 index 10a8ad7..0000000 --- a/src/c_fl_clock.cpp +++ /dev/null @@ -1,83 +0,0 @@ - - -#include <FL/Fl_Clock.H> -#include "c_fl_clock.h" -#include "c_fl_type.h" - - - - -class My_Clock : public Fl_Clock { - public: - using Fl_Clock::Fl_Clock; - friend void clock_set_draw_hook(CLOCK c, void * d); - friend void fl_clock_draw(CLOCK c); - friend void clock_set_handle_hook(CLOCK c, void * h); - friend int fl_clock_handle(CLOCK c, int e); - friend void fl_clock_draw2(CLOCK c, int x, int y, int w, int h); - 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_Clock::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Clock::real_draw() { - Fl_Clock::draw(); -} - -int My_Clock::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Clock::real_handle(int e) { - return Fl_Clock::handle(e); -} - -void clock_set_draw_hook(CLOCK c, void * d) { - reinterpret_cast<My_Clock*>(c)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_clock_draw(CLOCK c) { - reinterpret_cast<My_Clock*>(c)->real_draw(); -} - -void clock_set_handle_hook(CLOCK c, void * h) { - reinterpret_cast<My_Clock*>(c)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_clock_handle(CLOCK c, int e) { - return reinterpret_cast<My_Clock*>(c)->real_handle(e); -} - - - - -CLOCK new_fl_clock(int x, int y, int w, int h, char* label) { - My_Clock *c = new My_Clock(x, y, w, h, label); - return c; -} - -CLOCK new_fl_clock2(uchar k, int x, int y, int w, int h, char* label) { - My_Clock *c = new My_Clock(k,x,y,w,h,label); - return c; -} - -void free_fl_clock(CLOCK c) { - delete reinterpret_cast<My_Clock*>(c); -} - - - - -void fl_clock_draw2(CLOCK c, int x, int y, int w, int h) { - reinterpret_cast<My_Clock*>(c)->Fl_Clock::draw(x,y,w,h); -} - - diff --git a/src/c_fl_clock.h b/src/c_fl_clock.h deleted file mode 100644 index 89f372b..0000000 --- a/src/c_fl_clock.h +++ /dev/null @@ -1,33 +0,0 @@ - - -#ifndef FL_CLOCK_GUARD -#define FL_CLOCK_GUARD - - - - -typedef void* CLOCK; - - - - -extern "C" void clock_set_draw_hook(CLOCK c, void * d); -extern "C" void fl_clock_draw(CLOCK c); -extern "C" void clock_set_handle_hook(CLOCK c, void * h); -extern "C" int fl_clock_handle(CLOCK c, int e); - - - - -extern "C" CLOCK new_fl_clock(int x, int y, int w, int h, char* label); -extern "C" CLOCK new_fl_clock2(uchar k, int x, int y, int w, int h, char* label); -extern "C" void free_fl_clock(CLOCK c); - - - - -extern "C" void fl_clock_draw2(CLOCK c, int x, int y, int w, int h); - - -#endif - diff --git a/src/c_fl_clock_output.cpp b/src/c_fl_clock_output.cpp deleted file mode 100644 index b427068..0000000 --- a/src/c_fl_clock_output.cpp +++ /dev/null @@ -1,106 +0,0 @@ - - -#include <FL/Fl_Clock.H> -#include "c_fl_clock_output.h" -#include "c_fl_type.h" - - - - -class My_Clock_Output : public Fl_Clock_Output { - public: - using Fl_Clock_Output::Fl_Clock_Output; - friend void clock_output_set_draw_hook(CLOCK_OUTPUT c, void * d); - friend void fl_clock_output_draw(CLOCK_OUTPUT c); - friend void clock_output_set_handle_hook(CLOCK_OUTPUT c, void * h); - friend int fl_clock_output_handle(CLOCK_OUTPUT c, int e); - friend void fl_clock_output_draw2(CLOCK_OUTPUT c, int x, int y, int w, int h); - 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_Clock_Output::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Clock_Output::real_draw() { - Fl_Clock_Output::draw(); -} - -int My_Clock_Output::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Clock_Output::real_handle(int e) { - return Fl_Clock_Output::handle(e); -} - -void clock_output_set_draw_hook(CLOCK_OUTPUT c, void * d) { - reinterpret_cast<My_Clock_Output*>(c)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_clock_output_draw(CLOCK_OUTPUT c) { - reinterpret_cast<My_Clock_Output*>(c)->real_draw(); -} - -void clock_output_set_handle_hook(CLOCK_OUTPUT c, void * h) { - reinterpret_cast<My_Clock_Output*>(c)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_clock_output_handle(CLOCK_OUTPUT c, int e) { - return reinterpret_cast<My_Clock_Output*>(c)->real_handle(e); -} - - - - -CLOCK_OUTPUT new_fl_clock_output(int x, int y, int w, int h, char* label) { - My_Clock_Output *c = new My_Clock_Output(x, y, w, h, label); - return c; -} - -void free_fl_clock_output(CLOCK_OUTPUT c) { - delete reinterpret_cast<My_Clock_Output*>(c); -} - - - - -int fl_clock_output_get_hour(CLOCK_OUTPUT c) { - return reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::hour(); -} - -int fl_clock_output_get_minute(CLOCK_OUTPUT c) { - return reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::minute(); -} - -int fl_clock_output_get_second(CLOCK_OUTPUT c) { - return reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::second(); -} - - -ulong fl_clock_output_get_value(CLOCK_OUTPUT c) { - return reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value(); -} - -void fl_clock_output_set_value(CLOCK_OUTPUT c, ulong v) { - reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value(v); -} - -void fl_clock_output_set_value2(CLOCK_OUTPUT c, int h, int m, int s) { - reinterpret_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value(h,m,s); -} - - - - -void fl_clock_output_draw2(CLOCK_OUTPUT c, int x, int y, int w, int h) { - reinterpret_cast<My_Clock_Output*>(c)->Fl_Clock_Output::draw(x,y,w,h); -} - - diff --git a/src/c_fl_clock_output.h b/src/c_fl_clock_output.h deleted file mode 100644 index d77f989..0000000 --- a/src/c_fl_clock_output.h +++ /dev/null @@ -1,42 +0,0 @@ - - -#ifndef FL_CLOCK_OUTPUT_GUARD -#define FL_CLOCK_OUTPUT_GUARD - - - - -typedef void* CLOCK_OUTPUT; - - - - -extern "C" void clock_output_set_draw_hook(CLOCK_OUTPUT c, void * d); -extern "C" void fl_clock_output_draw(CLOCK_OUTPUT c); -extern "C" void clock_output_set_handle_hook(CLOCK_OUTPUT c, void * h); -extern "C" int fl_clock_output_handle(CLOCK_OUTPUT c, int e); - - - - -extern "C" CLOCK_OUTPUT new_fl_clock_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_clock_output(CLOCK_OUTPUT c); - - - - -extern "C" int fl_clock_output_get_hour(CLOCK_OUTPUT c); -extern "C" int fl_clock_output_get_minute(CLOCK_OUTPUT c); -extern "C" int fl_clock_output_get_second(CLOCK_OUTPUT c); - - -extern "C" ulong fl_clock_output_get_value(CLOCK_OUTPUT c); -extern "C" void fl_clock_output_set_value(CLOCK_OUTPUT c, ulong v); -extern "C" void fl_clock_output_set_value2(CLOCK_OUTPUT c, int h, int m, int s); - - -extern "C" void fl_clock_output_draw2(CLOCK_OUTPUT c, int x, int y, int w, int h); - - -#endif - diff --git a/src/c_fl_color_chooser.cpp b/src/c_fl_color_chooser.cpp deleted file mode 100644 index 86e1014..0000000 --- a/src/c_fl_color_chooser.cpp +++ /dev/null @@ -1,130 +0,0 @@ - - -#include <FL/Fl_Color_Chooser.H> -#include "c_fl_color_chooser.h" -#include "c_fl_type.h" - - - - -class My_Color_Chooser : public Fl_Color_Chooser { - public: - using Fl_Color_Chooser::Fl_Color_Chooser; - friend void color_chooser_set_draw_hook(COLOR_CHOOSER n, void * d); - friend void fl_color_chooser_draw(COLOR_CHOOSER n); - friend void color_chooser_set_handle_hook(COLOR_CHOOSER n, void * h); - friend int fl_color_chooser_handle(COLOR_CHOOSER n, 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_Color_Chooser::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Color_Chooser::real_draw() { - Fl_Color_Chooser::draw(); -} - -int My_Color_Chooser::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Color_Chooser::real_handle(int e) { - return Fl_Color_Chooser::handle(e); -} - -void color_chooser_set_draw_hook(COLOR_CHOOSER n, void * d) { - reinterpret_cast<My_Color_Chooser*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_color_chooser_draw(COLOR_CHOOSER n) { - reinterpret_cast<My_Color_Chooser*>(n)->real_draw(); -} - -void color_chooser_set_handle_hook(COLOR_CHOOSER n, void * h) { - reinterpret_cast<My_Color_Chooser*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_color_chooser_handle(COLOR_CHOOSER n, int e) { - return reinterpret_cast<My_Color_Chooser*>(n)->real_handle(e); -} - - - - -COLOR_CHOOSER new_fl_color_chooser(int x, int y, int w, int h, char* label) { - My_Color_Chooser *n = new My_Color_Chooser(x, y, w, h, label); - return n; -} - -void free_fl_color_chooser(COLOR_CHOOSER n) { - delete reinterpret_cast<My_Color_Chooser*>(n); -} - - - - -double fl_color_chooser_r(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->r(); -} - -double fl_color_chooser_g(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->g(); -} - -double fl_color_chooser_b(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->b(); -} - -int fl_color_chooser_rgb(COLOR_CHOOSER n, int r, int g, int b) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->rgb(r,g,b); -} - - - - -double fl_color_chooser_hue(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->hue(); -} - -double fl_color_chooser_saturation(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->saturation(); -} - -double fl_color_chooser_value(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->value(); -} - -int fl_color_chooser_hsv(COLOR_CHOOSER n, int h, int s, int v) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->hsv(h,s,v); -} - - - - -void fl_color_chooser_hsv2rgb(double h, double s, double v, double &r, double &g, double &b) { - Fl_Color_Chooser::hsv2rgb(h,s,v,r,g,b); -} - -void fl_color_chooser_rgb2hsv(double r, double g, double b, double &h, double &s, double &v) { - Fl_Color_Chooser::rgb2hsv(r,g,b,h,s,v); -} - - - - -int fl_color_chooser_get_mode(COLOR_CHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->mode(); -} - -void fl_color_chooser_set_mode(COLOR_CHOOSER n, int m) { - reinterpret_cast<Fl_Color_Chooser*>(n)->mode(m); -} - - diff --git a/src/c_fl_color_chooser.h b/src/c_fl_color_chooser.h deleted file mode 100644 index 3a8fd04..0000000 --- a/src/c_fl_color_chooser.h +++ /dev/null @@ -1,49 +0,0 @@ - - -#ifndef FL_COLOR_CHOOSER_GUARD -#define FL_COLOR_CHOOSER_GUARD - - - - -typedef void* COLOR_CHOOSER; - - - - -extern "C" void color_chooser_set_draw_hook(COLOR_CHOOSER n, void * d); -extern "C" void fl_color_chooser_draw(COLOR_CHOOSER n); -extern "C" void color_chooser_set_handle_hook(COLOR_CHOOSER n, void * h); -extern "C" int fl_color_chooser_handle(COLOR_CHOOSER n, int e); - - - - -extern "C" COLOR_CHOOSER new_fl_color_chooser(int x, int y, int w, int h, char* label); -extern "C" void free_fl_color_chooser(COLOR_CHOOSER n); - - - - -extern "C" double fl_color_chooser_r(COLOR_CHOOSER n); -extern "C" double fl_color_chooser_g(COLOR_CHOOSER n); -extern "C" double fl_color_chooser_b(COLOR_CHOOSER n); -extern "C" int fl_color_chooser_rgb(COLOR_CHOOSER n, int r, int g, int b); - - -extern "C" double fl_color_chooser_hue(COLOR_CHOOSER n); -extern "C" double fl_color_chooser_saturation(COLOR_CHOOSER n); -extern "C" double fl_color_chooser_value(COLOR_CHOOSER n); -extern "C" int fl_color_chooser_hsv(COLOR_CHOOSER n, int h, int s, int v); - - -extern "C" void fl_color_chooser_hsv2rgb(double h, double s, double v, double &r, double &g, double &b); -extern "C" void fl_color_chooser_rgb2hsv(double r, double g, double b, double &h, double &s, double &v); - - -extern "C" int fl_color_chooser_get_mode(COLOR_CHOOSER n); -extern "C" void fl_color_chooser_set_mode(COLOR_CHOOSER n, int m); - - -#endif - diff --git a/src/c_fl_copy_surface.cpp b/src/c_fl_copy_surface.cpp deleted file mode 100644 index c3be255..0000000 --- a/src/c_fl_copy_surface.cpp +++ /dev/null @@ -1,49 +0,0 @@ - - -#include <FL/Fl_Copy_Surface.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_copy_surface.h" - - - - -COPY_SURFACE new_fl_copy_surface(int w, int h) { - Fl_Copy_Surface *c = new Fl_Copy_Surface(w,h); - return c; -} - -void free_fl_copy_surface(COPY_SURFACE c) { - delete reinterpret_cast<Fl_Copy_Surface*>(c); -} - - - - -int fl_copy_surface_get_w(COPY_SURFACE c) { - return reinterpret_cast<Fl_Copy_Surface*>(c)->w(); -} - -int fl_copy_surface_get_h(COPY_SURFACE c) { - return reinterpret_cast<Fl_Copy_Surface*>(c)->h(); -} - - - - -void fl_copy_surface_draw(COPY_SURFACE c, void * w, int dx, int dy) { - reinterpret_cast<Fl_Copy_Surface*>(c)->draw(reinterpret_cast<Fl_Widget*>(w),dx,dy); -} - -void fl_copy_surface_draw_decorated_window(COPY_SURFACE c, void * w, int dx, int dy) { - reinterpret_cast<Fl_Copy_Surface*>(c)->draw_decorated_window(reinterpret_cast<Fl_Window*>(w),dx,dy); -} - - - - -void fl_copy_surface_set_current(COPY_SURFACE c) { - reinterpret_cast<Fl_Copy_Surface*>(c)->set_current(); -} - - diff --git a/src/c_fl_copy_surface.h b/src/c_fl_copy_surface.h deleted file mode 100644 index c323533..0000000 --- a/src/c_fl_copy_surface.h +++ /dev/null @@ -1,32 +0,0 @@ - - -#ifndef FL_COPY_SURFACE_GUARD -#define CL_COPY_SURFACE_GUARD - - - - -typedef void* COPY_SURFACE; - - - - -extern "C" COPY_SURFACE new_fl_copy_surface(int w, int h); -extern "C" void free_fl_copy_surface(COPY_SURFACE c); - - - - -extern "C" int fl_copy_surface_get_w(COPY_SURFACE c); -extern "C" int fl_copy_surface_get_h(COPY_SURFACE c); - - -extern "C" void fl_copy_surface_draw(COPY_SURFACE c, void * w, int dx, int dy); -extern "C" void fl_copy_surface_draw_decorated_window(COPY_SURFACE c, void * w, int dx, int dy); - - -extern "C" void fl_copy_surface_set_current(COPY_SURFACE c); - - -#endif - diff --git a/src/c_fl_counter.cpp b/src/c_fl_counter.cpp deleted file mode 100644 index 7e594f2..0000000 --- a/src/c_fl_counter.cpp +++ /dev/null @@ -1,111 +0,0 @@ - - -#include <FL/Fl_Counter.H> -#include "c_fl_counter.h" -#include "c_fl_type.h" - - - - -class My_Counter : public Fl_Counter { - public: - using Fl_Counter::Fl_Counter; - friend void counter_set_draw_hook(COUNTER c, void * d); - friend void fl_counter_draw(COUNTER c); - friend void counter_set_handle_hook(COUNTER c, void * h); - friend int fl_counter_handle(COUNTER c, 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_Counter::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Counter::real_draw() { - Fl_Counter::draw(); -} - -int My_Counter::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Counter::real_handle(int e) { - return Fl_Counter::handle(e); -} - -void counter_set_draw_hook(COUNTER c, void * d) { - reinterpret_cast<My_Counter*>(c)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_counter_draw(COUNTER c) { - reinterpret_cast<My_Counter*>(c)->real_draw(); -} - -void counter_set_handle_hook(COUNTER c, void * h) { - reinterpret_cast<My_Counter*>(c)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_counter_handle(COUNTER c, int e) { - return reinterpret_cast<My_Counter*>(c)->real_handle(e); -} - - - - -COUNTER new_fl_counter(int x, int y, int w, int h, char* label) { - My_Counter *c = new My_Counter(x, y, w, h, label); - return c; -} - -void free_fl_counter(COUNTER c) { - delete reinterpret_cast<My_Counter*>(c); -} - - - - -double fl_counter_get_step(COUNTER c) { - return reinterpret_cast<Fl_Counter*>(c)->step(); -} - -void fl_counter_set_step(COUNTER c, double t) { - reinterpret_cast<Fl_Counter*>(c)->step(t); -} - -void fl_counter_set_lstep(COUNTER c, double t) { - reinterpret_cast<Fl_Counter*>(c)->lstep(t); -} - - - - -unsigned int fl_counter_get_textcolor(COUNTER c) { - return reinterpret_cast<Fl_Counter*>(c)->textcolor(); -} - -void fl_counter_set_textcolor(COUNTER c, unsigned int t) { - reinterpret_cast<Fl_Counter*>(c)->textcolor(t); -} - -int fl_counter_get_textfont(COUNTER c) { - return reinterpret_cast<Fl_Counter*>(c)->textfont(); -} - -void fl_counter_set_textfont(COUNTER c, int t) { - reinterpret_cast<Fl_Counter*>(c)->textfont(t); -} - -int fl_counter_get_textsize(COUNTER c) { - return reinterpret_cast<Fl_Counter*>(c)->textsize(); -} - -void fl_counter_set_textsize(COUNTER c, int t) { - reinterpret_cast<Fl_Counter*>(c)->textsize(t); -} - diff --git a/src/c_fl_counter.h b/src/c_fl_counter.h deleted file mode 100644 index 97e7a50..0000000 --- a/src/c_fl_counter.h +++ /dev/null @@ -1,42 +0,0 @@ - - -#ifndef FL_COUNTER_GUARD -#define FL_COUNTER_GUARD - - - - -typedef void* COUNTER; - - - - -extern "C" void counter_set_draw_hook(COUNTER c, void * d); -extern "C" void fl_counter_draw(COUNTER c); -extern "C" void counter_set_handle_hook(COUNTER c, void * h); -extern "C" int fl_counter_handle(COUNTER c, int e); - - - - -extern "C" COUNTER new_fl_counter(int x, int y, int w, int h, char* label); -extern "C" void free_fl_counter(COUNTER c); - - - - -extern "C" double fl_counter_get_step(COUNTER c); -extern "C" void fl_counter_set_step(COUNTER c, double t); -extern "C" void fl_counter_set_lstep(COUNTER c, double t); - - -extern "C" unsigned int fl_counter_get_textcolor(COUNTER c); -extern "C" void fl_counter_set_textcolor(COUNTER c, unsigned int t); -extern "C" int fl_counter_get_textfont(COUNTER c); -extern "C" void fl_counter_set_textfont(COUNTER c, int t); -extern "C" int fl_counter_get_textsize(COUNTER c); -extern "C" void fl_counter_set_textsize(COUNTER c, int t); - - -#endif - diff --git a/src/c_fl_dial.cpp b/src/c_fl_dial.cpp deleted file mode 100644 index 3ec28a0..0000000 --- a/src/c_fl_dial.cpp +++ /dev/null @@ -1,103 +0,0 @@ - - -#include <FL/Fl_Dial.H> -#include "c_fl_dial.h" -#include "c_fl_type.h" - - - - -class My_Dial : public Fl_Dial { - public: - using Fl_Dial::Fl_Dial; - friend void dial_set_draw_hook(DIAL v, void * d); - friend void fl_dial_draw(DIAL v); - friend void dial_set_handle_hook(DIAL v, void * h); - friend int fl_dial_handle(DIAL v, 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_Dial::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Dial::real_draw() { - Fl_Dial::draw(); -} - -int My_Dial::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Dial::real_handle(int e) { - return Fl_Dial::handle(e); -} - -void dial_set_draw_hook(DIAL v, void * d) { - reinterpret_cast<My_Dial*>(v)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_dial_draw(DIAL v) { - reinterpret_cast<My_Dial*>(v)->real_draw(); -} - -void dial_set_handle_hook(DIAL v, void * h) { - reinterpret_cast<My_Dial*>(v)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_dial_handle(DIAL v, int e) { - return reinterpret_cast<My_Dial*>(v)->real_handle(e); -} - - - - -DIAL new_fl_dial(int x, int y, int w, int h, char* label) { - My_Dial *v = new My_Dial(x, y, w, h, label); - return v; -} - -void free_fl_dial(DIAL v) { - delete reinterpret_cast<My_Dial*>(v); -} - - - - -int fl_dial_get_type(DIAL v) { - return reinterpret_cast<Fl_Dial*>(v)->type(); -} - -void fl_dial_set_type(DIAL v, int t) { - reinterpret_cast<Fl_Dial*>(v)->type(t); -} - - - - -int fl_dial_get_angle1(DIAL v) { - return reinterpret_cast<Fl_Dial*>(v)->angle1(); -} - -void fl_dial_set_angle1(DIAL v, int t) { - reinterpret_cast<Fl_Dial*>(v)->angle1(t); -} - -int fl_dial_get_angle2(DIAL v) { - return reinterpret_cast<Fl_Dial*>(v)->angle2(); -} - -void fl_dial_set_angle2(DIAL v, int t) { - reinterpret_cast<Fl_Dial*>(v)->angle2(t); -} - -void fl_dial_set_angles(DIAL v, int a, int b) { - reinterpret_cast<Fl_Dial*>(v)->angles(a,b); -} - diff --git a/src/c_fl_dial.h b/src/c_fl_dial.h deleted file mode 100644 index c42fb36..0000000 --- a/src/c_fl_dial.h +++ /dev/null @@ -1,40 +0,0 @@ - - -#ifndef FL_DIAL_GUARD -#define FL_DIAL_GUARD - - - - -typedef void* DIAL; - - - - -extern "C" void dial_set_draw_hook(DIAL v, void * d); -extern "C" void fl_dial_draw(DIAL v); -extern "C" void dial_set_handle_hook(DIAL v, void * h); -extern "C" int fl_dial_handle(DIAL v, int e); - - - - -extern "C" DIAL new_fl_dial(int x, int y, int w, int h, char* label); -extern "C" void free_fl_dial(DIAL v); - - - - -extern "C" int fl_dial_get_type(DIAL v); -extern "C" void fl_dial_set_type(DIAL v, int t); - - -extern "C" int fl_dial_get_angle1(DIAL v); -extern "C" void fl_dial_set_angle1(DIAL v, int t); -extern "C" int fl_dial_get_angle2(DIAL v); -extern "C" void fl_dial_set_angle2(DIAL v, int t); -extern "C" void fl_dial_set_angles(DIAL v, int a, int b); - - -#endif - diff --git a/src/c_fl_dialog.cpp b/src/c_fl_dialog.cpp deleted file mode 100644 index 1929859..0000000 --- a/src/c_fl_dialog.cpp +++ /dev/null @@ -1,83 +0,0 @@ - - -#include <FL/fl_ask.H> -#include <FL/Fl_File_Chooser.H> -#include <FL/Fl_Color_Chooser.H> -#include "c_fl_dialog.h" - - -void dialog_fl_alert(const char * m) { - fl_alert(m); -} - -//int dialog_fl_ask(const char * m) { -// return fl_ask(m); -//} - -void dialog_fl_beep(int b) { - fl_beep(b); -} - -int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c) { - return fl_choice(m, a, b, c); -} - -const char * dialog_fl_input(const char * m, const char * d) { - return fl_input(m, d); -} - -void dialog_fl_message(const char * m) { - fl_message(m); -} - -const char * dialog_fl_password(const char * m, const char * d) { - return fl_password(m, d); -} - - - - -int dialog_fl_color_chooser(const char * n, double & r, double & g, double & b, int m) { - return fl_color_chooser(n, r, g, b, m); -} - -int dialog_fl_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m) { - return fl_color_chooser(n, r, g, b, m); -} - -char * dialog_fl_dir_chooser(const char * m, const char * d, int r) { - return fl_dir_chooser(m, d, r); -} - -char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r) { - return fl_file_chooser(m, p, d, r); -} - - - - -int dialog_fl_get_message_hotspot(void) { - return fl_message_hotspot(); -} - -void dialog_fl_set_message_hotspot(int v) { - fl_message_hotspot(v); -} - -void dialog_fl_message_font(int f, int s) { - fl_message_font(f, s); -} - -void * dialog_fl_message_icon(void) { - return fl_message_icon(); -} - -void dialog_fl_message_title(const char * t) { - fl_message_title(t); -} - -void dialog_fl_message_title_default(const char * t) { - fl_message_title_default(t); -} - - diff --git a/src/c_fl_dialog.h b/src/c_fl_dialog.h deleted file mode 100644 index 066e854..0000000 --- a/src/c_fl_dialog.h +++ /dev/null @@ -1,31 +0,0 @@ - - -#ifndef FL_DIALOG_GUARD -#define FL_DIALOG_GUARD - - -extern "C" void dialog_fl_alert(const char * m); -//extern "C" int dialog_fl_ask(const char * m); -extern "C" void dialog_fl_beep(int b); -extern "C" int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c); -extern "C" const char * dialog_fl_input(const char * m, const char * d); -extern "C" void dialog_fl_message(const char * m); -extern "C" const char * dialog_fl_password(const char * m, const char * d); - - -extern "C" int dialog_fl_color_chooser(const char * n, double & r, double & g, double & b, int m); -extern "C" int dialog_fl_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m); -extern "C" char * dialog_fl_dir_chooser(const char * m, const char * d, int r); -extern "C" char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r); - - -extern "C" int dialog_fl_get_message_hotspot(void); -extern "C" void dialog_fl_set_message_hotspot(int v); -extern "C" void dialog_fl_message_font(int f, int s); -extern "C" void * dialog_fl_message_icon(void); -extern "C" void dialog_fl_message_title(const char * t); -extern "C" void dialog_fl_message_title_default(const char * t); - - -#endif - diff --git a/src/c_fl_double_window.cpp b/src/c_fl_double_window.cpp deleted file mode 100644 index 389ce6a..0000000 --- a/src/c_fl_double_window.cpp +++ /dev/null @@ -1,89 +0,0 @@ - - -#include <FL/Fl_Double_Window.H> -#include "c_fl_double_window.h" -#include "c_fl_type.h" - - - - -class My_Double_Window : public Fl_Double_Window { - public: - using Fl_Double_Window::Fl_Double_Window; - friend void double_window_set_draw_hook(DOUBLEWINDOW n, void * d); - friend void fl_double_window_draw(DOUBLEWINDOW n); - friend void double_window_set_handle_hook(DOUBLEWINDOW n, void * h); - friend int fl_double_window_handle(DOUBLEWINDOW n, 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_Double_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Double_Window::real_draw() { - Fl_Double_Window::draw(); -} - -int My_Double_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Double_Window::real_handle(int e) { - return Fl_Double_Window::handle(e); -} - -void double_window_set_draw_hook(DOUBLEWINDOW n, void * d) { - reinterpret_cast<My_Double_Window*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_double_window_draw(DOUBLEWINDOW n) { - reinterpret_cast<My_Double_Window*>(n)->real_draw(); -} - -void double_window_set_handle_hook(DOUBLEWINDOW n, void * h) { - reinterpret_cast<My_Double_Window*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_double_window_handle(DOUBLEWINDOW n, int e) { - return reinterpret_cast<My_Double_Window*>(n)->real_handle(e); -} - - - - -DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label) { - My_Double_Window *d = new My_Double_Window(x, y, w, h, label); - return d; -} - -DOUBLEWINDOW new_fl_double_window2(int w, int h, char* label) { - My_Double_Window *d = new My_Double_Window(w, h, label); - return d; -} - -void free_fl_double_window(DOUBLEWINDOW d) { - delete reinterpret_cast<My_Double_Window*>(d); -} - - - - -void fl_double_window_show(DOUBLEWINDOW d) { - reinterpret_cast<Fl_Double_Window*>(d)->show(); -} - -void fl_double_window_hide(DOUBLEWINDOW d) { - reinterpret_cast<Fl_Double_Window*>(d)->hide(); -} - -void fl_double_window_flush(DOUBLEWINDOW d) { - reinterpret_cast<Fl_Double_Window*>(d)->flush(); -} - diff --git a/src/c_fl_double_window.h b/src/c_fl_double_window.h deleted file mode 100644 index d7ef32d..0000000 --- a/src/c_fl_double_window.h +++ /dev/null @@ -1,35 +0,0 @@ - - -#ifndef FL_DOUBLE_WINDOW_GUARD -#define FL_DOUBLE_WINDOW_GUARD - - - - -typedef void* DOUBLEWINDOW; - - - - -extern "C" void double_window_set_draw_hook(DOUBLEWINDOW n, void * d); -extern "C" void fl_double_window_draw(DOUBLEWINDOW n); -extern "C" void double_window_set_handle_hook(DOUBLEWINDOW n, void * h); -extern "C" int fl_double_window_handle(DOUBLEWINDOW n, int e); - - - - -extern "C" DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label); -extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h, char* label); -extern "C" void free_fl_double_window(DOUBLEWINDOW d); - - - - -extern "C" void fl_double_window_show(DOUBLEWINDOW d); -extern "C" void fl_double_window_hide(DOUBLEWINDOW d); -extern "C" void fl_double_window_flush(DOUBLEWINDOW d); - - -#endif - diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp deleted file mode 100644 index 4c63f77..0000000 --- a/src/c_fl_draw.cpp +++ /dev/null @@ -1,441 +0,0 @@ - - -#include <FL/fl_draw.H> -#include <FL/Fl_Window.H> -#include "c_fl_draw.h" - - - - -void fl_draw_reset_spot() { - fl_reset_spot(); -} - -void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr) { - fl_set_spot(f, s, x, y, w, h, reinterpret_cast<Fl_Window*>(ptr)); -} - -void fl_draw_set_status(int x, int y, int w, int h) { - fl_set_status(x, y, w, h); -} - - - - -int fl_draw_can_do_alpha_blending() { - return fl_can_do_alpha_blending(); -} - -const char * fl_draw_shortcut_label(unsigned long shortcut) { - return fl_shortcut_label(shortcut); -} - - - - -const char * fl_draw_latin1_to_local(const char *t, int n) { - return fl_latin1_to_local(t, n); -} - -const char * fl_draw_local_to_latin1(const char *t, int n) { - return fl_local_to_latin1(t, n); -} - -const char * fl_draw_mac_roman_to_local(const char *t, int n) { - return fl_mac_roman_to_local(t, n); -} - -const char * fl_draw_local_to_mac_roman(const char *t, int n) { - return fl_local_to_mac_roman(t, n); -} - - - - -int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh) { - return fl_clip_box(x, y, w, h, bx, by, bw, bh); -} - -int fl_draw_not_clipped(int x, int y, int w, int h) { - return fl_not_clipped(x, y, w, h); -} - -void fl_draw_pop_clip() { - fl_pop_clip(); -} - -void fl_draw_push_clip(int x, int y, int w, int h) { - fl_push_clip(x, y, w, h); -} - -void fl_draw_push_no_clip() { - fl_push_no_clip(); -} - -void fl_draw_restore_clip() { - fl_restore_clip(); -} - - - - -void fl_draw_overlay_clear() { - fl_overlay_clear(); -} - -void fl_draw_overlay_rect(int x, int y, int w, int h) { - fl_overlay_rect(x, y, w, h); -} - - - - -unsigned int fl_draw_get_color() { - return fl_color(); -} - -void fl_draw_set_color(unsigned int c) { - fl_color(c); -} - -void fl_draw_set_color2(uchar r, uchar g, uchar b) { - fl_color(r, g, b); -} - -void fl_draw_set_cursor(int m) { - fl_cursor((Fl_Cursor)m); -} - -void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b) { - fl_cursor((Fl_Cursor)m, f, b); -} - -unsigned int fl_draw_get_font() { - return (unsigned int)fl_font(); -} - -int fl_draw_size() { - return fl_size(); -} - -void fl_draw_set_font(unsigned int f, int s) { - fl_font((Fl_Font)f, (Fl_Fontsize)s); -} - -int fl_draw_height() { - return fl_height(); -} - -int fl_draw_descent() { - return fl_descent(); -} - -int fl_draw_height2(unsigned int f, int s) { - return fl_height(f, s); -} - -void fl_draw_line_style(int style, int width, char * dashes) { - fl_line_style(style, width, dashes); -} - - - - -void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y) { - fl_mult_matrix(a, b, c, d, x, y); -} - -void fl_draw_pop_matrix() { - fl_pop_matrix(); -} - -void fl_draw_push_matrix() { - fl_push_matrix(); -} - -void fl_draw_rotate(double d) { - fl_rotate(d); -} - -void fl_draw_scale(double x) { - fl_scale(x); -} - -void fl_draw_scale2(double x, double y) { - fl_scale(x, y); -} - -double fl_draw_transform_dx(double x, double y) { - return fl_transform_dx(x, y); -} - -double fl_draw_transform_dy(double x, double y) { - return fl_transform_dy(x, y); -} - -double fl_draw_transform_x(double x, double y) { - return fl_transform_x(x, y); -} - -double fl_draw_transform_y(double x, double y) { - return fl_transform_y(x, y); -} - -void fl_draw_transformed_vertex(double xf, double yf) { - fl_transformed_vertex(xf, yf); -} - -void fl_draw_translate(double x, double y) { - fl_translate(x, y); -} - -void fl_draw_vertex(double x, double y) { - fl_vertex(x, y); -} - - - - -void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l) { - fl_draw_image(reinterpret_cast<uchar*>(data), x, y, w, h, d, l); -} - -void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d) { - fl_draw_image(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d); -} - -void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l) { - fl_draw_image_mono(reinterpret_cast<uchar*>(data), x, y, w, h, d, l); -} - -void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d) { - fl_draw_image_mono(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d); -} - -void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha) { - return fl_read_image(reinterpret_cast<uchar*>(data), x, y, w, h, alpha); -} - - - - -typedef void (sym_hook)(Fl_Color); -typedef sym_hook* sym_hook_p; - -int fl_draw_add_symbol(const char *name, void *func, int scalable) { - return fl_add_symbol(name, reinterpret_cast<sym_hook_p>(func), scalable); -} - -void fl_draw_draw_text(const char *str, int n, int x, int y) { - fl_draw(str, n, x, y); -} - -void fl_draw_draw_text2(const char *str, int x, int y, int w, int h, - unsigned align, void * img, int draw_symbols) { - fl_draw(str, x, y, w, h, (Fl_Align)align, (Fl_Image*)img, draw_symbols); -} - -typedef void (t_hook)(const char *, int ,int ,int); -typedef t_hook* t_hook_p; - -void fl_draw_draw_text3(const char *str, int x, int y, int w, int h, - unsigned align, void * func, void * img, int draw_symbols) { - fl_draw(str, x, y, w, h, (Fl_Align)align, - reinterpret_cast<t_hook_p>(func), (Fl_Image*)img, draw_symbols); -} - -void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y) { - fl_draw(angle, str, n, x, y); -} - -void fl_draw_rtl_draw(const char *str, int n, int x, int y) { - fl_rtl_draw(str, n, x, y); -} - -void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c) { - fl_draw_box((Fl_Boxtype)bk, x, y, w, h, (Fl_Color)c); -} - -void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c) { - fl_draw_symbol(label, x, y, w, h, (Fl_Color)c); -} - -void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols) { - fl_measure(str, w, h, draw_symbols); -} - -typedef void (a_hook)(void *, int, int, int, int); -typedef a_hook* a_hook_p; - -void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy, - void * func, void * data) { - fl_scroll(x, y, w, h, dx, dy, reinterpret_cast<a_hook_p>(func), data); -} - -void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h) { - fl_text_extents(t, n, dx, dy, w, h); -} - -double fl_draw_width(const char *txt, int n) { - return fl_width(txt, n); -} - -double fl_draw_width2(unsigned long c) { - return fl_width(c); -} - - - - -void fl_draw_begin_complex_polygon() { - fl_begin_complex_polygon(); -} - -void fl_draw_begin_line() { - fl_begin_line(); -} - -void fl_draw_begin_loop() { - fl_begin_loop(); -} - -void fl_draw_begin_points() { - fl_begin_points(); -} - -void fl_draw_begin_polygon() { - fl_begin_polygon(); -} - - - - -void fl_draw_arc(double x, double y, double r, double start, double end) { - fl_arc(x, y, r, start, end); -} - -void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2) { - fl_arc(x, y, w, h, a1, a2); -} - -void fl_draw_chord(int x, int y, int w, int h, double a1, double a2) { - fl_chord(x, y, w, h, a1, a2); -} - -void fl_draw_circle(double x, double y, double r) { - fl_circle(x, y, r); -} - -void fl_draw_curve(double x0, double y0, double x1, double y1, - double x2, double y2, double x3, double y3) { - fl_curve(x0, y0, x1, y1, x2, y2, x3, y3); -} - -void fl_draw_frame(const char *s, int x, int y, int w, int h) { - fl_frame(s, x, y, w, h); -} - -void fl_draw_gap() { - fl_gap(); -} - -void fl_draw_line(int x0, int y0, int x1, int y1) { - fl_line(x0, y0, x1, y1); -} - -void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2) { - fl_line(x0, y0, x1, y1, x2, y2); -} - -void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2) { - fl_loop(x0, y0, x1, y1, x2, y2); -} - -void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) { - fl_loop(x0, y0, x1, y1, x2, y2, x3, y3); -} - -void fl_draw_pie(int x, int y, int w, int h, double a1, double a2) { - fl_pie(x, y, w, h, a1, a2); -} - -void fl_draw_point(int x, int y) { - fl_point(x, y); -} - -void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2) { - fl_polygon(x0, y0, x1, y1, x2, y2); -} - -void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) { - fl_polygon(x0, y0, x1, y1, x2, y2, x3, y3); -} - -void fl_draw_rect(int x, int y, int w, int h) { - fl_rect(x, y, w, h); -} - -void fl_draw_rect2(int x, int y, int w, int h, unsigned int c) { - fl_rect(x, y, w, h, c); -} - -void fl_draw_rect_fill(int x, int y, int w, int h) { - fl_rectf(x, y, w, h); -} - -void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c) { - fl_rectf(x, y, w, h, (Fl_Color)c); -} - -void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b) { - fl_rectf(x, y, w, h, r, g, b); -} - -void fl_draw_xy_line(int x0, int y0, int x1) { - fl_xyline(x0, y0, x1); -} - -void fl_draw_xy_line2(int x0, int y0, int x1, int y2) { - fl_xyline(x0, y0, x1, y2); -} - -void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3) { - fl_xyline(x0, y0, x1, y2, x3); -} - -void fl_draw_yx_line(int x0, int y0, int y1) { - fl_yxline(x0, y0, y1); -} - -void fl_draw_yx_line2(int x0, int y0, int y1, int x2) { - fl_yxline(x0, y0, y1, x2); -} - -void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3) { - fl_yxline(x0, y0, y1, x2, y3); -} - - - - -void fl_draw_end_complex_polygon() { - fl_end_complex_polygon(); -} - -void fl_draw_end_line() { - fl_end_line(); -} - -void fl_draw_end_loop() { - fl_end_loop(); -} - -void fl_draw_end_points() { - fl_end_points(); -} - -void fl_draw_end_polygon() { - fl_end_polygon(); -} - - diff --git a/src/c_fl_draw.h b/src/c_fl_draw.h deleted file mode 100644 index 74c0d00..0000000 --- a/src/c_fl_draw.h +++ /dev/null @@ -1,134 +0,0 @@ - - -#ifndef FL_DRAW_GUARD -#define FL_DRAW_GUARD - - - - -extern "C" void fl_draw_reset_spot(); -extern "C" void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr); -extern "C" void fl_draw_set_status(int x, int y, int w, int h); - - -extern "C" int fl_draw_can_do_alpha_blending(); -extern "C" const char * fl_draw_shortcut_label(unsigned long shortcut); - - -extern "C" const char * fl_draw_latin1_to_local(const char *t, int n); -extern "C" const char * fl_draw_local_to_latin1(const char *t, int n); -extern "C" const char * fl_draw_mac_roman_to_local(const char *t, int n); -extern "C" const char * fl_draw_local_to_mac_roman(const char *t, int n); - - -extern "C" int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh); -extern "C" int fl_draw_not_clipped(int x, int y, int w, int h); -extern "C" void fl_draw_pop_clip(); -extern "C" void fl_draw_push_clip(int x, int y, int w, int h); -extern "C" void fl_draw_push_no_clip(); -extern "C" void fl_draw_restore_clip(); - - -extern "C" void fl_draw_overlay_clear(); -extern "C" void fl_draw_overlay_rect(int x, int y, int w, int h); - - -extern "C" unsigned int fl_draw_get_color(); -extern "C" void fl_draw_set_color(unsigned int c); -extern "C" void fl_draw_set_color2(uchar r, uchar g, uchar b); -extern "C" void fl_draw_set_cursor(int m); -extern "C" void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b); -extern "C" unsigned int fl_draw_get_font(); -extern "C" int fl_draw_size(); -extern "C" void fl_draw_set_font(unsigned int f, int s); -extern "C" int fl_draw_height(); -extern "C" int fl_draw_descent(); -extern "C" int fl_draw_height2(unsigned int f, int s); -extern "C" void fl_draw_line_style(int style, int width, char * dashes); - - -extern "C" void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y); -extern "C" void fl_draw_pop_matrix(); -extern "C" void fl_draw_push_matrix(); -extern "C" void fl_draw_rotate(double d); -extern "C" void fl_draw_scale(double x); -extern "C" void fl_draw_scale2(double x, double y); -extern "C" double fl_draw_transform_dx(double x, double y); -extern "C" double fl_draw_transform_dy(double x, double y); -extern "C" double fl_draw_transform_x(double x, double y); -extern "C" double fl_draw_transform_y(double x, double y); -extern "C" void fl_draw_transformed_vertex(double xf, double yf); -extern "C" void fl_draw_translate(double x, double y); -extern "C" void fl_draw_vertex(double x, double y); - - -extern "C" void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l); -extern "C" void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d); -extern "C" void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l); -extern "C" void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d); -extern "C" void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha); - - -extern "C" int fl_draw_add_symbol(const char *name, void *func, int scalable); -extern "C" void fl_draw_draw_text(const char *str, int n, int x, int y); -extern "C" void fl_draw_draw_text2(const char *str, int x, int y, int w, int h, - unsigned align, void * img, int draw_symbols); -extern "C" void fl_draw_draw_text3(const char *str, int x, int y, int w, int h, - unsigned align, void * func, void * img, int draw_symbols); -extern "C" void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y); -extern "C" void fl_draw_rtl_draw(const char *str, int n, int x, int y); -extern "C" void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c); -extern "C" void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c); -extern "C" void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols); -extern "C" void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy, - void * func, void * data); -extern "C" void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h); -extern "C" double fl_draw_width(const char *txt, int n); -extern "C" double fl_draw_width2(unsigned long c); - - -extern "C" void fl_draw_begin_complex_polygon(); -extern "C" void fl_draw_begin_line(); -extern "C" void fl_draw_begin_loop(); -extern "C" void fl_draw_begin_points(); -extern "C" void fl_draw_begin_polygon(); - - -extern "C" void fl_draw_arc(double x, double y, double r, double start, double end); -extern "C" void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2); -extern "C" void fl_draw_chord(int x, int y, int w, int h, double a1, double a2); -extern "C" void fl_draw_circle(double x, double y, double r); -extern "C" void fl_draw_curve(double x0, double y0, double x1, double y1, - double x2, double y2, double x3, double y3); -extern "C" void fl_draw_frame(const char *s, int x, int y, int w, int h); -extern "C" void fl_draw_gap(); -extern "C" void fl_draw_line(int x0, int y0, int x1, int y1); -extern "C" void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2); -extern "C" void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2); -extern "C" void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3); -extern "C" void fl_draw_pie(int x, int y, int w, int h, double a1, double a2); -extern "C" void fl_draw_point(int x, int y); -extern "C" void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2); -extern "C" void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3); -extern "C" void fl_draw_rect(int x, int y, int w, int h); -extern "C" void fl_draw_rect2(int x, int y, int w, int h, unsigned int c); -extern "C" void fl_draw_rect_fill(int x, int y, int w, int h); -extern "C" void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c); -extern "C" void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b); -extern "C" void fl_draw_xy_line(int x0, int y0, int x1); -extern "C" void fl_draw_xy_line2(int x0, int y0, int x1, int y2); -extern "C" void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3); -extern "C" void fl_draw_yx_line(int x0, int y0, int y1); -extern "C" void fl_draw_yx_line2(int x0, int y0, int y1, int x2); -extern "C" void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3); - - -extern "C" void fl_draw_end_complex_polygon(); -extern "C" void fl_draw_end_line(); -extern "C" void fl_draw_end_loop(); -extern "C" void fl_draw_end_points(); -extern "C" void fl_draw_end_polygon(); - - -#endif - diff --git a/src/c_fl_event.cpp b/src/c_fl_event.cpp deleted file mode 100644 index e1c83ef..0000000 --- a/src/c_fl_event.cpp +++ /dev/null @@ -1,190 +0,0 @@ - - -#include <FL/Fl.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_event.h" - - - - -void fl_event_add_handler(void * f) { - Fl::add_handler(reinterpret_cast<Fl_Event_Handler>(f)); -} - -void fl_event_set_event_dispatch(void * f) { - Fl::event_dispatch(reinterpret_cast<Fl_Event_Dispatch>(f)); -} - -int fl_event_handle(int e, void * w) { - return Fl::handle_(e, reinterpret_cast<Fl_Window*>(w)); -} - - - - -void * fl_event_get_grab() { - return Fl::grab(); -} - -void fl_event_set_grab(void * w) { - Fl::grab(reinterpret_cast<Fl_Window*>(w)); -} - -void * fl_event_get_pushed() { - return Fl::pushed(); -} - -void fl_event_set_pushed(void * w) { - Fl::pushed(reinterpret_cast<Fl_Widget*>(w)); -} - -void * fl_event_get_belowmouse() { - return Fl::belowmouse(); -} - -void fl_event_set_belowmouse(void * w) { - Fl::belowmouse(reinterpret_cast<Fl_Widget*>(w)); -} - -void * fl_event_get_focus() { - return Fl::focus(); -} - -void fl_event_set_focus(void * w) { - Fl::focus(reinterpret_cast<Fl_Widget*>(w)); -} - - - - -int fl_event_compose(int &d) { - return Fl::compose(d); -} - -void fl_event_compose_reset() { - Fl::compose_reset(); -} - -const char * fl_event_text() { - return Fl::event_text(); -} - -int fl_event_length() { - return Fl::event_length(); -} - - - - -int fl_event_get() { - return Fl::event(); -} - -unsigned long fl_event_state() { - return Fl::event_state(); -} - -int fl_event_check_state(unsigned long s) { - return Fl::event_state(s); -} - - - - -int fl_event_x() { - return Fl::event_x(); -} - -int fl_event_x_root() { - return Fl::event_x_root(); -} - -int fl_event_y() { - return Fl::event_y(); -} - -int fl_event_y_root() { - return Fl::event_y_root(); -} - -int fl_event_dx() { - return Fl::event_dx(); -} - -int fl_event_dy() { - return Fl::event_dy(); -} - -void fl_event_get_mouse(int &x, int &y) { - Fl::get_mouse(x, y); -} - -int fl_event_is_click() { - return Fl::event_is_click(); -} - -int fl_event_is_clicks() { - return Fl::event_clicks(); -} - -void fl_event_set_clicks(int c) { - Fl::event_clicks(c); -} - -int fl_event_button() { - return Fl::event_button(); -} - -int fl_event_button1() { - return Fl::event_button1(); -} - -int fl_event_button2() { - return Fl::event_button2(); -} - -int fl_event_button3() { - return Fl::event_button3(); -} - -int fl_event_inside(int x, int y, int w, int h) { - return Fl::event_inside(x, y, w, h); -} - - - - -unsigned long fl_event_key() { - return Fl::event_key(); -} - -unsigned long fl_event_original_key() { - return Fl::event_original_key(); -} - -int fl_event_key_during(unsigned long k) { - return Fl::event_key(k); -} - -int fl_event_get_key(unsigned long k) { - return Fl::get_key(k); -} - -int fl_event_ctrl() { - return Fl::event_ctrl(); -} - -int fl_event_alt() { - return Fl::event_alt(); -} - -int fl_event_command() { - return Fl::event_command(); -} - -int fl_event_shift() { - return Fl::event_shift(); -} - - diff --git a/src/c_fl_event.h b/src/c_fl_event.h deleted file mode 100644 index 28cdb47..0000000 --- a/src/c_fl_event.h +++ /dev/null @@ -1,63 +0,0 @@ - - -#ifndef FL_EVENT_GUARD -#define FL_EVENT_GUARD - - - - -extern "C" void fl_event_add_handler(void * f); -extern "C" void fl_event_set_event_dispatch(void * f); -extern "C" int fl_event_handle(int e, void * w); - - -extern "C" void * fl_event_get_grab(); -extern "C" void fl_event_set_grab(void * w); -extern "C" void * fl_event_get_pushed(); -extern "C" void fl_event_set_pushed(void * w); -extern "C" void * fl_event_get_belowmouse(); -extern "C" void fl_event_set_belowmouse(void * w); -extern "C" void * fl_event_get_focus(); -extern "C" void fl_event_set_focus(void * w); - - -extern "C" int fl_event_compose(int &d); -extern "C" void fl_event_compose_reset(); -extern "C" const char * fl_event_text(); -extern "C" int fl_event_length(); - - -extern "C" int fl_event_get(); -extern "C" unsigned long fl_event_state(); -extern "C" int fl_event_check_state(unsigned long s); - - -extern "C" int fl_event_x(); -extern "C" int fl_event_x_root(); -extern "C" int fl_event_y(); -extern "C" int fl_event_y_root(); -extern "C" int fl_event_dx(); -extern "C" int fl_event_dy(); -extern "C" void fl_event_get_mouse(int &x, int &y); -extern "C" int fl_event_is_click(); -extern "C" int fl_event_is_clicks(); -extern "C" void fl_event_set_clicks(int c); -extern "C" int fl_event_button(); -extern "C" int fl_event_button1(); -extern "C" int fl_event_button2(); -extern "C" int fl_event_button3(); -extern "C" int fl_event_inside(int x, int y, int w, int h); - - -extern "C" unsigned long fl_event_key(); -extern "C" unsigned long fl_event_original_key(); -extern "C" int fl_event_key_during(unsigned long k); -extern "C" int fl_event_get_key(unsigned long k); -extern "C" int fl_event_ctrl(); -extern "C" int fl_event_alt(); -extern "C" int fl_event_command(); -extern "C" int fl_event_shift(); - - -#endif - diff --git a/src/c_fl_file_input.cpp b/src/c_fl_file_input.cpp deleted file mode 100644 index f4fcc4f..0000000 --- a/src/c_fl_file_input.cpp +++ /dev/null @@ -1,100 +0,0 @@ - - -#include <FL/Fl_File_Input.H> -#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; -}; - -void My_File_Input::draw() { - (*draw_hook)(this->user_data()); -} - -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<My_File_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_file_input_draw(FILE_INPUT i) { - reinterpret_cast<My_File_Input*>(i)->real_draw(); -} - -void file_input_set_handle_hook(FILE_INPUT i, void * h) { - reinterpret_cast<My_File_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_file_input_handle(FILE_INPUT i, int e) { - return reinterpret_cast<My_File_Input*>(i)->real_handle(e); -} - - - - -FILE_INPUT 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) { - delete reinterpret_cast<My_File_Input*>(i); -} - - - - -int fl_file_input_get_down_box(FILE_INPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->down_box(); -} - -void fl_file_input_set_down_box(FILE_INPUT i, int t) { - reinterpret_cast<Fl_File_Input*>(i)->down_box(static_cast<Fl_Boxtype>(t)); -} - -unsigned int fl_file_input_get_errorcolor(FILE_INPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->errorcolor(); -} - -void fl_file_input_set_errorcolor(FILE_INPUT i, unsigned int t) { - reinterpret_cast<Fl_File_Input*>(i)->errorcolor(t); -} - - - - -const char * fl_file_input_get_value(FILE_INPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->value(); -} - -void fl_file_input_set_value(FILE_INPUT i, const char * s, int len) { - reinterpret_cast<Fl_File_Input*>(i)->value(s,len); -} - - diff --git a/src/c_fl_file_input.h b/src/c_fl_file_input.h deleted file mode 100644 index 8346332..0000000 --- a/src/c_fl_file_input.h +++ /dev/null @@ -1,39 +0,0 @@ - - -#ifndef FL_FILE_INPUT_GUARD -#define FL_FILE_INPUT_GUARD - - - - -typedef void* FILE_INPUT; - - - - -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" 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); - - -#endif - diff --git a/src/c_fl_fill_dial.cpp b/src/c_fl_fill_dial.cpp deleted file mode 100644 index 94e5795..0000000 --- a/src/c_fl_fill_dial.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Fill_Dial.H> -#include "c_fl_fill_dial.h" -#include "c_fl_type.h" - - - - -class My_Fill_Dial : public Fl_Fill_Dial { - public: - using Fl_Fill_Dial::Fl_Fill_Dial; - friend void fill_dial_set_draw_hook(FILL_DIAL v, void * d); - friend void fl_fill_dial_draw(FILL_DIAL v); - friend void fill_dial_set_handle_hook(FILL_DIAL v, void * h); - friend int fl_fill_dial_handle(FILL_DIAL v, 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_Fill_Dial::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Fill_Dial::real_draw() { - Fl_Fill_Dial::draw(); -} - -int My_Fill_Dial::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Fill_Dial::real_handle(int e) { - return Fl_Fill_Dial::handle(e); -} - -void fill_dial_set_draw_hook(FILL_DIAL v, void * d) { - reinterpret_cast<My_Fill_Dial*>(v)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_fill_dial_draw(FILL_DIAL v) { - reinterpret_cast<My_Fill_Dial*>(v)->real_draw(); -} - -void fill_dial_set_handle_hook(FILL_DIAL v, void * h) { - reinterpret_cast<My_Fill_Dial*>(v)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_fill_dial_handle(FILL_DIAL v, int e) { - return reinterpret_cast<My_Fill_Dial*>(v)->real_handle(e); -} - - - - -FILL_DIAL new_fl_fill_dial(int x, int y, int w, int h, char* label) { - My_Fill_Dial *v = new My_Fill_Dial(x, y, w, h, label); - return v; -} - -void free_fl_fill_dial(FILL_DIAL v) { - delete reinterpret_cast<My_Fill_Dial*>(v); -} - - diff --git a/src/c_fl_fill_dial.h b/src/c_fl_fill_dial.h deleted file mode 100644 index 39dced5..0000000 --- a/src/c_fl_fill_dial.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_FILL_DIAL_GUARD -#define FL_FILL_DIAL_GUARD - - - - -typedef void* FILL_DIAL; - - - - -extern "C" void fill_dial_set_draw_hook(FILL_DIAL v, void * d); -extern "C" void fl_fill_dial_draw(FILL_DIAL v); -extern "C" void fill_dial_set_handle_hook(FILL_DIAL v, void * h); -extern "C" int fl_fill_dial_handle(FILL_DIAL v, int e); - - - - -extern "C" FILL_DIAL new_fl_fill_dial(int x, int y, int w, int h, char* label); -extern "C" void free_fl_fill_dial(FILL_DIAL v); - - -#endif - diff --git a/src/c_fl_fill_slider.cpp b/src/c_fl_fill_slider.cpp deleted file mode 100644 index c066e07..0000000 --- a/src/c_fl_fill_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Fill_Slider.H> -#include "c_fl_fill_slider.h" -#include "c_fl_type.h" - - - - -class My_Fill_Slider : public Fl_Fill_Slider { - public: - using Fl_Fill_Slider::Fl_Fill_Slider; - friend void fill_slider_set_draw_hook(FILL_SLIDER s, void * d); - friend void fl_fill_slider_draw(FILL_SLIDER s); - friend void fill_slider_set_handle_hook(FILL_SLIDER s, void * h); - friend int fl_fill_slider_handle(FILL_SLIDER s, 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_Fill_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Fill_Slider::real_draw() { - Fl_Fill_Slider::draw(); -} - -int My_Fill_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Fill_Slider::real_handle(int e) { - return Fl_Fill_Slider::handle(e); -} - -void fill_slider_set_draw_hook(FILL_SLIDER s, void * d) { - reinterpret_cast<My_Fill_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_fill_slider_draw(FILL_SLIDER s) { - reinterpret_cast<My_Fill_Slider*>(s)->real_draw(); -} - -void fill_slider_set_handle_hook(FILL_SLIDER s, void * h) { - reinterpret_cast<My_Fill_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_fill_slider_handle(FILL_SLIDER s, int e) { - return reinterpret_cast<My_Fill_Slider*>(s)->real_handle(e); -} - - - - -FILL_SLIDER new_fl_fill_slider(int x, int y, int w, int h, char* label) { - My_Fill_Slider *s = new My_Fill_Slider(x, y, w, h, label); - return s; -} - -void free_fl_fill_slider(FILL_SLIDER s) { - delete reinterpret_cast<My_Fill_Slider*>(s); -} - - diff --git a/src/c_fl_fill_slider.h b/src/c_fl_fill_slider.h deleted file mode 100644 index ac9a125..0000000 --- a/src/c_fl_fill_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_FILL_SLIDER_GUARD -#define FL_FILL_SLIDER_GUARD - - - - -typedef void* FILL_SLIDER; - - - - -extern "C" void fill_slider_set_draw_hook(FILL_SLIDER s, void * d); -extern "C" void fl_fill_slider_draw(FILL_SLIDER s); -extern "C" void fill_slider_set_handle_hook(FILL_SLIDER s, void * h); -extern "C" int fl_fill_slider_handle(FILL_SLIDER s, int e); - - - - -extern "C" FILL_SLIDER new_fl_fill_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_fill_slider(FILL_SLIDER s); - - -#endif - diff --git a/src/c_fl_float_input.cpp b/src/c_fl_float_input.cpp deleted file mode 100644 index 8a8ab7c..0000000 --- a/src/c_fl_float_input.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Float_Input.H> -#include "c_fl_float_input.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Float_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Float_Input::real_draw() { - Fl_Float_Input::draw(); -} - -int My_Float_Input::handle(int e) { - return (*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<My_Float_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_float_input_draw(FLOAT_INPUT i) { - reinterpret_cast<My_Float_Input*>(i)->real_draw(); -} - -void float_input_set_handle_hook(FLOAT_INPUT i, void * h) { - reinterpret_cast<My_Float_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_float_input_handle(FLOAT_INPUT i, int e) { - return reinterpret_cast<My_Float_Input*>(i)->real_handle(e); -} - - - - -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 free_fl_float_input(FLOAT_INPUT i) { - delete reinterpret_cast<My_Float_Input*>(i); -} - - diff --git a/src/c_fl_float_input.h b/src/c_fl_float_input.h deleted file mode 100644 index a49d0f7..0000000 --- a/src/c_fl_float_input.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_FLOAT_INPUT_GUARD -#define FL_FLOAT_INPUT_GUARD - - - - -typedef void* FLOAT_INPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_gif_image.cpp b/src/c_fl_gif_image.cpp deleted file mode 100644 index ad923bd..0000000 --- a/src/c_fl_gif_image.cpp +++ /dev/null @@ -1,17 +0,0 @@ - - -#include <FL/Fl_GIF_Image.H> -#include "c_fl_gif_image.h" - - - - -GIF_IMAGE new_fl_gif_image(const char * f) { - Fl_GIF_Image *j = new Fl_GIF_Image(f); - return j; -} - -void free_fl_gif_image(GIF_IMAGE j) { - delete reinterpret_cast<Fl_GIF_Image*>(j); -} - diff --git a/src/c_fl_gif_image.h b/src/c_fl_gif_image.h deleted file mode 100644 index c193ca0..0000000 --- a/src/c_fl_gif_image.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_GIF_IMAGE_GUARD -#define FL_GIF_IMAGE_GUARD - - - - -typedef void* GIF_IMAGE; - - - - -extern "C" GIF_IMAGE new_fl_gif_image(const char * f); -extern "C" void free_fl_gif_image(GIF_IMAGE j); - - -#endif - diff --git a/src/c_fl_gl_window.cpp b/src/c_fl_gl_window.cpp deleted file mode 100644 index 9b1766d..0000000 --- a/src/c_fl_gl_window.cpp +++ /dev/null @@ -1,182 +0,0 @@ - - -#include <FL/Fl_Gl_Window.H> -#include "c_fl_gl_window.h" -#include "c_fl_type.h" - - - - -class My_Gl_Window : public Fl_Gl_Window { - public: - using Fl_Gl_Window::Fl_Gl_Window; - friend void gl_window_set_draw_hook(GLWINDOW n, void * d); - friend void fl_gl_window_draw(GLWINDOW n); - friend void gl_window_set_handle_hook(GLWINDOW n, void * h); - friend int fl_gl_window_handle(GLWINDOW n, 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_Gl_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Gl_Window::real_draw() { - Fl_Gl_Window::draw(); -} - -int My_Gl_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Gl_Window::real_handle(int e) { - return Fl_Gl_Window::handle(e); -} - -void gl_window_set_draw_hook(GLWINDOW n, void * d) { - reinterpret_cast<My_Gl_Window*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_gl_window_draw(GLWINDOW n) { - reinterpret_cast<My_Gl_Window*>(n)->real_draw(); -} - -void gl_window_set_handle_hook(GLWINDOW n, void * h) { - reinterpret_cast<My_Gl_Window*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_gl_window_handle(GLWINDOW n, int e) { - return reinterpret_cast<My_Gl_Window*>(n)->real_handle(e); -} - - - - -GLWINDOW new_fl_gl_window(int x, int y, int w, int h, char* label) { - My_Gl_Window *gw = new My_Gl_Window(x, y, w, h, label); - return gw; -} - -GLWINDOW new_fl_gl_window2(int w, int h, char* label) { - My_Gl_Window *gw = new My_Gl_Window(w, h, label); - return gw; -} - -void free_fl_gl_window(GLWINDOW w) { - delete reinterpret_cast<My_Gl_Window*>(w); -} - - - - -void fl_gl_window_show(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->show(); -} - -void fl_gl_window_hide(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->hide(); -} - -void fl_gl_window_hide_overlay(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->hide_overlay(); -} - -void fl_gl_window_flush(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->flush(); -} - - - - -int fl_gl_window_pixel_h(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->pixel_h(); -} - -int fl_gl_window_pixel_w(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->pixel_w(); -} - -float fl_gl_window_pixels_per_unit(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->pixels_per_unit(); -} - - - - -unsigned int fl_gl_window_get_mode(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->mode(); -} - -void fl_gl_window_set_mode(GLWINDOW w, unsigned int a) { - reinterpret_cast<Fl_Gl_Window*>(w)->mode(a); -} - -int fl_gl_window_static_can_do(unsigned int m) { - return Fl_Gl_Window::can_do(m); -} - -int fl_gl_window_can_do(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->can_do(); -} - -int fl_gl_window_can_do_overlay(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->can_do_overlay(); -} - - - - -void * fl_gl_window_get_context(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->context(); -} - -void fl_gl_window_set_context(GLWINDOW w, void * con, int des) { - reinterpret_cast<Fl_Gl_Window*>(w)->context(con, des); -} - -char fl_gl_window_context_valid(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->context_valid(); -} - -void fl_gl_window_set_context_valid(GLWINDOW w, char v) { - reinterpret_cast<Fl_Gl_Window*>(w)->context_valid(v); -} - -char fl_gl_window_valid(GLWINDOW w) { - return reinterpret_cast<Fl_Gl_Window*>(w)->valid(); -} - -void fl_gl_window_set_valid(GLWINDOW w, char v) { - reinterpret_cast<Fl_Gl_Window*>(w)->valid(v); -} - -void fl_gl_window_make_current(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->make_current(); -} - -void fl_gl_window_make_overlay_current(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->make_overlay_current(); -} - - - - -void fl_gl_window_ortho(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->ortho(); -} - -void fl_gl_window_redraw_overlay(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->redraw_overlay(); -} - -void fl_gl_window_swap_buffers(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->swap_buffers(); -} - - diff --git a/src/c_fl_gl_window.h b/src/c_fl_gl_window.h deleted file mode 100644 index 155c2ef..0000000 --- a/src/c_fl_gl_window.h +++ /dev/null @@ -1,63 +0,0 @@ - - -#ifndef FL_GL_WINDOW_GUARD -#define FL_GL_WINDOW_GUARD - - - - -typedef void* GLWINDOW; - - - - -extern "C" void gl_window_set_draw_hook(GLWINDOW n, void * d); -extern "C" void fl_gl_window_draw(GLWINDOW n); -extern "C" void gl_window_set_handle_hook(GLWINDOW n, void * h); -extern "C" int fl_gl_window_handle(GLWINDOW n, int e); - - - - -extern "C" GLWINDOW new_fl_gl_window(int x, int y, int w, int h, char* label); -extern "C" GLWINDOW new_fl_gl_window2(int w, int h, char* label); -extern "C" void free_fl_gl_window(GLWINDOW w); - - - - -extern "C" void fl_gl_window_show(GLWINDOW w); -extern "C" void fl_gl_window_hide(GLWINDOW w); -extern "C" void fl_gl_window_hide_overlay(GLWINDOW w); -extern "C" void fl_gl_window_flush(GLWINDOW w); - - -extern "C" int fl_gl_window_pixel_h(GLWINDOW w); -extern "C" int fl_gl_window_pixel_w(GLWINDOW w); -extern "C" float fl_gl_window_pixels_per_unit(GLWINDOW w); - - -extern "C" unsigned int fl_gl_window_get_mode(GLWINDOW w); -extern "C" void fl_gl_window_set_mode(GLWINDOW w, unsigned int a); -extern "C" int fl_gl_window_static_can_do(unsigned int m); -extern "C" int fl_gl_window_can_do(GLWINDOW w); -extern "C" int fl_gl_window_can_do_overlay(GLWINDOW w); - - -extern "C" void * fl_gl_window_get_context(GLWINDOW w); -extern "C" void fl_gl_window_set_context(GLWINDOW w, void * con, int des); -extern "C" char fl_gl_window_context_valid(GLWINDOW w); -extern "C" void fl_gl_window_set_context_valid(GLWINDOW w, char v); -extern "C" char fl_gl_window_valid(GLWINDOW w); -extern "C" void fl_gl_window_set_valid(GLWINDOW w, char v); -extern "C" void fl_gl_window_make_current(GLWINDOW w); -extern "C" void fl_gl_window_make_overlay_current(GLWINDOW w); - - -extern "C" void fl_gl_window_ortho(GLWINDOW w); -extern "C" void fl_gl_window_redraw_overlay(GLWINDOW w); -extern "C" void fl_gl_window_swap_buffers(GLWINDOW w); - - -#endif - diff --git a/src/c_fl_graphics_driver.cpp b/src/c_fl_graphics_driver.cpp deleted file mode 100644 index 73112b4..0000000 --- a/src/c_fl_graphics_driver.cpp +++ /dev/null @@ -1,58 +0,0 @@ - - -#include <FL/Fl_Device.H> -#include <FL/Fl_Image.H> -#include "c_fl_graphics_driver.h" - - - - -unsigned int fl_graphics_driver_color(GRAPHICS_DRIVER g) { - return reinterpret_cast<Fl_Graphics_Driver*>(g)->color(); -} - - - - -int fl_graphics_driver_descent(GRAPHICS_DRIVER g) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::descent(); -} - -int fl_graphics_driver_height(GRAPHICS_DRIVER g) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::height(); -} - -double fl_graphics_driver_width(GRAPHICS_DRIVER g, unsigned int c) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::width(c); -} - -double fl_graphics_driver_width2(GRAPHICS_DRIVER g, const char * s, int l) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::width(s,l); -} - -int fl_graphics_driver_get_font(GRAPHICS_DRIVER g) { - return reinterpret_cast<Fl_Graphics_Driver*>(g)->font(); -} - -int fl_graphics_driver_size(GRAPHICS_DRIVER g) { - return reinterpret_cast<Fl_Graphics_Driver*>(g)->size(); -} - -void fl_graphics_driver_set_font(GRAPHICS_DRIVER g, int f, int s) { - // virtual so disable dispatch - reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::font(f,s); -} - - - - -void fl_graphics_driver_draw_scaled(GRAPHICS_DRIVER g, void * i, int x, int y, int w, int h) { - // virtual so disable dispatch - reinterpret_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::draw_scaled(reinterpret_cast<Fl_Image*>(i),x,y,w,h); -} - - diff --git a/src/c_fl_graphics_driver.h b/src/c_fl_graphics_driver.h deleted file mode 100644 index d255400..0000000 --- a/src/c_fl_graphics_driver.h +++ /dev/null @@ -1,30 +0,0 @@ - - -#ifndef FL_GRAPHICS_DRIVER_GUARD -#define FL_GRAPHICS_DRIVER_GUARD - - - - -typedef void* GRAPHICS_DRIVER; - - - - -extern "C" unsigned int fl_graphics_driver_color(GRAPHICS_DRIVER g); - - -extern "C" int fl_graphics_driver_descent(GRAPHICS_DRIVER g); -extern "C" int fl_graphics_driver_height(GRAPHICS_DRIVER g); -extern "C" double fl_graphics_driver_width(GRAPHICS_DRIVER g, unsigned int c); -extern "C" double fl_graphics_driver_width2(GRAPHICS_DRIVER g, const char * s, int l); -extern "C" int fl_graphics_driver_get_font(GRAPHICS_DRIVER g); -extern "C" int fl_graphics_driver_size(GRAPHICS_DRIVER g); -extern "C" void fl_graphics_driver_set_font(GRAPHICS_DRIVER g, int f, int s); - - -extern "C" void fl_graphics_driver_draw_scaled(GRAPHICS_DRIVER g, void * i, int x, int y, int w, int h); - - -#endif - diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp deleted file mode 100644 index b3b7a68..0000000 --- a/src/c_fl_group.cpp +++ /dev/null @@ -1,155 +0,0 @@ - - -#include <FL/Fl_Group.H> -#include <FL/Fl_Widget.H> -#include "c_fl_group.h" -#include "c_fl_widget.h" -#include "c_fl_type.h" - - - - -class My_Group : public Fl_Group { - public: - using Fl_Group::Fl_Group; - friend void group_set_draw_hook(GROUP g, void * d); - friend void fl_group_draw(GROUP g); - friend void group_set_handle_hook(GROUP g, void * h); - friend int fl_group_handle(GROUP g, 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_Group::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Group::real_draw() { - Fl_Group::draw(); -} - -int My_Group::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Group::real_handle(int e) { - return Fl_Group::handle(e); -} - -void group_set_draw_hook(GROUP g, void * d) { - reinterpret_cast<My_Group*>(g)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_group_draw(GROUP g) { - reinterpret_cast<My_Group*>(g)->real_draw(); -} - -void group_set_handle_hook(GROUP g, void * h) { - reinterpret_cast<My_Group*>(g)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_group_handle(GROUP g, int e) { - return reinterpret_cast<My_Group*>(g)->real_handle(e); -} - - - - -GROUP new_fl_group(int x, int y, int w, int h, char* label) { - My_Group *g = new My_Group(x, y, w, h, label); - return g; -} - -void free_fl_group(GROUP g) { - delete reinterpret_cast<My_Group*>(g); -} - - - - -void fl_group_end(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->end(); -} - - - - -void fl_group_add(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); -} - -void fl_group_insert(GROUP g, WIDGET item, int place) { - reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); -} - -void fl_group_insert2(GROUP g, WIDGET item, WIDGET before) { - reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), reinterpret_cast<Fl_Widget*>(before)); -} - -void fl_group_remove(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item)); -} - -void fl_group_remove2(GROUP g, int place) { - reinterpret_cast<Fl_Group*>(g)->remove(place); -} - - - - -void * fl_group_child(GROUP g, int place) { - return reinterpret_cast<Fl_Group*>(g)->child(place); -} - -int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); -} - -int fl_group_children(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->children(); -} - - - - -//unsigned int flt_group_get_clip_children(GROUP g) { -// return reinterpret_cast<Fl_Group*>(g)->clip_children(); -//} - - -//void fl_group_set_clip_children(GROUP g, int c) { -// reinterpret_cast<Fl_Group*>(g)->clip_children(c); -//} - - - - -void * fl_group_get_resizable(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->resizable(); -} - -void fl_group_set_resizable(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item)); -} - -void fl_group_init_sizes(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->init_sizes(); -} - - - - -void * fl_group_get_current() { - return Fl_Group::current(); -} - -void fl_group_set_current(GROUP g) { - Fl_Group::current(reinterpret_cast<Fl_Group*>(g)); -} - - diff --git a/src/c_fl_group.h b/src/c_fl_group.h deleted file mode 100644 index 6e13503..0000000 --- a/src/c_fl_group.h +++ /dev/null @@ -1,59 +0,0 @@ - - -#ifndef FL_GROUP_GUARD -#define FL_GROUP_GUARD - -#include "c_fl_widget.h" - - - - -typedef void* GROUP; - - - - -extern "C" void group_set_draw_hook(GROUP g, void * d); -extern "C" void fl_group_draw(GROUP g); -extern "C" void group_set_handle_hook(GROUP g, void * h); -extern "C" int fl_group_handle(GROUP g, int e); - - - - -extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); -extern "C" void free_fl_group(GROUP g); - - - - -extern "C" void fl_group_end(GROUP g); - - -extern "C" void fl_group_add(GROUP g, WIDGET item); -extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); -extern "C" void fl_group_insert2(GROUP g, WIDGET item, WIDGET before); -extern "C" void fl_group_remove(GROUP g, WIDGET item); -extern "C" void fl_group_remove2(GROUP g, int place); - - -extern "C" void * fl_group_child(GROUP g, int place); -extern "C" int fl_group_find(GROUP g, WIDGET item); -extern "C" int fl_group_children(GROUP g); - - -//extern "C" unsigned int fl_group_get_clip_children(GROUP g); -//extern "C" void fl_group_set_clip_children(GROUP g, int c); - - -extern "C" void * fl_group_get_resizable(GROUP g); -extern "C" void fl_group_set_resizable(GROUP g, WIDGET item); -extern "C" void fl_group_init_sizes(GROUP g); - - -extern "C" void * fl_group_get_current(); -extern "C" void fl_group_set_current(GROUP g); - - -#endif - diff --git a/src/c_fl_hor_fill_slider.cpp b/src/c_fl_hor_fill_slider.cpp deleted file mode 100644 index c3b0582..0000000 --- a/src/c_fl_hor_fill_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Hor_Fill_Slider.H> -#include "c_fl_hor_fill_slider.h" -#include "c_fl_type.h" - - - - -class My_Hor_Fill_Slider : public Fl_Hor_Fill_Slider { - public: - using Fl_Hor_Fill_Slider::Fl_Hor_Fill_Slider; - friend void hor_fill_slider_set_draw_hook(HOR_FILL_SLIDER s, void * d); - friend void fl_hor_fill_slider_draw(HOR_FILL_SLIDER s); - friend void hor_fill_slider_set_handle_hook(HOR_FILL_SLIDER s, void * h); - friend int fl_hor_fill_slider_handle(HOR_FILL_SLIDER s, 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_Hor_Fill_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Hor_Fill_Slider::real_draw() { - Fl_Hor_Fill_Slider::draw(); -} - -int My_Hor_Fill_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Hor_Fill_Slider::real_handle(int e) { - return Fl_Hor_Fill_Slider::handle(e); -} - -void hor_fill_slider_set_draw_hook(HOR_FILL_SLIDER s, void * d) { - reinterpret_cast<My_Hor_Fill_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_hor_fill_slider_draw(HOR_FILL_SLIDER s) { - reinterpret_cast<My_Hor_Fill_Slider*>(s)->real_draw(); -} - -void hor_fill_slider_set_handle_hook(HOR_FILL_SLIDER s, void * h) { - reinterpret_cast<My_Hor_Fill_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_hor_fill_slider_handle(HOR_FILL_SLIDER s, int e) { - return reinterpret_cast<My_Hor_Fill_Slider*>(s)->real_handle(e); -} - - - - -HOR_FILL_SLIDER new_fl_hor_fill_slider(int x, int y, int w, int h, char* label) { - My_Hor_Fill_Slider *s = new My_Hor_Fill_Slider(x, y, w, h, label); - return s; -} - -void free_fl_hor_fill_slider(HOR_FILL_SLIDER s) { - delete reinterpret_cast<My_Hor_Fill_Slider*>(s); -} - - diff --git a/src/c_fl_hor_fill_slider.h b/src/c_fl_hor_fill_slider.h deleted file mode 100644 index 95ac72f..0000000 --- a/src/c_fl_hor_fill_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_HOR_FILL_SLIDER_GUARD -#define FL_HOR_FILL_SLIDER_GUARD - - - - -typedef void* HOR_FILL_SLIDER; - - - - -extern "C" void hor_fill_slider_set_draw_hook(HOR_FILL_SLIDER s, void * d); -extern "C" void fl_hor_fill_slider_draw(HOR_FILL_SLIDER s); -extern "C" void hor_fill_slider_set_handle_hook(HOR_FILL_SLIDER s, void * h); -extern "C" int fl_hor_fill_slider_handle(HOR_FILL_SLIDER s, int e); - - - - -extern "C" HOR_FILL_SLIDER new_fl_hor_fill_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_fill_slider(HOR_FILL_SLIDER s); - - -#endif - diff --git a/src/c_fl_hor_nice_slider.cpp b/src/c_fl_hor_nice_slider.cpp deleted file mode 100644 index d17d700..0000000 --- a/src/c_fl_hor_nice_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Hor_Nice_Slider.H> -#include "c_fl_hor_nice_slider.h" -#include "c_fl_type.h" - - - - -class My_Hor_Nice_Slider : public Fl_Hor_Nice_Slider { - public: - using Fl_Hor_Nice_Slider::Fl_Hor_Nice_Slider; - friend void hor_nice_slider_set_draw_hook(HOR_NICE_SLIDER s, void * d); - friend void fl_hor_nice_slider_draw(HOR_NICE_SLIDER s); - friend void hor_nice_slider_set_handle_hook(HOR_NICE_SLIDER s, void * h); - friend int fl_hor_nice_slider_handle(HOR_NICE_SLIDER s, 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_Hor_Nice_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Hor_Nice_Slider::real_draw() { - Fl_Hor_Nice_Slider::draw(); -} - -int My_Hor_Nice_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Hor_Nice_Slider::real_handle(int e) { - return Fl_Hor_Nice_Slider::handle(e); -} - -void hor_nice_slider_set_draw_hook(HOR_NICE_SLIDER s, void * d) { - reinterpret_cast<My_Hor_Nice_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_hor_nice_slider_draw(HOR_NICE_SLIDER s) { - reinterpret_cast<My_Hor_Nice_Slider*>(s)->real_draw(); -} - -void hor_nice_slider_set_handle_hook(HOR_NICE_SLIDER s, void * h) { - reinterpret_cast<My_Hor_Nice_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_hor_nice_slider_handle(HOR_NICE_SLIDER s, int e) { - return reinterpret_cast<My_Hor_Nice_Slider*>(s)->real_handle(e); -} - - - - -HOR_NICE_SLIDER new_fl_hor_nice_slider(int x, int y, int w, int h, char* label) { - My_Hor_Nice_Slider *s = new My_Hor_Nice_Slider(x, y, w, h, label); - return s; -} - -void free_fl_hor_nice_slider(HOR_NICE_SLIDER s) { - delete reinterpret_cast<My_Hor_Nice_Slider*>(s); -} - - diff --git a/src/c_fl_hor_nice_slider.h b/src/c_fl_hor_nice_slider.h deleted file mode 100644 index 990fc76..0000000 --- a/src/c_fl_hor_nice_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_HOR_NICE_SLIDER_GUARD -#define FL_HOR_NICE_SLIDER_GUARD - - - - -typedef void* HOR_NICE_SLIDER; - - - - -extern "C" void hor_nice_slider_set_draw_hook(HOR_NICE_SLIDER s, void * d); -extern "C" void fl_hor_nice_slider_draw(HOR_NICE_SLIDER s); -extern "C" void hor_nice_slider_set_handle_hook(HOR_NICE_SLIDER s, void * h); -extern "C" int fl_hor_nice_slider_handle(HOR_NICE_SLIDER s, int e); - - - - -extern "C" HOR_NICE_SLIDER new_fl_hor_nice_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_nice_slider(HOR_NICE_SLIDER s); - - -#endif - diff --git a/src/c_fl_hor_value_slider.cpp b/src/c_fl_hor_value_slider.cpp deleted file mode 100644 index fa3305c..0000000 --- a/src/c_fl_hor_value_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Hor_Value_Slider.H> -#include "c_fl_hor_value_slider.h" -#include "c_fl_type.h" - - - - -class My_Hor_Value_Slider : public Fl_Hor_Value_Slider { - public: - using Fl_Hor_Value_Slider::Fl_Hor_Value_Slider; - friend void hor_value_slider_set_draw_hook(HOR_VALUE_SLIDER s, void * d); - friend void fl_hor_value_slider_draw(HOR_VALUE_SLIDER s); - friend void hor_value_slider_set_handle_hook(HOR_VALUE_SLIDER s, void * h); - friend int fl_hor_value_slider_handle(HOR_VALUE_SLIDER s, 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_Hor_Value_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Hor_Value_Slider::real_draw() { - Fl_Hor_Value_Slider::draw(); -} - -int My_Hor_Value_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Hor_Value_Slider::real_handle(int e) { - return Fl_Hor_Value_Slider::handle(e); -} - -void hor_value_slider_set_draw_hook(HOR_VALUE_SLIDER s, void * d) { - reinterpret_cast<My_Hor_Value_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_hor_value_slider_draw(HOR_VALUE_SLIDER s) { - reinterpret_cast<My_Hor_Value_Slider*>(s)->real_draw(); -} - -void hor_value_slider_set_handle_hook(HOR_VALUE_SLIDER s, void * h) { - reinterpret_cast<My_Hor_Value_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_hor_value_slider_handle(HOR_VALUE_SLIDER s, int e) { - return reinterpret_cast<My_Hor_Value_Slider*>(s)->real_handle(e); -} - - - - -HOR_VALUE_SLIDER new_fl_hor_value_slider(int x, int y, int w, int h, char* label) { - My_Hor_Value_Slider *s = new My_Hor_Value_Slider(x, y, w, h, label); - return s; -} - -void free_fl_hor_value_slider(HOR_VALUE_SLIDER s) { - delete reinterpret_cast<My_Hor_Value_Slider*>(s); -} - - diff --git a/src/c_fl_hor_value_slider.h b/src/c_fl_hor_value_slider.h deleted file mode 100644 index 7e682f5..0000000 --- a/src/c_fl_hor_value_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_HOR_VALUE_SLIDER_GUARD -#define FL_HOR_VALUE_SLIDER_GUARD - - - - -typedef void* HOR_VALUE_SLIDER; - - - - -extern "C" void hor_value_slider_set_draw_hook(HOR_VALUE_SLIDER s, void * d); -extern "C" void fl_hor_value_slider_draw(HOR_VALUE_SLIDER s); -extern "C" void hor_value_slider_set_handle_hook(HOR_VALUE_SLIDER s, void * h); -extern "C" int fl_hor_value_slider_handle(HOR_VALUE_SLIDER s, int e); - - - - -extern "C" HOR_VALUE_SLIDER new_fl_hor_value_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_value_slider(HOR_VALUE_SLIDER s); - - -#endif - diff --git a/src/c_fl_horizontal_slider.cpp b/src/c_fl_horizontal_slider.cpp deleted file mode 100644 index e690b17..0000000 --- a/src/c_fl_horizontal_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Hor_Slider.H> -#include "c_fl_horizontal_slider.h" -#include "c_fl_type.h" - - - - -class My_Horizontal_Slider : public Fl_Hor_Slider { - public: - using Fl_Hor_Slider::Fl_Hor_Slider; - friend void horizontal_slider_set_draw_hook(HORIZONTAL_SLIDER s, void * d); - friend void fl_horizontal_slider_draw(HORIZONTAL_SLIDER s); - friend void horizontal_slider_set_handle_hook(HORIZONTAL_SLIDER s, void * h); - friend int fl_horizontal_slider_handle(HORIZONTAL_SLIDER s, 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_Horizontal_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Horizontal_Slider::real_draw() { - Fl_Hor_Slider::draw(); -} - -int My_Horizontal_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Horizontal_Slider::real_handle(int e) { - return Fl_Hor_Slider::handle(e); -} - -void horizontal_slider_set_draw_hook(HORIZONTAL_SLIDER s, void * d) { - reinterpret_cast<My_Horizontal_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_horizontal_slider_draw(HORIZONTAL_SLIDER s) { - reinterpret_cast<My_Horizontal_Slider*>(s)->real_draw(); -} - -void horizontal_slider_set_handle_hook(HORIZONTAL_SLIDER s, void * h) { - reinterpret_cast<My_Horizontal_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_horizontal_slider_handle(HORIZONTAL_SLIDER s, int e) { - return reinterpret_cast<My_Horizontal_Slider*>(s)->real_handle(e); -} - - - - -HORIZONTAL_SLIDER new_fl_horizontal_slider(int x, int y, int w, int h, char* label) { - My_Horizontal_Slider *s = new My_Horizontal_Slider(x, y, w, h, label); - return s; -} - -void free_fl_horizontal_slider(HORIZONTAL_SLIDER s) { - delete reinterpret_cast<My_Horizontal_Slider*>(s); -} - - diff --git a/src/c_fl_horizontal_slider.h b/src/c_fl_horizontal_slider.h deleted file mode 100644 index 13ba6e2..0000000 --- a/src/c_fl_horizontal_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_HORIZONTAL_SLIDER_GUARD -#define FL_HORIZONTAL_SLIDER_GUARD - - - - -typedef void* HORIZONTAL_SLIDER; - - - - -extern "C" void horizontal_slider_set_draw_hook(HORIZONTAL_SLIDER s, void * d); -extern "C" void fl_horizontal_slider_draw(HORIZONTAL_SLIDER s); -extern "C" void horizontal_slider_set_handle_hook(HORIZONTAL_SLIDER s, void * h); -extern "C" int fl_horizontal_slider_handle(HORIZONTAL_SLIDER s, int e); - - - - -extern "C" HORIZONTAL_SLIDER new_fl_horizontal_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_horizontal_slider(HORIZONTAL_SLIDER s); - - -#endif - diff --git a/src/c_fl_image.cpp b/src/c_fl_image.cpp deleted file mode 100644 index 6e42280..0000000 --- a/src/c_fl_image.cpp +++ /dev/null @@ -1,138 +0,0 @@ - - -#include <FL/Fl_Image.H> -#include "c_fl_image.h" - - - - -class My_Image : public Fl_Image { - public: - using Fl_Image::Fl_Image; - friend void fl_image_draw_empty(IMAGE i, int x, int y); -}; - - - - -IMAGE new_fl_image(int w, int h, int d) { - My_Image *i = new My_Image(w, h, d); - return i; -} - -void free_fl_image(IMAGE i) { - delete reinterpret_cast<My_Image*>(i); -} - - - - -int fl_image_get_rgb_scaling() { - return Fl_Image::RGB_scaling(); -} - -void fl_image_set_rgb_scaling(int t) { - Fl_Image::RGB_scaling(static_cast<Fl_RGB_Scaling>(t)); -} - -IMAGE fl_image_copy(IMAGE i, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Image*>(i)->Fl_Image::copy(w, h); -} - -IMAGE fl_image_copy2(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->copy(); -} - - - - -void fl_image_color_average(IMAGE i, int c, float b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Image*>(i)->Fl_Image::color_average(c, b); -} - -void fl_image_desaturate(IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_Image*>(i)->Fl_Image::desaturate(); -} - - - - -void fl_image_inactive(IMAGE i) { - reinterpret_cast<Fl_Image*>(i)->inactive(); -} - -int fl_image_fail(IMAGE i) { - switch (reinterpret_cast<Fl_Image*>(i)->fail()) { - case Fl_Image::ERR_NO_IMAGE: - return 1; - case Fl_Image::ERR_FILE_ACCESS: - return 2; - case Fl_Image::ERR_FORMAT: - return 3; - default: - return 0; - } -} - -void fl_image_uncache(IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_Image*>(i)->Fl_Image::uncache(); -} - - - - -int fl_image_w(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->w(); -} - -int fl_image_h(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->h(); -} - -int fl_image_d(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->d(); -} - -int fl_image_ld(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->ld(); -} - -int fl_image_count(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->count(); -} - - - - -const void * fl_image_data(IMAGE i) { - return reinterpret_cast<Fl_Image*>(i)->data(); -} - -char fl_image_get_pixel(char *c, int off) { - return c[off]; -} - -void fl_image_set_pixel(char *c, int off, char val) { - c[off] = val; -} - - - - -void fl_image_draw(IMAGE i, int x, int y) { - reinterpret_cast<Fl_Image*>(i)->draw(x, y); -} - -void fl_image_draw2(IMAGE i, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Image*>(i)->Fl_Image::draw(x, y, w, h, cx, cy); -} - -void fl_image_draw_empty(IMAGE i, int x, int y) { - reinterpret_cast<My_Image*>(i)->draw_empty(x, y); -} - diff --git a/src/c_fl_image.h b/src/c_fl_image.h deleted file mode 100644 index 2915ab7..0000000 --- a/src/c_fl_image.h +++ /dev/null @@ -1,53 +0,0 @@ - - -#ifndef FL_IMAGE_GUARD -#define FL_IMAGE_GUARD - - - - -typedef void* IMAGE; - - - - -extern "C" IMAGE new_fl_image(int w, int h, int d); -extern "C" void free_fl_image(IMAGE i); - - -extern "C" int fl_image_get_rgb_scaling(); -extern "C" void fl_image_set_rgb_scaling(int t); -extern "C" IMAGE fl_image_copy(IMAGE i, int w, int h); -extern "C" IMAGE fl_image_copy2(IMAGE i); - - - - -extern "C" void fl_image_color_average(IMAGE i, int c, float b); -extern "C" void fl_image_desaturate(IMAGE i); - - -extern "C" void fl_image_inactive(IMAGE i); -extern "C" int fl_image_fail(IMAGE i); -extern "C" void fl_image_uncache(IMAGE i); - - -extern "C" int fl_image_w(IMAGE i); -extern "C" int fl_image_h(IMAGE i); -extern "C" int fl_image_d(IMAGE i); -extern "C" int fl_image_ld(IMAGE i); -extern "C" int fl_image_count(IMAGE i); - - -extern "C" const void * fl_image_data(IMAGE i); -extern "C" char fl_image_get_pixel(char *c, int off); -extern "C" void fl_image_set_pixel(char *c, int off, char val); - - -extern "C" void fl_image_draw(IMAGE i, int x, int y); -extern "C" void fl_image_draw2(IMAGE i, int x, int y, int w, int h, int cx, int cy); -extern "C" void fl_image_draw_empty(IMAGE i, int x, int y); - - -#endif - diff --git a/src/c_fl_image_surface.cpp b/src/c_fl_image_surface.cpp deleted file mode 100644 index 305e3cc..0000000 --- a/src/c_fl_image_surface.cpp +++ /dev/null @@ -1,49 +0,0 @@ - - -#include <FL/Fl_Image_Surface.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_image_surface.h" - - - - -IMAGE_SURFACE new_fl_image_surface(int w, int h, int r) { - Fl_Image_Surface *s = new Fl_Image_Surface(w,h,r); - return s; -} - -void free_fl_image_surface(IMAGE_SURFACE s) { - delete reinterpret_cast<Fl_Image_Surface*>(s); -} - - - - -void fl_image_surface_draw(IMAGE_SURFACE s, void * w, int dx, int dy) { - reinterpret_cast<Fl_Image_Surface*>(s)->draw(reinterpret_cast<Fl_Widget*>(w),dx,dy); -} - -void fl_image_surface_draw_decorated_window(IMAGE_SURFACE s, void * w, int dx, int dy) { - reinterpret_cast<Fl_Image_Surface*>(s)->draw_decorated_window(reinterpret_cast<Fl_Window*>(w),dx,dy); -} - - - - -void * fl_image_surface_image(IMAGE_SURFACE s) { - return reinterpret_cast<Fl_Image_Surface*>(s)->image(); -} - -void * fl_image_surface_highres_image(IMAGE_SURFACE s) { - return reinterpret_cast<Fl_Image_Surface*>(s)->highres_image(); -} - - - - -void fl_image_surface_set_current(IMAGE_SURFACE s) { - reinterpret_cast<Fl_Image_Surface*>(s)->set_current(); -} - - diff --git a/src/c_fl_image_surface.h b/src/c_fl_image_surface.h deleted file mode 100644 index 0ad97a3..0000000 --- a/src/c_fl_image_surface.h +++ /dev/null @@ -1,32 +0,0 @@ - - -#ifndef FL_IMAGE_SURFACE_GUARD -#define FL_IMAGE_SURFACE_GUARD - - - - -typedef void* IMAGE_SURFACE; - - - - -extern "C" IMAGE_SURFACE new_fl_image_surface(int w, int h, int r); -extern "C" void free_fl_image_surface(IMAGE_SURFACE s); - - - - -extern "C" void fl_image_surface_draw(IMAGE_SURFACE s, void * w, int dx, int dy); -extern "C" void fl_image_surface_draw_decorated_window(IMAGE_SURFACE s, void * w, int dx, int dy); - - -extern "C" void * fl_image_surface_image(IMAGE_SURFACE s); -extern "C" void * fl_image_surface_highres_image(IMAGE_SURFACE s); - - -extern "C" void fl_image_surface_set_current(IMAGE_SURFACE s); - - -#endif - diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp deleted file mode 100644 index 84bbc90..0000000 --- a/src/c_fl_input.cpp +++ /dev/null @@ -1,239 +0,0 @@ - - -#include <FL/Fl_Input.H> -#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<My_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_input_draw(INPUT i) { - reinterpret_cast<My_Input*>(i)->real_draw(); -} - -void input_set_handle_hook(INPUT i, void * h) { - reinterpret_cast<My_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_input_handle(INPUT i, int e) { - return reinterpret_cast<My_Input*>(i)->real_handle(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<My_Input*>(i); -} - - - - -int fl_input_copy(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->copy(1); -} - -int fl_input_cut(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->cut(); -} - -int fl_input_cut2(INPUT i, int b) { - return reinterpret_cast<Fl_Input*>(i)->cut(b); -} - -int fl_input_cut3(INPUT i, int a, int b) { - return reinterpret_cast<Fl_Input*>(i)->cut(a,b); -} - -int fl_input_copy_cuts(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->copy_cuts(); -} - -int fl_input_undo(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->undo(); -} - - - - -int fl_input_get_readonly(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->readonly(); -} - -void fl_input_set_readonly(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->readonly(t); -} - -int fl_input_get_tab_nav(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->tab_nav(); -} - -void fl_input_set_tab_nav(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->tab_nav(t); -} - -int fl_input_get_wrap(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->wrap(); -} - -void fl_input_set_wrap(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->wrap(t); -} - - - - -int fl_input_get_input_type(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->input_type(); -} - -void fl_input_set_input_type(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->input_type(t); -} - -unsigned long fl_input_get_shortcut(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->shortcut(); -} - -void fl_input_set_shortcut(INPUT i, unsigned long t) { - reinterpret_cast<Fl_Input*>(i)->shortcut(t); -} - -int fl_input_get_mark(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->mark(); -} - -int fl_input_set_mark(INPUT i, int t) { - return reinterpret_cast<Fl_Input*>(i)->mark(t); -} - -int fl_input_get_position(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->position(); -} - -int fl_input_set_position(INPUT i, int t) { - return reinterpret_cast<Fl_Input*>(i)->position(t); -} - - - - -unsigned int fl_input_index(INPUT i, int p) { - return reinterpret_cast<Fl_Input*>(i)->index(p); -} - -int fl_input_insert(INPUT i, const char * s, int l) { - return reinterpret_cast<Fl_Input*>(i)->insert(s,l); -} - -int fl_input_replace(INPUT i, int b, int e, const char * s, int l) { - return reinterpret_cast<Fl_Input*>(i)->replace(b,e,s,l); -} - -const char * fl_input_get_value(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->value(); -} - -void fl_input_set_value(INPUT i, char * s, int len) { - reinterpret_cast<Fl_Input*>(i)->value(s,len); -} - - - - -int fl_input_get_maximum_size(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->maximum_size(); -} - -void fl_input_set_maximum_size(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->maximum_size(t); -} - -int fl_input_get_size(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->size(); -} - - - - -unsigned int fl_input_get_cursor_color(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->cursor_color(); -} - -void fl_input_set_cursor_color(INPUT i, unsigned int t) { - reinterpret_cast<Fl_Input*>(i)->cursor_color(t); -} - -unsigned int fl_input_get_textcolor(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->textcolor(); -} - -void fl_input_set_textcolor(INPUT i, unsigned int t) { - reinterpret_cast<Fl_Input*>(i)->textcolor(t); -} - -int fl_input_get_textfont(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->textfont(); -} - -void fl_input_set_textfont(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->textfont(t); -} - -int fl_input_get_textsize(INPUT i) { - return reinterpret_cast<Fl_Input*>(i)->textsize(); -} - -void fl_input_set_textsize(INPUT i, int t) { - reinterpret_cast<Fl_Input*>(i)->textsize(t); -} - - - - -void fl_input_set_size(INPUT i, int w, int h) { - reinterpret_cast<Fl_Input*>(i)->size(w,h); -} - - diff --git a/src/c_fl_input.h b/src/c_fl_input.h deleted file mode 100644 index 38bfc7e..0000000 --- a/src/c_fl_input.h +++ /dev/null @@ -1,80 +0,0 @@ - - -#ifndef FL_INPUT_GUARD -#define FL_INPUT_GUARD - - - - -typedef void* INPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_input_choice.cpp b/src/c_fl_input_choice.cpp deleted file mode 100644 index a48a4bc..0000000 --- a/src/c_fl_input_choice.cpp +++ /dev/null @@ -1,147 +0,0 @@ - - -#include <FL/Fl_Input_Choice.H> -#include "c_fl_input_choice.h" -#include "c_fl_type.h" - - - - -class My_Input_Choice : public Fl_Input_Choice { - public: - using Fl_Input_Choice::Fl_Input_Choice; - friend void input_choice_set_draw_hook(INPUT_CHOICE n, void * d); - friend void fl_input_choice_draw(INPUT_CHOICE n); - friend void input_choice_set_handle_hook(INPUT_CHOICE n, void * h); - friend int fl_input_choice_handle(INPUT_CHOICE n, 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_Choice::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Input_Choice::real_draw() { - Fl_Input_Choice::draw(); -} - -int My_Input_Choice::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Input_Choice::real_handle(int e) { - return Fl_Input_Choice::handle(e); -} - -void input_choice_set_draw_hook(INPUT_CHOICE n, void * d) { - reinterpret_cast<My_Input_Choice*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_input_choice_draw(INPUT_CHOICE n) { - reinterpret_cast<My_Input_Choice*>(n)->real_draw(); -} - -void input_choice_set_handle_hook(INPUT_CHOICE n, void * h) { - reinterpret_cast<My_Input_Choice*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_input_choice_handle(INPUT_CHOICE n, int e) { - return reinterpret_cast<My_Input_Choice*>(n)->real_handle(e); -} - - - - -INPUT_CHOICE new_fl_input_choice(int x, int y, int w, int h, char* label) { - My_Input_Choice *n = new My_Input_Choice(x, y, w, h, label); - return n; -} - -void free_fl_input_choice(INPUT_CHOICE n) { - delete reinterpret_cast<My_Input_Choice*>(n); -} - - - - -void * fl_input_choice_input(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->input(); -} - -void * fl_input_choice_menubutton(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->menubutton(); -} - - - - -void fl_input_choice_clear(INPUT_CHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->clear(); -} - - - - -int fl_input_choice_changed(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->changed(); -} - -void fl_input_choice_clear_changed(INPUT_CHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->clear_changed(); -} - -void fl_input_choice_set_changed(INPUT_CHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->set_changed(); -} - -int fl_input_choice_get_down_box(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->down_box(); -} - -void fl_input_choice_set_down_box(INPUT_CHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->down_box(static_cast<Fl_Boxtype>(t)); -} - -unsigned int fl_input_choice_get_textcolor(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textcolor(); -} - -void fl_input_choice_set_textcolor(INPUT_CHOICE n, unsigned int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textcolor(t); -} - -int fl_input_choice_get_textfont(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textfont(); -} - -void fl_input_choice_set_textfont(INPUT_CHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textfont(t); -} - -int fl_input_choice_get_textsize(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textsize(); -} - -void fl_input_choice_set_textsize(INPUT_CHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textsize(t); -} - -const char * fl_input_choice_get_value(INPUT_CHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->value(); -} - -void fl_input_choice_set_value(INPUT_CHOICE n, const char * t) { - reinterpret_cast<Fl_Input_Choice*>(n)->value(t); -} - -void fl_input_choice_set_value2(INPUT_CHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->value(t); -} - - diff --git a/src/c_fl_input_choice.h b/src/c_fl_input_choice.h deleted file mode 100644 index 9b1c1d4..0000000 --- a/src/c_fl_input_choice.h +++ /dev/null @@ -1,52 +0,0 @@ - - -#ifndef FL_INPUT_CHOICE_GUARD -#define FL_INPUT_CHOICE_GUARD - - - - -typedef void* INPUT_CHOICE; - - - - -extern "C" void input_choice_set_draw_hook(INPUT_CHOICE n, void * d); -extern "C" void fl_input_choice_draw(INPUT_CHOICE n); -extern "C" void input_choice_set_handle_hook(INPUT_CHOICE n, void * h); -extern "C" int fl_input_choice_handle(INPUT_CHOICE n, int e); - - - - -extern "C" INPUT_CHOICE new_fl_input_choice(int x, int y, int w, int h, char* label); -extern "C" void free_fl_input_choice(INPUT_CHOICE n); - - - - -extern "C" void * fl_input_choice_input(INPUT_CHOICE n); -extern "C" void * fl_input_choice_menubutton(INPUT_CHOICE n); - - -extern "C" void fl_input_choice_clear(INPUT_CHOICE n); - - -extern "C" int fl_input_choice_changed(INPUT_CHOICE n); -extern "C" void fl_input_choice_clear_changed(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_changed(INPUT_CHOICE n); -extern "C" int fl_input_choice_get_down_box(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_down_box(INPUT_CHOICE n, int t); -extern "C" unsigned int fl_input_choice_get_textcolor(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_textcolor(INPUT_CHOICE n, unsigned int t); -extern "C" int fl_input_choice_get_textfont(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_textfont(INPUT_CHOICE n, int t); -extern "C" int fl_input_choice_get_textsize(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_textsize(INPUT_CHOICE n, int t); -extern "C" const char * fl_input_choice_get_value(INPUT_CHOICE n); -extern "C" void fl_input_choice_set_value(INPUT_CHOICE n, const char * t); -extern "C" void fl_input_choice_set_value2(INPUT_CHOICE n, int t); - - -#endif - diff --git a/src/c_fl_int_input.cpp b/src/c_fl_int_input.cpp deleted file mode 100644 index 5dab998..0000000 --- a/src/c_fl_int_input.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Int_Input.H> -#include "c_fl_int_input.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Int_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Int_Input::real_draw() { - Fl_Int_Input::draw(); -} - -int My_Int_Input::handle(int e) { - return (*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<My_Int_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_int_input_draw(INT_INPUT i) { - reinterpret_cast<My_Int_Input*>(i)->real_draw(); -} - -void int_input_set_handle_hook(INT_INPUT i, void * h) { - reinterpret_cast<My_Int_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_int_input_handle(INT_INPUT i, int e) { - return reinterpret_cast<My_Int_Input*>(i)->real_handle(e); -} - - - - -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 free_fl_int_input(INT_INPUT i) { - delete reinterpret_cast<My_Int_Input*>(i); -} - - diff --git a/src/c_fl_int_input.h b/src/c_fl_int_input.h deleted file mode 100644 index 907c041..0000000 --- a/src/c_fl_int_input.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_INT_INPUT_GUARD -#define FL_INT_INPUT_GUARD - - - - -typedef void* INT_INPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_jpeg_image.cpp b/src/c_fl_jpeg_image.cpp deleted file mode 100644 index be99257..0000000 --- a/src/c_fl_jpeg_image.cpp +++ /dev/null @@ -1,22 +0,0 @@ - - -#include <FL/Fl_JPEG_Image.H> -#include "c_fl_jpeg_image.h" - - - - -JPEG_IMAGE new_fl_jpeg_image(const char * f) { - Fl_JPEG_Image *j = new Fl_JPEG_Image(f); - return j; -} - -JPEG_IMAGE new_fl_jpeg_image2(const char *n, void *data) { - Fl_JPEG_Image *j = new Fl_JPEG_Image(n, reinterpret_cast<uchar*>(data)); - return j; -} - -void free_fl_jpeg_image(JPEG_IMAGE j) { - delete reinterpret_cast<Fl_JPEG_Image*>(j); -} - diff --git a/src/c_fl_jpeg_image.h b/src/c_fl_jpeg_image.h deleted file mode 100644 index 1592465..0000000 --- a/src/c_fl_jpeg_image.h +++ /dev/null @@ -1,20 +0,0 @@ - - -#ifndef FL_JPEG_IMAGE_GUARD -#define FL_JPEG_IMAGE_GUARD - - - - -typedef void* JPEG_IMAGE; - - - - -extern "C" JPEG_IMAGE new_fl_jpeg_image(const char * f); -extern "C" JPEG_IMAGE new_fl_jpeg_image2(const char * n, void *data); -extern "C" void free_fl_jpeg_image(JPEG_IMAGE j); - - -#endif - diff --git a/src/c_fl_light_button.cpp b/src/c_fl_light_button.cpp deleted file mode 100644 index e1ffe84..0000000 --- a/src/c_fl_light_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Light_Button.H> -#include "c_fl_light_button.h" -#include "c_fl_type.h" - - - - -class My_Light_Button : public Fl_Light_Button { - public: - using Fl_Light_Button::Fl_Light_Button; - friend void light_button_set_draw_hook(LIGHTBUTTON b, void * d); - friend void fl_light_button_draw(LIGHTBUTTON b); - friend void light_button_set_handle_hook(LIGHTBUTTON b, void * h); - friend int fl_light_button_handle(LIGHTBUTTON b, 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_Light_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Light_Button::real_draw() { - Fl_Light_Button::draw(); -} - -int My_Light_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Light_Button::real_handle(int e) { - return Fl_Light_Button::handle(e); -} - -void light_button_set_draw_hook(LIGHTBUTTON b, void * d) { - reinterpret_cast<My_Light_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_light_button_draw(LIGHTBUTTON b) { - reinterpret_cast<My_Light_Button*>(b)->real_draw(); -} - -void light_button_set_handle_hook(LIGHTBUTTON b, void * h) { - reinterpret_cast<My_Light_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_light_button_handle(LIGHTBUTTON b, int e) { - return reinterpret_cast<My_Light_Button*>(b)->real_handle(e); -} - - - - -LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label) { - My_Light_Button *b = new My_Light_Button(x, y, w, h, label); - return b; -} - -void free_fl_light_button(LIGHTBUTTON b) { - delete reinterpret_cast<My_Light_Button*>(b); -} - diff --git a/src/c_fl_light_button.h b/src/c_fl_light_button.h deleted file mode 100644 index 1a9fab4..0000000 --- a/src/c_fl_light_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_LIGHT_BUTTON_GUARD -#define FL_LIGHT_BUTTON_GUARD - - - - -typedef void* LIGHTBUTTON; - - - - -extern "C" void light_button_set_draw_hook(LIGHTBUTTON b, void * d); -extern "C" void fl_light_button_draw(LIGHTBUTTON b); -extern "C" void light_button_set_handle_hook(LIGHTBUTTON b, void * h); -extern "C" int fl_light_button_handle(LIGHTBUTTON b, int e); - - - - -extern "C" LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_light_button(LIGHTBUTTON b); - - -#endif - diff --git a/src/c_fl_line_dial.cpp b/src/c_fl_line_dial.cpp deleted file mode 100644 index 874ef8e..0000000 --- a/src/c_fl_line_dial.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Line_Dial.H> -#include "c_fl_line_dial.h" -#include "c_fl_type.h" - - - - -class My_Line_Dial : public Fl_Line_Dial { - public: - using Fl_Line_Dial::Fl_Line_Dial; - friend void line_dial_set_draw_hook(LINE_DIAL v, void * d); - friend void fl_line_dial_draw(LINE_DIAL v); - friend void line_dial_set_handle_hook(LINE_DIAL v, void * h); - friend int fl_line_dial_handle(LINE_DIAL v, 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_Line_Dial::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Line_Dial::real_draw() { - Fl_Line_Dial::draw(); -} - -int My_Line_Dial::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Line_Dial::real_handle(int e) { - return Fl_Line_Dial::handle(e); -} - -void line_dial_set_draw_hook(LINE_DIAL v, void * d) { - reinterpret_cast<My_Line_Dial*>(v)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_line_dial_draw(LINE_DIAL v) { - reinterpret_cast<My_Line_Dial*>(v)->real_draw(); -} - -void line_dial_set_handle_hook(LINE_DIAL v, void * h) { - reinterpret_cast<My_Line_Dial*>(v)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_line_dial_handle(LINE_DIAL v, int e) { - return reinterpret_cast<My_Line_Dial*>(v)->real_handle(e); -} - - - - -LINE_DIAL new_fl_line_dial(int x, int y, int w, int h, char* label) { - My_Line_Dial *v = new My_Line_Dial(x, y, w, h, label); - return v; -} - -void free_fl_line_dial(LINE_DIAL v) { - delete reinterpret_cast<My_Line_Dial*>(v); -} - - diff --git a/src/c_fl_line_dial.h b/src/c_fl_line_dial.h deleted file mode 100644 index 0056939..0000000 --- a/src/c_fl_line_dial.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_LINE_DIAL_GUARD -#define FL_LINE_DIAL_GUARD - - - - -typedef void* LINE_DIAL; - - - - -extern "C" void line_dial_set_draw_hook(LINE_DIAL v, void * d); -extern "C" void fl_line_dial_draw(LINE_DIAL v); -extern "C" void line_dial_set_handle_hook(LINE_DIAL v, void * h); -extern "C" int fl_line_dial_handle(LINE_DIAL v, int e); - - - - -extern "C" LINE_DIAL new_fl_line_dial(int x, int y, int w, int h, char* label); -extern "C" void free_fl_line_dial(LINE_DIAL v); - - -#endif - diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp deleted file mode 100644 index 3a4fa8f..0000000 --- a/src/c_fl_menu.cpp +++ /dev/null @@ -1,220 +0,0 @@ - - -#include <FL/Fl_Menu_.H> -#include <FL/Fl_Menu_Item.H> -#include "c_fl_menu.h" -#include "c_fl_type.h" - - - - -class My_Menu : public Fl_Menu_ { - public: - using Fl_Menu_::Fl_Menu_; - friend void menu_set_draw_hook(MENU m, void * d); - friend void menu_set_handle_hook(MENU m, void * h); - protected: - void draw(); - int handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; - -void My_Menu::draw() { - (*draw_hook)(this->user_data()); -} - -int My_Menu::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -void menu_set_draw_hook(MENU m, void * d) { - reinterpret_cast<My_Menu*>(m)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void menu_set_handle_hook(MENU m, void * h) { - reinterpret_cast<My_Menu*>(m)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - - - - -MENU new_fl_menu(int x, int y, int w, int h, char* label) { - My_Menu *m = new My_Menu(x, y, w, h, label); - return m; -} - -void free_fl_menu(MENU m) { - delete reinterpret_cast<My_Menu*>(m); -} - - - - -int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) { - return reinterpret_cast<Fl_Menu_*>(m)->add(t,s,reinterpret_cast<Fl_Callback_p>(c),u,f); -} - -int fl_menu_insert(MENU m, int p, const char * t, unsigned long s, void * c, void * u, unsigned long f) { - return reinterpret_cast<Fl_Menu_*>(m)->insert(p,t,s,reinterpret_cast<Fl_Callback_p>(c),u,f); -} - -void fl_menu_remove(MENU m, int p) { - reinterpret_cast<Fl_Menu_*>(m)->remove(p); -} - -void fl_menu_clear(MENU m) { - reinterpret_cast<Fl_Menu_*>(m)->clear(); -} - - - - -const void * fl_menu_get_item(MENU m, int i) { - return &(reinterpret_cast<Fl_Menu_*>(m)->menu()[i]); -} - -const void * fl_menu_find_item(MENU m, const char * t) { - return reinterpret_cast<Fl_Menu_*>(m)->find_item(t); -} - -const void * fl_menu_find_item2(MENU m, void * cb) { - // have to loop through the array manually since callbacks are stored in userdata - for (int i=0; i<fl_menu_size(m); i++) { - if (reinterpret_cast<Fl_Menu_*>(m)->menu()[i].user_data() == cb) { - return fl_menu_get_item(m,i); - } - } - return 0; -} - -int fl_menu_find_index(MENU m, const char * t) { - return reinterpret_cast<Fl_Menu_*>(m)->find_index(t); -} - -int fl_menu_find_index2(MENU m, void * i) { - return reinterpret_cast<Fl_Menu_*>(m)->find_index(reinterpret_cast<Fl_Menu_Item*>(i)); -} - -int fl_menu_find_index3(MENU m, void * cb) { - // have to loop through the array manually since callbacks are stored in userdata - for (int i=0; i<fl_menu_size(m); i++) { - if (reinterpret_cast<Fl_Menu_*>(m)->menu()[i].user_data() == cb) { - return i; - } - } - return -1; -} - -int fl_menu_size(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->size(); -} - - - - -const void * fl_menu_mvalue(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->mvalue(); -} - -const char * fl_menu_text(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->text(); -} - -int fl_menu_value(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->value(); -} - -int fl_menu_set_value(MENU m, int p) { - return reinterpret_cast<Fl_Menu_*>(m)->value(p); -} - -int fl_menu_set_value2(MENU m, void * i) { - return reinterpret_cast<Fl_Menu_*>(m)->value(reinterpret_cast<Fl_Menu_Item*>(i)); -} - - - - -unsigned int fl_menu_get_textcolor(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->textcolor(); -} - -void fl_menu_set_textcolor(MENU m, unsigned int c) { - reinterpret_cast<Fl_Menu_*>(m)->textcolor(c); -} - -int fl_menu_get_textfont(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->textfont(); -} - -void fl_menu_set_textfont(MENU m, int f) { - reinterpret_cast<Fl_Menu_*>(m)->textfont(f); -} - -int fl_menu_get_textsize(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->textsize(); -} - -void fl_menu_set_textsize(MENU m, int s) { - reinterpret_cast<Fl_Menu_*>(m)->textsize(s); -} - - - - -int fl_menu_get_down_box(MENU m) { - return reinterpret_cast<Fl_Menu_*>(m)->down_box(); -} - -void fl_menu_set_down_box(MENU m, int t) { - reinterpret_cast<Fl_Menu_*>(m)->down_box(static_cast<Fl_Boxtype>(t)); -} - -void fl_menu_global(MENU m) { - reinterpret_cast<Fl_Menu_*>(m)->global(); -} - -int fl_menu_measure(MENU m, int i, int *h) { - // method actually belongs to Fl_Menu_Item - const Fl_Menu_Item * item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i)); - return item->measure(h,reinterpret_cast<Fl_Menu_*>(m)); -} - - - - -const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n) { - // method actually belongs to Fl_Menu_Item - const Fl_Menu_Item * dummy = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,0)); - const Fl_Menu_Item * item; - if (n >= 0) { - item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,n)); - } else { - item = 0; - } - return dummy->popup(x,y,t,item,reinterpret_cast<Fl_Menu_*>(m)); -} - -const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n) { - // method actually belongs to Fl_Menu_Item - const Fl_Menu_Item * dummy = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,0)); - const Fl_Menu_Item * item; - if (n >= 0) { - item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,n)); - } else { - item = 0; - } - return dummy->pulldown(x,y,w,h,item,reinterpret_cast<Fl_Menu_*>(m)); -} - - - - -void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s) { - // method actually belongs to Fl_Menu_Item - const Fl_Menu_Item * item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i)); - item->draw(x,y,w,h,reinterpret_cast<Fl_Menu_*>(m),s); -} - - diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h deleted file mode 100644 index 7babca2..0000000 --- a/src/c_fl_menu.h +++ /dev/null @@ -1,70 +0,0 @@ - - -#ifndef FL_MENU_GUARD -#define FL_MENU_GUARD - - - - -typedef void* MENU; - - - - -extern "C" void menu_set_draw_hook(MENU m, void * d); -extern "C" void menu_set_handle_hook(MENU m, void * h); - - - - -extern "C" MENU new_fl_menu(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu(MENU m); - - - - -extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); -extern "C" int fl_menu_insert(MENU m, int p, const char * t, unsigned long s, void * c, void * u, unsigned long f); -extern "C" void fl_menu_remove(MENU m, int p); -extern "C" void fl_menu_clear(MENU m); - - -extern "C" const void * fl_menu_get_item(MENU m, int i); -extern "C" const void * fl_menu_find_item(MENU m, const char * t); -extern "C" const void * fl_menu_find_item2(MENU m, void * cb); -extern "C" int fl_menu_find_index(MENU m, const char * t); -extern "C" int fl_menu_find_index2(MENU m, void * i); -extern "C" int fl_menu_find_index3(MENU m, void * cb); -extern "C" int fl_menu_size(MENU m); - - -extern "C" const void * fl_menu_mvalue(MENU m); -extern "C" const char * fl_menu_text(MENU m); -extern "C" int fl_menu_value(MENU m); -extern "C" int fl_menu_set_value(MENU m, int p); -extern "C" int fl_menu_set_value2(MENU m, void * i); - - -extern "C" unsigned int fl_menu_get_textcolor(MENU m); -extern "C" void fl_menu_set_textcolor(MENU m, unsigned int c); -extern "C" int fl_menu_get_textfont(MENU m); -extern "C" void fl_menu_set_textfont(MENU m, int f); -extern "C" int fl_menu_get_textsize(MENU m); -extern "C" void fl_menu_set_textsize(MENU m, int s); - - -extern "C" int fl_menu_get_down_box(MENU m); -extern "C" void fl_menu_set_down_box(MENU m, int t); -extern "C" void fl_menu_global(MENU m); -extern "C" int fl_menu_measure(MENU m, int i, int *h); - - -extern "C" const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n); -extern "C" const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n); - - -extern "C" void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s); - - -#endif - diff --git a/src/c_fl_menu_bar.cpp b/src/c_fl_menu_bar.cpp deleted file mode 100644 index 98b61f2..0000000 --- a/src/c_fl_menu_bar.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Menu_Bar.H> -#include "c_fl_menu_bar.h" -#include "c_fl_type.h" - - - - -class My_Menu_Bar : public Fl_Menu_Bar { - public: - using Fl_Menu_Bar::Fl_Menu_Bar; - friend void menu_bar_set_draw_hook(MENUBAR m, void * d); - friend void fl_menu_bar_draw(MENUBAR m); - friend void menu_bar_set_handle_hook(MENUBAR m, void * h); - friend int fl_menu_bar_handle(MENUBAR m, 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_Menu_Bar::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Menu_Bar::real_draw() { - Fl_Menu_Bar::draw(); -} - -int My_Menu_Bar::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Menu_Bar::real_handle(int e) { - return Fl_Menu_Bar::handle(e); -} - -void menu_bar_set_draw_hook(MENUBAR m, void * d) { - reinterpret_cast<My_Menu_Bar*>(m)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_menu_bar_draw(MENUBAR m) { - reinterpret_cast<My_Menu_Bar*>(m)->real_draw(); -} - -void menu_bar_set_handle_hook(MENUBAR m, void * h) { - reinterpret_cast<My_Menu_Bar*>(m)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_menu_bar_handle(MENUBAR m, int e) { - return reinterpret_cast<My_Menu_Bar*>(m)->real_handle(e); -} - - - - -MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) { - My_Menu_Bar *m = new My_Menu_Bar(x, y, w, h, label); - return m; -} - -void free_fl_menu_bar(MENUBAR m) { - delete reinterpret_cast<My_Menu_Bar*>(m); -} - diff --git a/src/c_fl_menu_bar.h b/src/c_fl_menu_bar.h deleted file mode 100644 index 60d2e06..0000000 --- a/src/c_fl_menu_bar.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_MENU_BAR_GUARD -#define FL_MENU_BAR_GUARD - - - - -typedef void* MENUBAR; - - - - -extern "C" void menu_bar_set_draw_hook(MENUBAR m, void * d); -extern "C" void fl_menu_bar_draw(MENUBAR m); -extern "C" void menu_bar_set_handle_hook(MENUBAR m, void * h); -extern "C" int fl_menu_bar_handle(MENUBAR m, int e); - - - - -extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_bar(MENUBAR m); - - -#endif - diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp deleted file mode 100644 index b08c36f..0000000 --- a/src/c_fl_menu_button.cpp +++ /dev/null @@ -1,81 +0,0 @@ - - -#include <FL/Fl_Menu_Button.H> -#include "c_fl_menu_button.h" -#include "c_fl_type.h" - - - - -class My_Menu_Button : public Fl_Menu_Button { - public: - using Fl_Menu_Button::Fl_Menu_Button; - friend void menu_button_set_draw_hook(MENUBUTTON m, void * d); - friend void fl_menu_button_draw(MENUBUTTON m); - friend void menu_button_set_handle_hook(MENUBUTTON m, void * h); - friend int fl_menu_button_handle(MENUBUTTON m, 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_Menu_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Menu_Button::real_draw() { - Fl_Menu_Button::draw(); -} - -int My_Menu_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Menu_Button::real_handle(int e) { - return Fl_Menu_Button::handle(e); -} - -void menu_button_set_draw_hook(MENUBUTTON m, void * d) { - reinterpret_cast<My_Menu_Button*>(m)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_menu_button_draw(MENUBUTTON m) { - reinterpret_cast<My_Menu_Button*>(m)->real_draw(); -} - -void menu_button_set_handle_hook(MENUBUTTON m, void * h) { - reinterpret_cast<My_Menu_Button*>(m)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_menu_button_handle(MENUBUTTON m, int e) { - return reinterpret_cast<My_Menu_Button*>(m)->real_handle(e); -} - - - - -MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label) { - My_Menu_Button *m = new My_Menu_Button(x, y, w, h, label); - return m; -} - -void free_fl_menu_button(MENUBUTTON m) { - delete reinterpret_cast<My_Menu_Button*>(m); -} - - - - -void fl_menu_button_type(MENUBUTTON m, unsigned int t) { - reinterpret_cast<Fl_Menu_Button*>(m)->type(t); -} - -const void * fl_menu_button_popup(MENUBUTTON m) { - return reinterpret_cast<Fl_Menu_Button*>(m)->popup(); -} - - diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h deleted file mode 100644 index 8013bf9..0000000 --- a/src/c_fl_menu_button.h +++ /dev/null @@ -1,33 +0,0 @@ - - -#ifndef FL_MENU_BUTTON_GUARD -#define FL_MENU_BUTTON_GUARD - - - - -typedef void* MENUBUTTON; - - - - -extern "C" void menu_button_set_draw_hook(MENUBUTTON m, void * d); -extern "C" void fl_menu_button_draw(MENUBUTTON m); -extern "C" void menu_button_set_handle_hook(MENUBUTTON m, void * h); -extern "C" int fl_menu_button_handle(MENUBUTTON m, int e); - - - - -extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_button(MENUBUTTON m); - - - - -extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); -extern "C" const void * fl_menu_button_popup(MENUBUTTON m); - - -#endif - diff --git a/src/c_fl_menu_window.cpp b/src/c_fl_menu_window.cpp deleted file mode 100644 index 77b07ae..0000000 --- a/src/c_fl_menu_window.cpp +++ /dev/null @@ -1,104 +0,0 @@ - - -#include <FL/Fl_Menu_Window.H> -#include "c_fl_menu_window.h" -#include "c_fl_type.h" - - - - -class My_Menu_Window : public Fl_Menu_Window { - public: - using Fl_Menu_Window::Fl_Menu_Window; - friend void menu_window_set_draw_hook(MENUWINDOW n, void * d); - friend void fl_menu_window_draw(MENUWINDOW n); - friend void menu_window_set_handle_hook(MENUWINDOW n, void * h); - friend int fl_menu_window_handle(MENUWINDOW n, 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_Menu_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Menu_Window::real_draw() { - Fl_Menu_Window::draw(); -} - -int My_Menu_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Menu_Window::real_handle(int e) { - return Fl_Menu_Window::handle(e); -} - -void menu_window_set_draw_hook(MENUWINDOW n, void * d) { - reinterpret_cast<My_Menu_Window*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_menu_window_draw(MENUWINDOW n) { - reinterpret_cast<My_Menu_Window*>(n)->real_draw(); -} - -void menu_window_set_handle_hook(MENUWINDOW n, void * h) { - reinterpret_cast<My_Menu_Window*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_menu_window_handle(MENUWINDOW n, int e) { - return reinterpret_cast<My_Menu_Window*>(n)->real_handle(e); -} - - - - -MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) { - My_Menu_Window *m = new My_Menu_Window(x, y, w, h, label); - return m; -} - -MENUWINDOW new_fl_menu_window2(int w, int h, char* label) { - My_Menu_Window *m = new My_Menu_Window(w, h, label); - return m; -} - -void free_fl_menu_window(MENUWINDOW m) { - delete reinterpret_cast<My_Menu_Window*>(m); -} - - - - -void fl_menu_window_show(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->show(); -} - -void fl_menu_window_hide(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->hide(); -} - -void fl_menu_window_flush(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->flush(); -} - - - - -void fl_menu_window_set_overlay(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->set_overlay(); -} - -void fl_menu_window_clear_overlay(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->clear_overlay(); -} - -unsigned int fl_menu_window_overlay(MENUWINDOW m) { - return reinterpret_cast<Fl_Menu_Window*>(m)->overlay(); -} - diff --git a/src/c_fl_menu_window.h b/src/c_fl_menu_window.h deleted file mode 100644 index 2d37249..0000000 --- a/src/c_fl_menu_window.h +++ /dev/null @@ -1,40 +0,0 @@ - - -#ifndef FL_MENU_WINDOW_GUARD -#define FL_MENU_WINDOW_GUARD - - - - -typedef void* MENUWINDOW; - - - - -extern "C" void menu_window_set_draw_hook(MENUWINDOW n, void * d); -extern "C" void fl_menu_window_draw(MENUWINDOW n); -extern "C" void menu_window_set_handle_hook(MENUWINDOW n, void * h); -extern "C" int fl_menu_window_handle(MENUWINDOW n, int e); - - - - -extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label); -extern "C" MENUWINDOW new_fl_menu_window2(int w, int h, char* label); -extern "C" void free_fl_menu_window(MENUWINDOW m); - - - - -extern "C" void fl_menu_window_show(MENUWINDOW m); -extern "C" void fl_menu_window_hide(MENUWINDOW m); -extern "C" void fl_menu_window_flush(MENUWINDOW m); - - -extern "C" void fl_menu_window_set_overlay(MENUWINDOW m); -extern "C" void fl_menu_window_clear_overlay(MENUWINDOW m); -extern "C" unsigned int fl_menu_window_overlay(MENUWINDOW m); - - -#endif - diff --git a/src/c_fl_menuitem.cpp b/src/c_fl_menuitem.cpp deleted file mode 100644 index 3a9565e..0000000 --- a/src/c_fl_menuitem.cpp +++ /dev/null @@ -1,158 +0,0 @@ - - -#include <FL/Fl_Menu_Item.H> -#include <FL/Fl_Widget.H> -#include "c_fl_menuitem.h" - - - - -void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f) { - Fl_Menu_Item *mi = new Fl_Menu_Item; - mi->callback(reinterpret_cast<Fl_Callback*>(c)); - mi->flags = static_cast<int>(f); - mi->shortcut(static_cast<int>(s)); - mi->label(t); - return mi; -} - -void free_fl_menu_item(MENU_ITEM mi) { - delete reinterpret_cast<Fl_Menu_Item*>(mi); -} - - - - -void * fl_menu_item_get_user_data(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->user_data(); -} - -void fl_menu_item_set_user_data(MENU_ITEM mi, void * c) { - reinterpret_cast<Fl_Menu_Item*>(mi)->user_data(c); -} - -void fl_menu_item_do_callback(MENU_ITEM mi, void * w) { - reinterpret_cast<Fl_Menu_Item*>(mi)->do_callback(reinterpret_cast<Fl_Widget*>(w)); -} - - - - -int fl_menu_item_checkbox(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->checkbox(); -} - -int fl_menu_item_radio(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->radio(); -} - -int fl_menu_item_value(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->value(); -} - -void fl_menu_item_set(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->set(); -} - -void fl_menu_item_clear(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->clear(); -} - -void fl_menu_item_setonly(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->setonly(); -} - - - - -const char * fl_menu_item_get_label(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->label(); -} - -void fl_menu_item_set_label(MENU_ITEM mi, const char *t) { - reinterpret_cast<Fl_Menu_Item*>(mi)->label(t); -} - -unsigned int fl_menu_item_get_labelcolor(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->labelcolor(); -} - -void fl_menu_item_set_labelcolor(MENU_ITEM mi, unsigned int c) { - reinterpret_cast<Fl_Menu_Item*>(mi)->labelcolor(c); -} - -int fl_menu_item_get_labelfont(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->labelfont(); -} - -void fl_menu_item_set_labelfont(MENU_ITEM mi, int f) { - reinterpret_cast<Fl_Menu_Item*>(mi)->labelfont(f); -} - -int fl_menu_item_get_labelsize(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->labelsize(); -} - -void fl_menu_item_set_labelsize(MENU_ITEM mi, int s) { - reinterpret_cast<Fl_Menu_Item*>(mi)->labelsize(s); -} - -int fl_menu_item_get_labeltype(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->labeltype(); -} - -void fl_menu_item_set_labeltype(MENU_ITEM mi, int t) { - reinterpret_cast<Fl_Menu_Item*>(mi)->labeltype(static_cast<Fl_Labeltype>(t)); -} - - - - -int fl_menu_item_get_shortcut(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->shortcut(); -} - -void fl_menu_item_set_shortcut(MENU_ITEM mi, int s) { - reinterpret_cast<Fl_Menu_Item*>(mi)->shortcut(s); -} - -unsigned long fl_menu_item_get_flags(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->flags; -} - -void fl_menu_item_set_flags(MENU_ITEM mi, unsigned long f) { - reinterpret_cast<Fl_Menu_Item*>(mi)->flags = f; -} - - - - -void fl_menu_item_activate(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->activate(); -} - -void fl_menu_item_deactivate(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->deactivate(); -} - -void fl_menu_item_show(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->show(); -} - -void fl_menu_item_hide(MENU_ITEM mi) { - reinterpret_cast<Fl_Menu_Item*>(mi)->hide(); -} - -int fl_menu_item_active(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->active(); -} - -int fl_menu_item_visible(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->visible(); -} - -int fl_menu_item_activevisible(MENU_ITEM mi) { - return reinterpret_cast<Fl_Menu_Item*>(mi)->activevisible(); -} - - diff --git a/src/c_fl_menuitem.h b/src/c_fl_menuitem.h deleted file mode 100644 index ce90cbc..0000000 --- a/src/c_fl_menuitem.h +++ /dev/null @@ -1,61 +0,0 @@ - - -#ifndef FL_MENU_ITEM_GUARD -#define FL_MENU_ITEM_GUARD - - - - -typedef void* MENU_ITEM; - - - - -extern "C" void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f); -extern "C" void free_fl_menu_item(MENU_ITEM mi); - - - - -extern "C" void * fl_menu_item_get_user_data(MENU_ITEM mi); -extern "C" void fl_menu_item_set_user_data(MENU_ITEM mi, void * c); -extern "C" void fl_menu_item_do_callback(MENU_ITEM mi, void * w); - - -extern "C" int fl_menu_item_checkbox(MENU_ITEM mi); -extern "C" int fl_menu_item_radio(MENU_ITEM mi); -extern "C" int fl_menu_item_value(MENU_ITEM mi); -extern "C" void fl_menu_item_set(MENU_ITEM mi); -extern "C" void fl_menu_item_clear(MENU_ITEM mi); -extern "C" void fl_menu_item_setonly(MENU_ITEM mi); - - -extern "C" const char * fl_menu_item_get_label(MENU_ITEM mi); -extern "C" void fl_menu_item_set_label(MENU_ITEM mi, const char *t); -extern "C" unsigned int fl_menu_item_get_labelcolor(MENU_ITEM mi); -extern "C" void fl_menu_item_set_labelcolor(MENU_ITEM mi, unsigned int c); -extern "C" int fl_menu_item_get_labelfont(MENU_ITEM mi); -extern "C" void fl_menu_item_set_labelfont(MENU_ITEM mi, int f); -extern "C" int fl_menu_item_get_labelsize(MENU_ITEM mi); -extern "C" void fl_menu_item_set_labelsize(MENU_ITEM mi, int s); -extern "C" int fl_menu_item_get_labeltype(MENU_ITEM mi); -extern "C" void fl_menu_item_set_labeltype(MENU_ITEM mi, int t); - - -extern "C" int fl_menu_item_get_shortcut(MENU_ITEM mi); -extern "C" void fl_menu_item_set_shortcut(MENU_ITEM mi, int s); -extern "C" unsigned long fl_menu_item_get_flags(MENU_ITEM mi); -extern "C" void fl_menu_item_set_flags(MENU_ITEM mi, unsigned long f); - - -extern "C" void fl_menu_item_activate(MENU_ITEM mi); -extern "C" void fl_menu_item_deactivate(MENU_ITEM mi); -extern "C" void fl_menu_item_show(MENU_ITEM mi); -extern "C" void fl_menu_item_hide(MENU_ITEM mi); -extern "C" int fl_menu_item_active(MENU_ITEM mi); -extern "C" int fl_menu_item_visible(MENU_ITEM mi); -extern "C" int fl_menu_item_activevisible(MENU_ITEM mi); - - -#endif - diff --git a/src/c_fl_multiline_input.cpp b/src/c_fl_multiline_input.cpp deleted file mode 100644 index f6ee055..0000000 --- a/src/c_fl_multiline_input.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Multiline_Input.H> -#include "c_fl_multiline_input.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Multiline_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Multiline_Input::real_draw() { - Fl_Multiline_Input::draw(); -} - -int My_Multiline_Input::handle(int e) { - return (*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<My_Multiline_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_multiline_input_draw(MULTILINE_INPUT i) { - reinterpret_cast<My_Multiline_Input*>(i)->real_draw(); -} - -void multiline_input_set_handle_hook(MULTILINE_INPUT i, void * h) { - reinterpret_cast<My_Multiline_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_multiline_input_handle(MULTILINE_INPUT i, int e) { - return reinterpret_cast<My_Multiline_Input*>(i)->real_handle(e); -} - - - - -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 free_fl_multiline_input(MULTILINE_INPUT i) { - delete reinterpret_cast<My_Multiline_Input*>(i); -} - - diff --git a/src/c_fl_multiline_input.h b/src/c_fl_multiline_input.h deleted file mode 100644 index 177567b..0000000 --- a/src/c_fl_multiline_input.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_MULTILINE_INPUT_GUARD -#define FL_MULTILINE_INPUT_GUARD - - - - -typedef void* MULTILINE_INPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_multiline_output.cpp b/src/c_fl_multiline_output.cpp deleted file mode 100644 index 5f39e23..0000000 --- a/src/c_fl_multiline_output.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Multiline_Output.H> -#include "c_fl_multiline_output.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Multiline_Output::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Multiline_Output::real_draw() { - Fl_Multiline_Output::draw(); -} - -int My_Multiline_Output::handle(int e) { - return (*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<My_Multiline_Output*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_multiline_output_draw(MULTILINE_OUTPUT i) { - reinterpret_cast<My_Multiline_Output*>(i)->real_draw(); -} - -void multiline_output_set_handle_hook(MULTILINE_OUTPUT i, void * h) { - reinterpret_cast<My_Multiline_Output*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_multiline_output_handle(MULTILINE_OUTPUT i, int e) { - return reinterpret_cast<My_Multiline_Output*>(i)->real_handle(e); -} - - - - -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 free_fl_multiline_output(MULTILINE_OUTPUT i) { - delete reinterpret_cast<My_Multiline_Output*>(i); -} - - diff --git a/src/c_fl_multiline_output.h b/src/c_fl_multiline_output.h deleted file mode 100644 index fae3da8..0000000 --- a/src/c_fl_multiline_output.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_MULTILINE_OUTPUT_GUARD -#define FL_MULTILINE_OUTPUT_GUARD - - - - -typedef void* MULTILINE_OUTPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_nice_slider.cpp b/src/c_fl_nice_slider.cpp deleted file mode 100644 index 804f0f0..0000000 --- a/src/c_fl_nice_slider.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Nice_Slider.H> -#include "c_fl_nice_slider.h" -#include "c_fl_type.h" - - - - -class My_Nice_Slider : public Fl_Nice_Slider { - public: - using Fl_Nice_Slider::Fl_Nice_Slider; - friend void nice_slider_set_draw_hook(NICE_SLIDER s, void * d); - friend void fl_nice_slider_draw(NICE_SLIDER s); - friend void nice_slider_set_handle_hook(NICE_SLIDER s, void * h); - friend int fl_nice_slider_handle(NICE_SLIDER s, 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_Nice_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Nice_Slider::real_draw() { - Fl_Nice_Slider::draw(); -} - -int My_Nice_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Nice_Slider::real_handle(int e) { - return Fl_Nice_Slider::handle(e); -} - -void nice_slider_set_draw_hook(NICE_SLIDER s, void * d) { - reinterpret_cast<My_Nice_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_nice_slider_draw(NICE_SLIDER s) { - reinterpret_cast<My_Nice_Slider*>(s)->real_draw(); -} - -void nice_slider_set_handle_hook(NICE_SLIDER s, void * h) { - reinterpret_cast<My_Nice_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_nice_slider_handle(NICE_SLIDER s, int e) { - return reinterpret_cast<My_Nice_Slider*>(s)->real_handle(e); -} - - - - -NICE_SLIDER new_fl_nice_slider(int x, int y, int w, int h, char* label) { - My_Nice_Slider *s = new My_Nice_Slider(x, y, w, h, label); - return s; -} - -void free_fl_nice_slider(NICE_SLIDER s) { - delete reinterpret_cast<My_Nice_Slider*>(s); -} - - diff --git a/src/c_fl_nice_slider.h b/src/c_fl_nice_slider.h deleted file mode 100644 index d07b47e..0000000 --- a/src/c_fl_nice_slider.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_NICE_SLIDER_GUARD -#define FL_NICE_SLIDER_GUARD - - - - -typedef void* NICE_SLIDER; - - - - -extern "C" void nice_slider_set_draw_hook(NICE_SLIDER s, void * d); -extern "C" void fl_nice_slider_draw(NICE_SLIDER s); -extern "C" void nice_slider_set_handle_hook(NICE_SLIDER s, void * h); -extern "C" int fl_nice_slider_handle(NICE_SLIDER s, int e); - - - - -extern "C" NICE_SLIDER new_fl_nice_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_nice_slider(NICE_SLIDER s); - - -#endif - diff --git a/src/c_fl_output.cpp b/src/c_fl_output.cpp deleted file mode 100644 index a367ac5..0000000 --- a/src/c_fl_output.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Output.H> -#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; -}; - -void My_Output::draw() { - (*draw_hook)(this->user_data()); -} - -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<My_Output*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_output_draw(OUTPUTT i) { - reinterpret_cast<My_Output*>(i)->real_draw(); -} - -void output_set_handle_hook(OUTPUTT i, void * h) { - reinterpret_cast<My_Output*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_output_handle(OUTPUTT i, int e) { - return reinterpret_cast<My_Output*>(i)->real_handle(e); -} - - - - -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; -} - -void free_fl_output(OUTPUTT i) { - delete reinterpret_cast<My_Output*>(i); -} - - diff --git a/src/c_fl_output.h b/src/c_fl_output.h deleted file mode 100644 index bb9bf96..0000000 --- a/src/c_fl_output.h +++ /dev/null @@ -1,29 +0,0 @@ - - -#ifndef FL_OUTPUT_GUARD -#define FL_OUTPUT_GUARD - - - - -// using just "OUTPUT" doesn't compile for some reason -// some sort of name clash? -typedef void* OUTPUTT; - - - - -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_overlay_window.cpp b/src/c_fl_overlay_window.cpp deleted file mode 100644 index 84a65f2..0000000 --- a/src/c_fl_overlay_window.cpp +++ /dev/null @@ -1,117 +0,0 @@ - - -#include <FL/Fl_Overlay_Window.H> -#include "c_fl_overlay_window.h" -#include "c_fl_type.h" - - - - -class My_Overlay_Window : public Fl_Overlay_Window { - public: - using Fl_Overlay_Window::Fl_Overlay_Window; - friend void overlay_window_set_draw_hook(OVERLAYWINDOW w, void * d); - friend void fl_overlay_window_draw(OVERLAYWINDOW w); - friend void overlay_window_set_draw_overlay_hook(OVERLAYWINDOW w, void * d); - friend void overlay_window_set_handle_hook(OVERLAYWINDOW w, void * h); - friend int fl_overlay_window_handle(OVERLAYWINDOW w, int e); - friend OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label); - friend OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label); - protected: - void draw(); - void real_draw(); - void draw_overlay(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - d_hook_p draw_overlay_hook; - h_hook_p handle_hook; -}; - -void My_Overlay_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Overlay_Window::real_draw() { - Fl_Overlay_Window::draw(); -} - -void My_Overlay_Window::draw_overlay() { - (*draw_overlay_hook)(this->user_data()); -} - -int My_Overlay_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Overlay_Window::real_handle(int e) { - return Fl_Overlay_Window::handle(e); -} - -void overlay_window_set_draw_hook(OVERLAYWINDOW w, void * d) { - reinterpret_cast<My_Overlay_Window*>(w)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_overlay_window_draw(OVERLAYWINDOW w) { - reinterpret_cast<My_Overlay_Window*>(w)->real_draw(); -} - -void overlay_window_set_draw_overlay_hook(OVERLAYWINDOW w, void * d) { - reinterpret_cast<My_Overlay_Window*>(w)->draw_overlay_hook = reinterpret_cast<d_hook_p>(d); -} - -void overlay_window_set_handle_hook(OVERLAYWINDOW w, void * h) { - reinterpret_cast<My_Overlay_Window*>(w)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_overlay_window_handle(OVERLAYWINDOW w, int e) { - return reinterpret_cast<My_Overlay_Window*>(w)->real_handle(e); -} - - - - -OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label) { - My_Overlay_Window *ow = new My_Overlay_Window(x, y, w, h, label); - return ow; -} - -OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label) { - My_Overlay_Window *ow = new My_Overlay_Window(w, h, label); - return ow; -} - -void free_fl_overlay_window(OVERLAYWINDOW w) { - delete reinterpret_cast<My_Overlay_Window*>(w); -} - - - - -int fl_overlay_window_can_do_overlay(OVERLAYWINDOW w) { - return reinterpret_cast<Fl_Overlay_Window*>(w)->can_do_overlay(); -} - - - - -void fl_overlay_window_show(OVERLAYWINDOW w) { - reinterpret_cast<Fl_Overlay_Window*>(w)->show(); -} - -void fl_overlay_window_hide(OVERLAYWINDOW w) { - reinterpret_cast<Fl_Overlay_Window*>(w)->hide(); -} - -void fl_overlay_window_flush(OVERLAYWINDOW w) { - reinterpret_cast<Fl_Overlay_Window*>(w)->flush(); -} - - - - -void fl_overlay_window_redraw_overlay(OVERLAYWINDOW w) { - reinterpret_cast<Fl_Overlay_Window*>(w)->redraw_overlay(); -} - - diff --git a/src/c_fl_overlay_window.h b/src/c_fl_overlay_window.h deleted file mode 100644 index ab8cb70..0000000 --- a/src/c_fl_overlay_window.h +++ /dev/null @@ -1,42 +0,0 @@ - - -#ifndef FL_OVERLAY_WINDOW_GUARD -#define FL_OVERLAY_WINDOW_GUARD - - - - -typedef void* OVERLAYWINDOW; - - - - -extern "C" void overlay_window_set_draw_hook(OVERLAYWINDOW w, void * d); -extern "C" void fl_overlay_window_draw(OVERLAYWINDOW w); -extern "C" void overlay_window_set_draw_overlay_hook(OVERLAYWINDOW w, void * d); -extern "C" void overlay_window_set_handle_hook(OVERLAYWINDOW w, void * h); -extern "C" int fl_overlay_window_handle(OVERLAYWINDOW w, int e); - - - - -extern "C" OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label); -extern "C" OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label); -extern "C" void free_fl_overlay_window(OVERLAYWINDOW w); - - - - -extern "C" int fl_overlay_window_can_do_overlay(OVERLAYWINDOW w); - - -extern "C" void fl_overlay_window_show(OVERLAYWINDOW w); -extern "C" void fl_overlay_window_hide(OVERLAYWINDOW w); -extern "C" void fl_overlay_window_flush(OVERLAYWINDOW w); - - -extern "C" void fl_overlay_window_redraw_overlay(OVERLAYWINDOW w); - - -#endif - diff --git a/src/c_fl_pack.cpp b/src/c_fl_pack.cpp deleted file mode 100644 index ca52172..0000000 --- a/src/c_fl_pack.cpp +++ /dev/null @@ -1,81 +0,0 @@ - - -#include <FL/Fl_Pack.H> -#include "c_fl_pack.h" -#include "c_fl_type.h" - - - - -class My_Pack : public Fl_Pack { - public: - using Fl_Pack::Fl_Pack; - friend void pack_set_draw_hook(PACK n, void * d); - friend void fl_pack_draw(PACK n); - friend void pack_set_handle_hook(PACK n, void * h); - friend int fl_pack_handle(PACK n, 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_Pack::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Pack::real_draw() { - Fl_Pack::draw(); -} - -int My_Pack::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Pack::real_handle(int e) { - return Fl_Pack::handle(e); -} - -void pack_set_draw_hook(PACK n, void * d) { - reinterpret_cast<My_Pack*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_pack_draw(PACK n) { - reinterpret_cast<My_Pack*>(n)->real_draw(); -} - -void pack_set_handle_hook(PACK n, void * h) { - reinterpret_cast<My_Pack*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_pack_handle(PACK n, int e) { - return reinterpret_cast<My_Pack*>(n)->real_handle(e); -} - - - - -PACK new_fl_pack(int x, int y, int w, int h, char* label) { - My_Pack *b = new My_Pack(x, y, w, h, label); - return b; -} - -void free_fl_pack(PACK p) { - delete reinterpret_cast<My_Pack*>(p); -} - - - - -int fl_pack_get_spacing(PACK p) { - return reinterpret_cast<Fl_Pack*>(p)->spacing(); -} - -void fl_pack_set_spacing(PACK p, int t) { - reinterpret_cast<Fl_Pack*>(p)->spacing(t); -} - - diff --git a/src/c_fl_pack.h b/src/c_fl_pack.h deleted file mode 100644 index debb69c..0000000 --- a/src/c_fl_pack.h +++ /dev/null @@ -1,33 +0,0 @@ - - -#ifndef FL_PACK_GUARD -#define FL_PACK_GUARD - - - - -typedef void* PACK; - - - - -extern "C" void pack_set_draw_hook(PACK n, void * d); -extern "C" void fl_pack_draw(PACK n); -extern "C" void pack_set_handle_hook(PACK n, void * h); -extern "C" int fl_pack_handle(PACK n, int e); - - - - -extern "C" PACK new_fl_pack(int x, int y, int w, int h, char * label); -extern "C" void free_fl_pack(PACK p); - - - - -extern "C" int fl_pack_get_spacing(PACK p); -extern "C" void fl_pack_set_spacing(PACK p, int t); - - -#endif - diff --git a/src/c_fl_paged_device.cpp b/src/c_fl_paged_device.cpp deleted file mode 100644 index 2f60c23..0000000 --- a/src/c_fl_paged_device.cpp +++ /dev/null @@ -1,117 +0,0 @@ - - -#include <FL/Fl_Paged_Device.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_paged_device.h" - - - - -class My_Paged_Device : public Fl_Paged_Device { - public: - using Fl_Paged_Device::Fl_Paged_Device; - friend PAGED_DEVICE new_fl_paged_device(void); -}; - - - - -PAGED_DEVICE new_fl_paged_device(void) { - My_Paged_Device *p = new My_Paged_Device(); - return p; -} - -void free_fl_paged_device(PAGED_DEVICE p) { - delete reinterpret_cast<My_Paged_Device*>(p); -} - - - - -int fl_paged_device_start_job(PAGED_DEVICE p, int c) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_job(c,0,0); -} - -int fl_paged_device_start_job2(PAGED_DEVICE p, int c, int f, int t) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_job(c,&f,&t); -} - -void fl_paged_device_end_job(PAGED_DEVICE p) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::end_job(); -} - -int fl_paged_device_start_page(PAGED_DEVICE p) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_page(); -} - -int fl_paged_device_end_page(PAGED_DEVICE p) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::end_page(); -} - - - - -void fl_paged_device_margins(PAGED_DEVICE p, int * l, int * t, int * r, int * b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::margins(l,t,r,b); -} - -int fl_paged_device_printable_rect(PAGED_DEVICE p, int * w, int * h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::printable_rect(w,h); -} - -void fl_paged_device_get_origin(PAGED_DEVICE p, int * x, int * y) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::origin(x,y); -} - -void fl_paged_device_set_origin(PAGED_DEVICE p, int x, int y) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::origin(x,y); -} - -void fl_paged_device_rotate(PAGED_DEVICE p, float r) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::rotate(r); -} - -void fl_paged_device_scale(PAGED_DEVICE p, float x, float y) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::scale(x,y); -} - -void fl_paged_device_translate(PAGED_DEVICE p, int x, int y) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::translate(x,y); -} - -void fl_paged_device_untranslate(PAGED_DEVICE p) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::untranslate(); -} - - - - -void fl_paged_device_print_widget(PAGED_DEVICE p, void * i, int dx, int dy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::print_widget(reinterpret_cast<Fl_Widget*>(i),dx,dy); -} - -void fl_paged_device_print_window(PAGED_DEVICE p, void * i, int dx, int dy) { - reinterpret_cast<Fl_Paged_Device*>(p)->print_window(reinterpret_cast<Fl_Window*>(i),dx,dy); -} - -void fl_paged_device_print_window_part(PAGED_DEVICE p, void * i, int x, int y, int w, int h, int dx, int dy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::print_window_part(reinterpret_cast<Fl_Window*>(i),x,y,w,h,dx,dy); -} - - diff --git a/src/c_fl_paged_device.h b/src/c_fl_paged_device.h deleted file mode 100644 index 0d4a7f1..0000000 --- a/src/c_fl_paged_device.h +++ /dev/null @@ -1,43 +0,0 @@ - - -#ifndef FL_PAGED_DEVICE_GUARD -#define FL_PAGED_DEVICE_GUARD - - - - -typedef void* PAGED_DEVICE; - - - - -extern "C" PAGED_DEVICE new_fl_paged_device(void); -extern "C" void free_fl_paged_device(PAGED_DEVICE p); - - - - -extern "C" int fl_paged_device_start_job(PAGED_DEVICE p, int c); -extern "C" int fl_paged_device_start_job2(PAGED_DEVICE p, int c, int f, int t); -extern "C" void fl_paged_device_end_job(PAGED_DEVICE p); -extern "C" int fl_paged_device_start_page(PAGED_DEVICE p); -extern "C" int fl_paged_device_end_page(PAGED_DEVICE p); - - -extern "C" void fl_paged_device_margins(PAGED_DEVICE p, int * l, int * t, int * r, int * b); -extern "C" int fl_paged_device_printable_rect(PAGED_DEVICE p, int * w, int * h); -extern "C" void fl_paged_device_get_origin(PAGED_DEVICE p, int * x, int * y); -extern "C" void fl_paged_device_set_origin(PAGED_DEVICE p, int x, int y); -extern "C" void fl_paged_device_rotate(PAGED_DEVICE p, float r); -extern "C" void fl_paged_device_scale(PAGED_DEVICE p, float x, float y); -extern "C" void fl_paged_device_translate(PAGED_DEVICE p, int x, int y); -extern "C" void fl_paged_device_untranslate(PAGED_DEVICE p); - - -extern "C" void fl_paged_device_print_widget(PAGED_DEVICE p, void * i, int dx, int dy); -extern "C" void fl_paged_device_print_window(PAGED_DEVICE p, void * i, int dx, int dy); -extern "C" void fl_paged_device_print_window_part(PAGED_DEVICE p, void * i, int x, int y, int w, int h, int dx, int dy); - - -#endif - diff --git a/src/c_fl_pixmap.cpp b/src/c_fl_pixmap.cpp deleted file mode 100644 index 322f98c..0000000 --- a/src/c_fl_pixmap.cpp +++ /dev/null @@ -1,54 +0,0 @@ - - -#include <FL/Fl_Pixmap.H> -#include "c_fl_pixmap.h" - - - - -void free_fl_pixmap(PIXMAP b) { - delete reinterpret_cast<Fl_Pixmap*>(b); -} - -PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Pixmap*>(b)->Fl_Pixmap::copy(w, h); -} - -PIXMAP fl_pixmap_copy2(PIXMAP b) { - return reinterpret_cast<Fl_Pixmap*>(b)->copy(); -} - - - - -void fl_pixmap_color_average(PIXMAP p, int c, float b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Pixmap*>(p)->Fl_Pixmap::color_average(c, b); -} - -void fl_pixmap_desaturate(PIXMAP p) { - // virtual so disable dispatch - reinterpret_cast<Fl_Pixmap*>(p)->Fl_Pixmap::desaturate(); -} - - - - -void fl_pixmap_uncache(PIXMAP p) { - // virtual so disable dispatch - reinterpret_cast<Fl_Pixmap*>(p)->Fl_Pixmap::uncache(); -} - - - - -void fl_pixmap_draw2(PIXMAP b, int x, int y) { - reinterpret_cast<Fl_Pixmap*>(b)->draw(x, y); -} - -void fl_pixmap_draw(PIXMAP b, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Pixmap*>(b)->Fl_Pixmap::draw(x, y, w, h, cx, cy); -} - diff --git a/src/c_fl_pixmap.h b/src/c_fl_pixmap.h deleted file mode 100644 index 1d5a57a..0000000 --- a/src/c_fl_pixmap.h +++ /dev/null @@ -1,31 +0,0 @@ - - -#ifndef FL_PIXMAP_GUARD -#define FL_PIXMAP_GUARD - - - - -typedef void* PIXMAP; - - - - -extern "C" void free_fl_pixmap(PIXMAP b); -extern "C" PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h); -extern "C" PIXMAP fl_pixmap_copy2(PIXMAP b); - - -extern "C" void fl_pixmap_color_average(PIXMAP p, int c, float b); -extern "C" void fl_pixmap_desaturate(PIXMAP p); - - -extern "C" void fl_pixmap_uncache(PIXMAP p); - - -extern "C" void fl_pixmap_draw2(PIXMAP b, int x, int y); -extern "C" void fl_pixmap_draw(PIXMAP b, int x, int y, int w, int h, int cx, int cy); - - -#endif - diff --git a/src/c_fl_png_image.cpp b/src/c_fl_png_image.cpp deleted file mode 100644 index b4fb29a..0000000 --- a/src/c_fl_png_image.cpp +++ /dev/null @@ -1,22 +0,0 @@ - - -#include <FL/Fl_PNG_Image.H> -#include "c_fl_png_image.h" - - - - -PNG_IMAGE new_fl_png_image(const char * f) { - Fl_PNG_Image *p = new Fl_PNG_Image(f); - return p; -} - -PNG_IMAGE new_fl_png_image2(const char *name, void *data, int size) { - Fl_PNG_Image *p = new Fl_PNG_Image(name, reinterpret_cast<uchar*>(data), size); - return p; -} - -void free_fl_png_image(PNG_IMAGE p) { - delete reinterpret_cast<Fl_PNG_Image*>(p); -} - diff --git a/src/c_fl_png_image.h b/src/c_fl_png_image.h deleted file mode 100644 index 7e9a25c..0000000 --- a/src/c_fl_png_image.h +++ /dev/null @@ -1,20 +0,0 @@ - - -#ifndef FL_PNG_IMAGE_GUARD -#define FL_PNG_IMAGE_GUARD - - - - -typedef void* PNG_IMAGE; - - - - -extern "C" PNG_IMAGE new_fl_png_image(const char * f); -extern "C" PNG_IMAGE new_fl_png_image2(const char *name, void *data, int size); -extern "C" void free_fl_png_image(PNG_IMAGE p); - - -#endif - diff --git a/src/c_fl_pnm_image.cpp b/src/c_fl_pnm_image.cpp deleted file mode 100644 index 18303e3..0000000 --- a/src/c_fl_pnm_image.cpp +++ /dev/null @@ -1,17 +0,0 @@ - - -#include <FL/Fl_PNM_Image.H> -#include "c_fl_pnm_image.h" - - - - -PNM_IMAGE new_fl_pnm_image(const char * f) { - Fl_PNM_Image *p = new Fl_PNM_Image(f); - return p; -} - -void free_fl_pnm_image(PNM_IMAGE p) { - delete reinterpret_cast<Fl_PNM_Image*>(p); -} - diff --git a/src/c_fl_pnm_image.h b/src/c_fl_pnm_image.h deleted file mode 100644 index 558780c..0000000 --- a/src/c_fl_pnm_image.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_PNM_IMAGE_GUARD -#define FL_PNM_IMAGE_GUARD - - - - -typedef void* PNM_IMAGE; - - - - -extern "C" PNM_IMAGE new_fl_pnm_image(const char * f); -extern "C" void free_fl_pnm_image(PNM_IMAGE p); - - -#endif - diff --git a/src/c_fl_preferences.cpp b/src/c_fl_preferences.cpp deleted file mode 100644 index bd36806..0000000 --- a/src/c_fl_preferences.cpp +++ /dev/null @@ -1,105 +0,0 @@ - - -#include <FL/Fl_Preferences.H> -#include "c_fl_preferences.h" - - - - -PREFS new_fl_preferences(char * p, char * v, char * a) { - Fl_Preferences *e = new Fl_Preferences(p,v,a); - return e; -} - -void free_fl_preferences(PREFS e) { - delete reinterpret_cast<Fl_Preferences*>(e); -} - - - - -int fl_preferences_entries(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->entries(); -} - -const char * fl_preferences_entry(PREFS e, int i) { - return reinterpret_cast<Fl_Preferences*>(e)->entry(i); -} - -int fl_preferences_entryexists(PREFS e, const char * k) { - return reinterpret_cast<Fl_Preferences*>(e)->entryExists(k); -} - -int fl_preferences_size(PREFS e, const char * k) { - return reinterpret_cast<Fl_Preferences*>(e)->size(k); -} - - - - -int fl_preferences_get_int(PREFS e, const char * k, int& v, int d) { - return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_float(PREFS e, const char * k, float& v, float d) { - return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_double(PREFS e, const char * k, double& v, double d) { - return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d) { - return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - - - - -int fl_preferences_set_int(PREFS e, const char * k, int v) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_float(PREFS e, const char * k, float v) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p); -} - -int fl_preferences_set_double(PREFS e, const char * k, double v) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p); -} - -int fl_preferences_set_str(PREFS e, const char * k, const char * v) { - return reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - - - - -int fl_preferences_deleteentry(PREFS e, const char * k) { - return reinterpret_cast<Fl_Preferences*>(e)->deleteEntry(k); -} - -int fl_preferences_deleteallentries(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->deleteAllEntries(); -} - -int fl_preferences_clear(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->clear(); -} - - - - -void fl_preferences_flush(PREFS e) { - reinterpret_cast<Fl_Preferences*>(e)->flush(); -} - - diff --git a/src/c_fl_preferences.h b/src/c_fl_preferences.h deleted file mode 100644 index e8581c2..0000000 --- a/src/c_fl_preferences.h +++ /dev/null @@ -1,49 +0,0 @@ - - -#ifndef FL_PREFERENCES_GUARD -#define FL_PREFERENCES_GUARD - - - - -typedef void* PREFS; - - - - -extern "C" PREFS new_fl_preferences(char * p, char * v, char * a); -extern "C" void free_fl_preferences(PREFS e); - - - - -extern "C" int fl_preferences_entries(PREFS e); -extern "C" const char * fl_preferences_entry(PREFS e, int i); -extern "C" int fl_preferences_entryexists(PREFS e, const char * k); -extern "C" int fl_preferences_size(PREFS e, const char * k); - - -extern "C" int fl_preferences_get_int(PREFS e, const char * k, int& v, int d); -extern "C" int fl_preferences_get_float(PREFS e, const char * k, float& v, float d); -extern "C" int fl_preferences_get_double(PREFS e, const char * k, double& v, double d); -extern "C" int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d); - - -extern "C" int fl_preferences_set_int(PREFS e, const char * k, int v); -extern "C" int fl_preferences_set_float(PREFS e, const char * k, float v); -extern "C" int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p); -extern "C" int fl_preferences_set_double(PREFS e, const char * k, double v); -extern "C" int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p); -extern "C" int fl_preferences_set_str(PREFS e, const char * k, const char * v); - - -extern "C" int fl_preferences_deleteentry(PREFS e, const char * k); -extern "C" int fl_preferences_deleteallentries(PREFS e); -extern "C" int fl_preferences_clear(PREFS e); - - -extern "C" void fl_preferences_flush(PREFS e); - - -#endif - diff --git a/src/c_fl_printer.cpp b/src/c_fl_printer.cpp deleted file mode 100644 index 614012b..0000000 --- a/src/c_fl_printer.cpp +++ /dev/null @@ -1,96 +0,0 @@ - - -#include <FL/Fl_Printer.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_printer.h" - - - - -PRINTER new_fl_printer(void) { - Fl_Printer *p = new Fl_Printer(); - return p; -} - -void free_fl_printer(PRINTER p) { - delete reinterpret_cast<Fl_Printer*>(p); -} - - - - -int fl_printer_start_job(PRINTER p, int c) { - return reinterpret_cast<Fl_Printer*>(p)->start_job(c,0,0); -} - -int fl_printer_start_job2(PRINTER p, int c, int f, int t) { - return reinterpret_cast<Fl_Printer*>(p)->start_job(c,&f,&t); -} - -void fl_printer_end_job(PRINTER p) { - reinterpret_cast<Fl_Printer*>(p)->end_job(); -} - -int fl_printer_start_page(PRINTER p) { - return reinterpret_cast<Fl_Printer*>(p)->start_page(); -} - -int fl_printer_end_page(PRINTER p) { - return reinterpret_cast<Fl_Printer*>(p)->end_page(); -} - - - - -void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b) { - reinterpret_cast<Fl_Printer*>(p)->margins(l,t,r,b); -} - -int fl_printer_printable_rect(PRINTER p, int * w, int * h) { - return reinterpret_cast<Fl_Printer*>(p)->printable_rect(w,h); -} - -void fl_printer_get_origin(PRINTER p, int * x, int * y) { - reinterpret_cast<Fl_Printer*>(p)->origin(x,y); -} - -void fl_printer_set_origin(PRINTER p, int x, int y) { - reinterpret_cast<Fl_Printer*>(p)->origin(x,y); -} - -void fl_printer_rotate(PRINTER p, float r) { - reinterpret_cast<Fl_Printer*>(p)->rotate(r); -} - -void fl_printer_scale(PRINTER p, float x, float y) { - reinterpret_cast<Fl_Printer*>(p)->scale(x,y); -} - -void fl_printer_translate(PRINTER p, int x, int y) { - reinterpret_cast<Fl_Printer*>(p)->translate(x,y); -} - -void fl_printer_untranslate(PRINTER p) { - reinterpret_cast<Fl_Printer*>(p)->untranslate(); -} - - - - -void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy) { - reinterpret_cast<Fl_Printer*>(p)->print_widget(reinterpret_cast<Fl_Widget*>(i),dx,dy); -} - -void fl_printer_print_window_part(PRINTER p, void * i, int x, int y, int w, int h, int dx, int dy) { - reinterpret_cast<Fl_Printer*>(p)->print_window_part(reinterpret_cast<Fl_Window*>(i),x,y,w,h,dx,dy); -} - - - - -void fl_printer_set_current(PRINTER p) { - reinterpret_cast<Fl_Printer*>(p)->set_current(); -} - - diff --git a/src/c_fl_printer.h b/src/c_fl_printer.h deleted file mode 100644 index 0ae2499..0000000 --- a/src/c_fl_printer.h +++ /dev/null @@ -1,45 +0,0 @@ - - -#ifndef FL_PRINTER_GUARD -#define FL_PRINTER_GUARD - - - - -typedef void* PRINTER; - - - - -extern "C" PRINTER new_fl_printer(void); -extern "C" void free_fl_printer(PRINTER p); - - - - -extern "C" int fl_printer_start_job(PRINTER p, int c); -extern "C" int fl_printer_start_job2(PRINTER p, int c, int f, int t); -extern "C" void fl_printer_end_job(PRINTER p); -extern "C" int fl_printer_start_page(PRINTER p); -extern "C" int fl_printer_end_page(PRINTER p); - - -extern "C" void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b); -extern "C" int fl_printer_printable_rect(PRINTER p, int * w, int * h); -extern "C" void fl_printer_get_origin(PRINTER p, int * x, int * y); -extern "C" void fl_printer_set_origin(PRINTER p, int x, int y); -extern "C" void fl_printer_rotate(PRINTER p, float r); -extern "C" void fl_printer_scale(PRINTER p, float x, float y); -extern "C" void fl_printer_translate(PRINTER p, int x, int y); -extern "C" void fl_printer_untranslate(PRINTER p); - - -extern "C" void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy); -extern "C" void fl_printer_print_window_part(PRINTER p, void * i, int x, int y, int w, int h, int dx, int dy); - - -extern "C" void fl_printer_set_current(PRINTER p); - - -#endif - diff --git a/src/c_fl_progress.cpp b/src/c_fl_progress.cpp deleted file mode 100644 index 342e08b..0000000 --- a/src/c_fl_progress.cpp +++ /dev/null @@ -1,96 +0,0 @@ - - -#include <FL/Fl_Progress.H> -#include "c_fl_progress.h" -#include "c_fl_type.h" - - - - -class My_Progress : public Fl_Progress { - public: - using Fl_Progress::Fl_Progress; - friend void progress_set_draw_hook(PROGRESS p, void * d); - friend void fl_progress_draw(PROGRESS p); - friend void progress_set_handle_hook(PROGRESS p, void * h); - friend int fl_progress_handle(PROGRESS p, 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_Progress::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Progress::real_draw() { - Fl_Progress::draw(); -} - -int My_Progress::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Progress::real_handle(int e) { - return Fl_Progress::handle(e); -} - -void progress_set_draw_hook(PROGRESS p, void * d) { - reinterpret_cast<My_Progress*>(p)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_progress_draw(PROGRESS p) { - reinterpret_cast<My_Progress*>(p)->real_draw(); -} - -void progress_set_handle_hook(PROGRESS p, void * h) { - reinterpret_cast<My_Progress*>(p)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_progress_handle(PROGRESS p, int e) { - return reinterpret_cast<My_Progress*>(p)->real_handle(e); -} - - - - -PROGRESS new_fl_progress(int x, int y, int w, int h, char* label) { - My_Progress *p = new My_Progress(x, y, w, h, label); - return p; -} - -void free_fl_progress(PROGRESS p) { - delete reinterpret_cast<My_Progress*>(p); -} - - - - -float fl_progress_get_minimum(PROGRESS p) { - return reinterpret_cast<Fl_Progress*>(p)->minimum(); -} - -void fl_progress_set_minimum(PROGRESS p, float t) { - reinterpret_cast<Fl_Progress*>(p)->minimum(t); -} - -float fl_progress_get_maximum(PROGRESS p) { - return reinterpret_cast<Fl_Progress*>(p)->maximum(); -} - -void fl_progress_set_maximum(PROGRESS p, float t) { - reinterpret_cast<Fl_Progress*>(p)->maximum(t); -} - -float fl_progress_get_value(PROGRESS p) { - return reinterpret_cast<Fl_Progress*>(p)->value(); -} - -void fl_progress_set_value(PROGRESS p, float t) { - reinterpret_cast<Fl_Progress*>(p)->value(t); -} - diff --git a/src/c_fl_progress.h b/src/c_fl_progress.h deleted file mode 100644 index 0254bfd..0000000 --- a/src/c_fl_progress.h +++ /dev/null @@ -1,37 +0,0 @@ - - -#ifndef FL_PROGRESS_GUARD -#define FL_PROGRESS_GUARD - - - - -typedef void* PROGRESS; - - - - -extern "C" void progress_set_draw_hook(PROGRESS p, void * d); -extern "C" void fl_progress_draw(PROGRESS p); -extern "C" void progress_set_handle_hook(PROGRESS p, void * h); -extern "C" int fl_progress_handle(PROGRESS p, int e); - - - - -extern "C" PROGRESS new_fl_progress(int x, int y, int w, int h, char* label); -extern "C" void free_fl_progress(PROGRESS p); - - - - -extern "C" float fl_progress_get_minimum(PROGRESS p); -extern "C" void fl_progress_set_minimum(PROGRESS p, float t); -extern "C" float fl_progress_get_maximum(PROGRESS p); -extern "C" void fl_progress_set_maximum(PROGRESS p, float t); -extern "C" float fl_progress_get_value(PROGRESS p); -extern "C" void fl_progress_set_value(PROGRESS p, float t); - - -#endif - diff --git a/src/c_fl_radio_button.cpp b/src/c_fl_radio_button.cpp deleted file mode 100644 index 3ae1ca4..0000000 --- a/src/c_fl_radio_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Radio_Button.H> -#include "c_fl_radio_button.h" -#include "c_fl_type.h" - - - - -class My_Radio_Button : public Fl_Radio_Button { - public: - using Fl_Radio_Button::Fl_Radio_Button; - friend void radio_button_set_draw_hook(RADIOBUTTON b, void * d); - friend void fl_radio_button_draw(RADIOBUTTON b); - friend void radio_button_set_handle_hook(RADIOBUTTON b, void * h); - friend int fl_radio_button_handle(RADIOBUTTON b, 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_Radio_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Radio_Button::real_draw() { - Fl_Radio_Button::draw(); -} - -int My_Radio_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Radio_Button::real_handle(int e) { - return Fl_Radio_Button::handle(e); -} - -void radio_button_set_draw_hook(RADIOBUTTON b, void * d) { - reinterpret_cast<My_Radio_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_radio_button_draw(RADIOBUTTON b) { - reinterpret_cast<My_Radio_Button*>(b)->real_draw(); -} - -void radio_button_set_handle_hook(RADIOBUTTON b, void * h) { - reinterpret_cast<My_Radio_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_radio_button_handle(RADIOBUTTON b, int e) { - return reinterpret_cast<My_Radio_Button*>(b)->real_handle(e); -} - - - - -RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label) { - My_Radio_Button *b = new My_Radio_Button(x, y, w, h, label); - return b; -} - -void free_fl_radio_button(RADIOBUTTON b) { - delete reinterpret_cast<My_Radio_Button*>(b); -} - diff --git a/src/c_fl_radio_button.h b/src/c_fl_radio_button.h deleted file mode 100644 index 0a517e8..0000000 --- a/src/c_fl_radio_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_RADIO_BUTTON_GUARD -#define FL_RADIO_BUTTON_GUARD - - - - -typedef void* RADIOBUTTON; - - - - -extern "C" void radio_button_set_draw_hook(RADIOBUTTON b, void * d); -extern "C" void fl_radio_button_draw(RADIOBUTTON b); -extern "C" void radio_button_set_handle_hook(RADIOBUTTON b, void * h); -extern "C" int fl_radio_button_handle(RADIOBUTTON b, int e); - - - - -extern "C" RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_button(RADIOBUTTON b); - - -#endif - diff --git a/src/c_fl_radio_light_button.cpp b/src/c_fl_radio_light_button.cpp deleted file mode 100644 index e750712..0000000 --- a/src/c_fl_radio_light_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Radio_Light_Button.H> -#include "c_fl_radio_light_button.h" -#include "c_fl_type.h" - - - - -class My_Radio_Light_Button : public Fl_Radio_Light_Button { - public: - using Fl_Radio_Light_Button::Fl_Radio_Light_Button; - friend void radio_light_button_set_draw_hook(RADIOLIGHTBUTTON b, void * d); - friend void fl_radio_light_button_draw(RADIOLIGHTBUTTON b); - friend void radio_light_button_set_handle_hook(RADIOLIGHTBUTTON b, void * h); - friend int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, 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_Radio_Light_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Radio_Light_Button::real_draw() { - Fl_Radio_Light_Button::draw(); -} - -int My_Radio_Light_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Radio_Light_Button::real_handle(int e) { - return Fl_Radio_Light_Button::handle(e); -} - -void radio_light_button_set_draw_hook(RADIOLIGHTBUTTON b, void * d) { - reinterpret_cast<My_Radio_Light_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_radio_light_button_draw(RADIOLIGHTBUTTON b) { - reinterpret_cast<My_Radio_Light_Button*>(b)->real_draw(); -} - -void radio_light_button_set_handle_hook(RADIOLIGHTBUTTON b, void * h) { - reinterpret_cast<My_Radio_Light_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e) { - return reinterpret_cast<My_Radio_Light_Button*>(b)->real_handle(e); -} - - - - -RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label) { - My_Radio_Light_Button *b = new My_Radio_Light_Button(x, y, w, h, label); - return b; -} - -void free_fl_radio_light_button(RADIOLIGHTBUTTON b) { - delete reinterpret_cast<My_Radio_Light_Button*>(b); -} - diff --git a/src/c_fl_radio_light_button.h b/src/c_fl_radio_light_button.h deleted file mode 100644 index 57d56b0..0000000 --- a/src/c_fl_radio_light_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_RADIO_LIGHT_BUTTON_GUARD -#define FL_RADIO_LIGHT_BUTTON_GUARD - - - - -typedef void* RADIOLIGHTBUTTON; - - - - -extern "C" void radio_light_button_set_draw_hook(RADIOLIGHTBUTTON b, void * d); -extern "C" void fl_radio_light_button_draw(RADIOLIGHTBUTTON b); -extern "C" void radio_light_button_set_handle_hook(RADIOLIGHTBUTTON b, void * h); -extern "C" int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e); - - - - -extern "C" RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_light_button(RADIOLIGHTBUTTON b); - - -#endif - diff --git a/src/c_fl_radio_round_button.cpp b/src/c_fl_radio_round_button.cpp deleted file mode 100644 index d51cacb..0000000 --- a/src/c_fl_radio_round_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Radio_Round_Button.H> -#include "c_fl_radio_round_button.h" -#include "c_fl_type.h" - - - - -class My_Radio_Round_Button : public Fl_Radio_Round_Button { - public: - using Fl_Radio_Round_Button::Fl_Radio_Round_Button; - friend void radio_round_button_set_draw_hook(RADIOROUNDBUTTON b, void * d); - friend void fl_radio_round_button_draw(RADIOROUNDBUTTON b); - friend void radio_round_button_set_handle_hook(RADIOROUNDBUTTON b, void * h); - friend int fl_radio_round_button_handle(RADIOROUNDBUTTON b, 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_Radio_Round_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Radio_Round_Button::real_draw() { - Fl_Radio_Round_Button::draw(); -} - -int My_Radio_Round_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Radio_Round_Button::real_handle(int e) { - return Fl_Radio_Round_Button::handle(e); -} - -void radio_round_button_set_draw_hook(RADIOROUNDBUTTON b, void * d) { - reinterpret_cast<My_Radio_Round_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_radio_round_button_draw(RADIOROUNDBUTTON b) { - reinterpret_cast<My_Radio_Round_Button*>(b)->real_draw(); -} - -void radio_round_button_set_handle_hook(RADIOROUNDBUTTON b, void * h) { - reinterpret_cast<My_Radio_Round_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e) { - return reinterpret_cast<My_Radio_Round_Button*>(b)->real_handle(e); -} - - - - -RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label) { - My_Radio_Round_Button *b = new My_Radio_Round_Button(x, y, w, h, label); - return b; -} - -void free_fl_radio_round_button(RADIOROUNDBUTTON b) { - delete reinterpret_cast<My_Radio_Round_Button*>(b); -} - diff --git a/src/c_fl_radio_round_button.h b/src/c_fl_radio_round_button.h deleted file mode 100644 index 04c8748..0000000 --- a/src/c_fl_radio_round_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_RADIO_ROUND_BUTTON_GUARD -#define FL_RADIO_ROUND_BUTTON_GUARD - - - - -typedef void* RADIOROUNDBUTTON; - - - - -extern "C" void radio_round_button_set_draw_hook(RADIOROUNDBUTTON b, void * d); -extern "C" void fl_radio_round_button_draw(RADIOROUNDBUTTON b); -extern "C" void radio_round_button_set_handle_hook(RADIOROUNDBUTTON b, void * h); -extern "C" int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e); - - - - -extern "C" RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_round_button(RADIOROUNDBUTTON b); - - -#endif - diff --git a/src/c_fl_repeat_button.cpp b/src/c_fl_repeat_button.cpp deleted file mode 100644 index d8fef46..0000000 --- a/src/c_fl_repeat_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Repeat_Button.H> -#include "c_fl_repeat_button.h" -#include "c_fl_type.h" - - - - -class My_Repeat_Button : public Fl_Repeat_Button { - public: - using Fl_Repeat_Button::Fl_Repeat_Button; - friend void repeat_button_set_draw_hook(REPEATBUTTON b, void * d); - friend void fl_repeat_button_draw(REPEATBUTTON b); - friend void repeat_button_set_handle_hook(REPEATBUTTON b, void * h); - friend int fl_repeat_button_handle(REPEATBUTTON b, 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_Repeat_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Repeat_Button::real_draw() { - Fl_Repeat_Button::draw(); -} - -int My_Repeat_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Repeat_Button::real_handle(int e) { - return Fl_Repeat_Button::handle(e); -} - -void repeat_button_set_draw_hook(REPEATBUTTON b, void * d) { - reinterpret_cast<My_Repeat_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_repeat_button_draw(REPEATBUTTON b) { - reinterpret_cast<My_Repeat_Button*>(b)->real_draw(); -} - -void repeat_button_set_handle_hook(REPEATBUTTON b, void * h) { - reinterpret_cast<My_Repeat_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_repeat_button_handle(REPEATBUTTON b, int e) { - return reinterpret_cast<My_Repeat_Button*>(b)->real_handle(e); -} - - - - -REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label) { - My_Repeat_Button *b = new My_Repeat_Button(x, y, w, h, label); - return b; -} - -void free_fl_repeat_button(REPEATBUTTON b) { - delete reinterpret_cast<My_Repeat_Button*>(b); -} - diff --git a/src/c_fl_repeat_button.h b/src/c_fl_repeat_button.h deleted file mode 100644 index fdc3320..0000000 --- a/src/c_fl_repeat_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_REPEAT_BUTTON_GUARD -#define FL_REPEAT_BUTTON_GUARD - - - - -typedef void* REPEATBUTTON; - - - - -extern "C" void repeat_button_set_draw_hook(REPEATBUTTON b, void * d); -extern "C" void fl_repeat_button_draw(REPEATBUTTON b); -extern "C" void repeat_button_set_handle_hook(REPEATBUTTON b, void * h); -extern "C" int fl_repeat_button_handle(REPEATBUTTON b, int e); - - - - -extern "C" REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_repeat_button(REPEATBUTTON b); - - -#endif - diff --git a/src/c_fl_return_button.cpp b/src/c_fl_return_button.cpp deleted file mode 100644 index eced86d..0000000 --- a/src/c_fl_return_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Return_Button.H> -#include "c_fl_return_button.h" -#include "c_fl_type.h" - - - - -class My_Return_Button : public Fl_Return_Button { - public: - using Fl_Return_Button::Fl_Return_Button; - friend void return_button_set_draw_hook(RETURNBUTTON b, void * d); - friend void fl_return_button_draw(RETURNBUTTON b); - friend void return_button_set_handle_hook(RETURNBUTTON b, void * h); - friend int fl_return_button_handle(RETURNBUTTON b, 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_Return_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Return_Button::real_draw() { - Fl_Return_Button::draw(); -} - -int My_Return_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Return_Button::real_handle(int e) { - return Fl_Return_Button::handle(e); -} - -void return_button_set_draw_hook(RETURNBUTTON b, void * d) { - reinterpret_cast<My_Return_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_return_button_draw(RETURNBUTTON b) { - reinterpret_cast<My_Return_Button*>(b)->real_draw(); -} - -void return_button_set_handle_hook(RETURNBUTTON b, void * h) { - reinterpret_cast<My_Return_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_return_button_handle(RETURNBUTTON b, int e) { - return reinterpret_cast<My_Return_Button*>(b)->real_handle(e); -} - - - - -RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label) { - My_Return_Button *b = new My_Return_Button(x, y, w, h, label); - return b; -} - -void free_fl_return_button(RETURNBUTTON b) { - delete reinterpret_cast<My_Return_Button*>(b); -} - diff --git a/src/c_fl_return_button.h b/src/c_fl_return_button.h deleted file mode 100644 index 59928a7..0000000 --- a/src/c_fl_return_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_RETURN_BUTTON_GUARD -#define FL_RETURN_BUTTON_GUARD - - - - -typedef void* RETURNBUTTON; - - - - -extern "C" void return_button_set_draw_hook(RETURNBUTTON b, void * d); -extern "C" void fl_return_button_draw(RETURNBUTTON b); -extern "C" void return_button_set_handle_hook(RETURNBUTTON b, void * h); -extern "C" int fl_return_button_handle(RETURNBUTTON b, int e); - - - - -extern "C" RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_return_button(RETURNBUTTON b); - - -#endif - diff --git a/src/c_fl_rgb_image.cpp b/src/c_fl_rgb_image.cpp deleted file mode 100644 index adde3e4..0000000 --- a/src/c_fl_rgb_image.cpp +++ /dev/null @@ -1,74 +0,0 @@ - - -#include <FL/Fl_RGB_Image.H> -#include <FL/Fl_Pixmap.H> -#include "c_fl_rgb_image.h" - - - - -RGB_IMAGE new_fl_rgb_image(void *data, int w, int h, int d, int ld) { - Fl_RGB_Image *rgb = new Fl_RGB_Image(reinterpret_cast<uchar*>(data), w, h, d, ld); - return rgb; -} - -RGB_IMAGE new_fl_rgb_image2(void *pix, unsigned int c) { - Fl_RGB_Image *rgb = new Fl_RGB_Image(reinterpret_cast<Fl_Pixmap*>(pix), c); - return rgb; -} - -void free_fl_rgb_image(RGB_IMAGE i) { - delete reinterpret_cast<Fl_RGB_Image*>(i); -} - -size_t fl_rgb_image_get_max_size() { - return Fl_RGB_Image::max_size(); -} - -void fl_rgb_image_set_max_size(size_t v) { - Fl_RGB_Image::max_size(v); -} - -RGB_IMAGE fl_rgb_image_copy(RGB_IMAGE i, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::copy(w, h); -} - -RGB_IMAGE fl_rgb_image_copy2(RGB_IMAGE i) { - return reinterpret_cast<Fl_RGB_Image*>(i)->copy(); -} - - - - -void fl_rgb_image_color_average(RGB_IMAGE i, int c, float b) { - // virtual so disable dispatch - reinterpret_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::color_average(c, b); -} - -void fl_rgb_image_desaturate(RGB_IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::desaturate(); -} - - - - -void fl_rgb_image_uncache(RGB_IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::uncache(); -} - - - - -void fl_rgb_image_draw2(RGB_IMAGE i, int x, int y) { - reinterpret_cast<Fl_RGB_Image*>(i)->draw(x, y); -} - -void fl_rgb_image_draw(RGB_IMAGE i, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::draw(x, y, w, h, cx, cy); -} - - diff --git a/src/c_fl_rgb_image.h b/src/c_fl_rgb_image.h deleted file mode 100644 index 0e32539..0000000 --- a/src/c_fl_rgb_image.h +++ /dev/null @@ -1,37 +0,0 @@ - - -#ifndef FL_RGB_IMAGE_GUARD -#define FL_RGB_IMAGE_GUARD - - - - -typedef void* RGB_IMAGE; - - - - -extern "C" RGB_IMAGE new_fl_rgb_image(void *data, int w, int h, int d, int ld); -extern "C" RGB_IMAGE new_fl_rgb_image2(void *pix, unsigned int c); -extern "C" void free_fl_rgb_image(RGB_IMAGE i); -extern "C" size_t fl_rgb_image_get_max_size(); -extern "C" void fl_rgb_image_set_max_size(size_t v); -extern "C" RGB_IMAGE fl_rgb_image_copy(RGB_IMAGE i, int w, int h); -extern "C" RGB_IMAGE fl_rgb_image_copy2(RGB_IMAGE i); - - - - -extern "C" void fl_rgb_image_color_average(RGB_IMAGE i, int c, float b); -extern "C" void fl_rgb_image_desaturate(RGB_IMAGE i); - - -extern "C" void fl_rgb_image_uncache(RGB_IMAGE i); - - -extern "C" void fl_rgb_image_draw2(RGB_IMAGE i, int x, int y); -extern "C" void fl_rgb_image_draw(RGB_IMAGE i, int x, int y, int w, int h, int cx, int cy); - - -#endif - diff --git a/src/c_fl_roller.cpp b/src/c_fl_roller.cpp deleted file mode 100644 index 94ac576..0000000 --- a/src/c_fl_roller.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Roller.H> -#include "c_fl_roller.h" -#include "c_fl_type.h" - - - - -class My_Roller : public Fl_Roller { - public: - using Fl_Roller::Fl_Roller; - friend void roller_set_draw_hook(ROLLER r, void * d); - friend void fl_roller_draw(ROLLER r); - friend void roller_set_handle_hook(ROLLER r, void * h); - friend int fl_roller_handle(ROLLER r, 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_Roller::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Roller::real_draw() { - Fl_Roller::draw(); -} - -int My_Roller::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Roller::real_handle(int e) { - return Fl_Roller::handle(e); -} - -void roller_set_draw_hook(ROLLER r, void * d) { - reinterpret_cast<My_Roller*>(r)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_roller_draw(ROLLER r) { - reinterpret_cast<My_Roller*>(r)->real_draw(); -} - -void roller_set_handle_hook(ROLLER r, void * h) { - reinterpret_cast<My_Roller*>(r)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_roller_handle(ROLLER r, int e) { - return reinterpret_cast<My_Roller*>(r)->real_handle(e); -} - - - - -ROLLER new_fl_roller(int x, int y, int w, int h, char* label) { - My_Roller *r = new My_Roller(x, y, w, h, label); - return r; -} - -void free_fl_roller(ROLLER r) { - delete reinterpret_cast<My_Roller*>(r); -} - - diff --git a/src/c_fl_roller.h b/src/c_fl_roller.h deleted file mode 100644 index 1820eee..0000000 --- a/src/c_fl_roller.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_ROLLER_GUARD -#define FL_ROLLER_GUARD - - - - -typedef void* ROLLER; - - - - -extern "C" void roller_set_draw_hook(ROLLER r, void * d); -extern "C" void fl_roller_draw(ROLLER r); -extern "C" void roller_set_handle_hook(ROLLER r, void * h); -extern "C" int fl_roller_handle(ROLLER r, int e); - - - - -extern "C" ROLLER new_fl_roller(int x, int y, int w, int h, char* label); -extern "C" void free_fl_roller(ROLLER r); - - -#endif - diff --git a/src/c_fl_round_button.cpp b/src/c_fl_round_button.cpp deleted file mode 100644 index 9c82173..0000000 --- a/src/c_fl_round_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Round_Button.H> -#include "c_fl_round_button.h" -#include "c_fl_type.h" - - - - -class My_Round_Button : public Fl_Round_Button { - public: - using Fl_Round_Button::Fl_Round_Button; - friend void round_button_set_draw_hook(ROUNDBUTTON b, void * d); - friend void fl_round_button_draw(ROUNDBUTTON b); - friend void round_button_set_handle_hook(ROUNDBUTTON b, void * h); - friend int fl_round_button_handle(ROUNDBUTTON b, 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_Round_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Round_Button::real_draw() { - Fl_Round_Button::draw(); -} - -int My_Round_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Round_Button::real_handle(int e) { - return Fl_Round_Button::handle(e); -} - -void round_button_set_draw_hook(ROUNDBUTTON b, void * d) { - reinterpret_cast<My_Round_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_round_button_draw(ROUNDBUTTON b) { - reinterpret_cast<My_Round_Button*>(b)->real_draw(); -} - -void round_button_set_handle_hook(ROUNDBUTTON b, void * h) { - reinterpret_cast<My_Round_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_round_button_handle(ROUNDBUTTON b, int e) { - return reinterpret_cast<My_Round_Button*>(b)->real_handle(e); -} - - - - -ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label) { - My_Round_Button *b = new My_Round_Button(x, y, w, h, label); - return b; -} - -void free_fl_round_button(ROUNDBUTTON b) { - delete reinterpret_cast<My_Round_Button*>(b); -} - diff --git a/src/c_fl_round_button.h b/src/c_fl_round_button.h deleted file mode 100644 index f812746..0000000 --- a/src/c_fl_round_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_ROUND_BUTTON_GUARD -#define FL_ROUND_BUTTON_GUARD - - - - -typedef void* ROUNDBUTTON; - - - - -extern "C" void round_button_set_draw_hook(ROUNDBUTTON b, void * d); -extern "C" void fl_round_button_draw(ROUNDBUTTON b); -extern "C" void round_button_set_handle_hook(ROUNDBUTTON b, void * h); -extern "C" int fl_round_button_handle(ROUNDBUTTON b, int e); - - - - -extern "C" ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_round_button(ROUNDBUTTON b); - - -#endif - diff --git a/src/c_fl_round_clock.cpp b/src/c_fl_round_clock.cpp deleted file mode 100644 index c37fd77..0000000 --- a/src/c_fl_round_clock.cpp +++ /dev/null @@ -1,78 +0,0 @@ - - -#include <FL/Fl_Round_Clock.H> -#include "c_fl_round_clock.h" -#include "c_fl_type.h" - - - - -class My_Round_Clock : public Fl_Round_Clock { - public: - using Fl_Round_Clock::Fl_Round_Clock; - friend void round_clock_set_draw_hook(ROUND_CLOCK c, void * d); - friend void fl_round_clock_draw(ROUND_CLOCK c); - friend void round_clock_set_handle_hook(ROUND_CLOCK c, void * h); - friend int fl_round_clock_handle(ROUND_CLOCK c, int e); - friend void fl_round_clock_draw2(ROUND_CLOCK c, int x, int y, int w, int h); - 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_Round_Clock::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Round_Clock::real_draw() { - Fl_Round_Clock::draw(); -} - -int My_Round_Clock::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Round_Clock::real_handle(int e) { - return Fl_Round_Clock::handle(e); -} - -void round_clock_set_draw_hook(ROUND_CLOCK c, void * d) { - reinterpret_cast<My_Round_Clock*>(c)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_round_clock_draw(ROUND_CLOCK c) { - reinterpret_cast<My_Round_Clock*>(c)->real_draw(); -} - -void round_clock_set_handle_hook(ROUND_CLOCK c, void * h) { - reinterpret_cast<My_Round_Clock*>(c)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_round_clock_handle(ROUND_CLOCK c, int e) { - return reinterpret_cast<My_Round_Clock*>(c)->real_handle(e); -} - - - - -ROUND_CLOCK new_fl_round_clock(int x, int y, int w, int h, char* label) { - My_Round_Clock *c = new My_Round_Clock(x, y, w, h, label); - return c; -} - -void free_fl_round_clock(ROUND_CLOCK c) { - delete reinterpret_cast<My_Round_Clock*>(c); -} - - - - -void fl_round_clock_draw2(ROUND_CLOCK c, int x, int y, int w, int h) { - reinterpret_cast<My_Round_Clock*>(c)->Fl_Round_Clock::draw(x,y,w,h); -} - - diff --git a/src/c_fl_round_clock.h b/src/c_fl_round_clock.h deleted file mode 100644 index 20d4721..0000000 --- a/src/c_fl_round_clock.h +++ /dev/null @@ -1,32 +0,0 @@ - - -#ifndef FL_ROUND_CLOCK_GUARD -#define FL_ROUND_CLOCK_GUARD - - - - -typedef void* ROUND_CLOCK; - - - - -extern "C" void round_clock_set_draw_hook(ROUND_CLOCK c, void * d); -extern "C" void fl_round_clock_draw(ROUND_CLOCK c); -extern "C" void round_clock_set_handle_hook(ROUND_CLOCK c, void * h); -extern "C" int fl_round_clock_handle(ROUND_CLOCK c, int e); - - - - -extern "C" ROUND_CLOCK new_fl_round_clock(int x, int y, int w, int h, char* label); -extern "C" void free_fl_round_clock(ROUND_CLOCK c); - - - - -extern "C" void fl_round_clock_draw2(ROUND_CLOCK c, int x, int y, int w, int h); - - -#endif - diff --git a/src/c_fl_screen.cpp b/src/c_fl_screen.cpp deleted file mode 100644 index 7db7741..0000000 --- a/src/c_fl_screen.cpp +++ /dev/null @@ -1,80 +0,0 @@ - - -#include <FL/Fl.H> -#include "c_fl_screen.h" - - -int fl_screen_x() { - return Fl::x(); -} - -int fl_screen_y() { - return Fl::y(); -} - -int fl_screen_w() { - return Fl::w(); -} - -int fl_screen_h() { - return Fl::h(); -} - - - - -int fl_screen_count() { - return Fl::screen_count(); -} - -void fl_screen_dpi(float &h, float &v, int n) { - Fl::screen_dpi(h, v, n); -} - - - - -int fl_screen_num(int x, int y) { - return Fl::screen_num(x, y); -} - - -int fl_screen_num2(int x, int y, int w, int h) { - return Fl::screen_num(x, y, w, h); -} - - - - -void fl_screen_work_area(int &x, int &y, int &w, int &h, int px, int py) { - Fl::screen_work_area(x, y, w, h, px, py); -} - -void fl_screen_work_area2(int &x, int &y, int &w, int &h, int n) { - Fl::screen_work_area(x, y, w, h, n); -} - -void fl_screen_work_area3(int &x, int &y, int &w, int &h) { - Fl::screen_work_area(x, y, w, h); -} - - - - -void fl_screen_xywh(int &x, int &y, int &w, int &h, int px, int py) { - Fl::screen_xywh(x, y, w, h, px, py); -} - -void fl_screen_xywh2(int &x, int &y, int &w, int &h, int n) { - Fl::screen_xywh(x, y, w, h, n); -} - -void fl_screen_xywh3(int &x, int &y, int &w, int &h) { - Fl::screen_xywh(x, y, w, h); -} - -void fl_screen_xywh4(int &x, int &y, int &w, int &h, int px, int py, int pw, int ph) { - Fl::screen_xywh(x, y, w, h, px, py, pw, ph); -} - - diff --git a/src/c_fl_screen.h b/src/c_fl_screen.h deleted file mode 100644 index 58d94c5..0000000 --- a/src/c_fl_screen.h +++ /dev/null @@ -1,35 +0,0 @@ - - -#ifndef FL_SCREEN_GUARD -#define FL_SCREEN_GUARD - - - - -extern "C" int fl_screen_x(); -extern "C" int fl_screen_y(); -extern "C" int fl_screen_w(); -extern "C" int fl_screen_h(); - - -extern "C" int fl_screen_count(); -extern "C" void fl_screen_dpi(float &h, float &v, int n); - - -extern "C" int fl_screen_num(int x, int y); -extern "C" int fl_screen_num2(int x, int y, int w, int h); - - -extern "C" void fl_screen_work_area(int &x, int &y, int &w, int &h, int px, int py); -extern "C" void fl_screen_work_area2(int &x, int &y, int &w, int &h, int n); -extern "C" void fl_screen_work_area3(int &x, int &y, int &w, int &h); - - -extern "C" void fl_screen_xywh(int &x, int &y, int &w, int &h, int px, int py); -extern "C" void fl_screen_xywh2(int &x, int &y, int &w, int &h, int n); -extern "C" void fl_screen_xywh3(int &x, int &y, int &w, int &h); -extern "C" void fl_screen_xywh4(int &x, int &y, int &w, int &h, int px, int py, int pw, int ph); - - -#endif - diff --git a/src/c_fl_scroll.cpp b/src/c_fl_scroll.cpp deleted file mode 100644 index 281446a..0000000 --- a/src/c_fl_scroll.cpp +++ /dev/null @@ -1,106 +0,0 @@ - - -#include <FL/Fl_Scroll.H> -#include "c_fl_scroll.h" -#include "c_fl_type.h" - - - - -class My_Scroll : public Fl_Scroll { - public: - using Fl_Scroll::Fl_Scroll; - friend void scroll_set_draw_hook(SCROLL s, void * d); - friend void fl_scroll_draw(SCROLL s); - friend void scroll_set_handle_hook(SCROLL s, void * h); - friend int fl_scroll_handle(SCROLL s, 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_Scroll::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Scroll::real_draw() { - Fl_Scroll::draw(); -} - -int My_Scroll::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Scroll::real_handle(int e) { - return Fl_Scroll::handle(e); -} - -void scroll_set_draw_hook(SCROLL s, void * d) { - reinterpret_cast<My_Scroll*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_scroll_draw(SCROLL s) { - reinterpret_cast<My_Scroll*>(s)->real_draw(); -} - -void scroll_set_handle_hook(SCROLL s, void * h) { - reinterpret_cast<My_Scroll*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_scroll_handle(SCROLL s, int e) { - return reinterpret_cast<My_Scroll*>(s)->real_handle(e); -} - - - - -SCROLL new_fl_scroll(int x, int y, int w, int h, char* label) { - My_Scroll *s = new My_Scroll(x, y, w, h, label); - return s; -} - -void free_fl_scroll(SCROLL s) { - delete reinterpret_cast<My_Scroll*>(s); -} - - - - -void fl_scroll_clear(SCROLL s) { - reinterpret_cast<Fl_Scroll*>(s)->clear(); -} - - - - -void fl_scroll_to(SCROLL s, int x, int y) { - reinterpret_cast<Fl_Scroll*>(s)->scroll_to(x, y); -} - -void fl_scroll_set_type(SCROLL s, int t) { - reinterpret_cast<Fl_Scroll*>(s)->type(t); -} - - - - -int fl_scroll_get_size(SCROLL s) { - return reinterpret_cast<Fl_Scroll*>(s)->scrollbar_size(); -} - -void fl_scroll_set_size(SCROLL s, int t) { - reinterpret_cast<Fl_Scroll*>(s)->scrollbar_size(t); -} - -int fl_scroll_xposition(SCROLL s) { - return reinterpret_cast<Fl_Scroll*>(s)->xposition(); -} - -int fl_scroll_yposition(SCROLL s) { - return reinterpret_cast<Fl_Scroll*>(s)->yposition(); -} - diff --git a/src/c_fl_scroll.h b/src/c_fl_scroll.h deleted file mode 100644 index 37c9e95..0000000 --- a/src/c_fl_scroll.h +++ /dev/null @@ -1,42 +0,0 @@ - - -#ifndef FL_SCROLL_GUARD -#define FL_SCROLL_GUARD - - - - -typedef void* SCROLL; - - - - -extern "C" void scroll_set_draw_hook(SCROLL s, void * d); -extern "C" void fl_scroll_draw(SCROLL s); -extern "C" void scroll_set_handle_hook(SCROLL s, void * h); -extern "C" int fl_scroll_handle(SCROLL s, int e); - - - - -extern "C" SCROLL new_fl_scroll(int x, int y, int w, int h, char* label); -extern "C" void free_fl_scroll(SCROLL s); - - - - -extern "C" void fl_scroll_clear(SCROLL s); - - -extern "C" void fl_scroll_to(SCROLL s, int x, int y); -extern "C" void fl_scroll_set_type(SCROLL s, int t); - - -extern "C" int fl_scroll_get_size(SCROLL s); -extern "C" void fl_scroll_set_size(SCROLL s, int t); -extern "C" int fl_scroll_xposition(SCROLL s); -extern "C" int fl_scroll_yposition(SCROLL s); - - -#endif - diff --git a/src/c_fl_scrollbar.cpp b/src/c_fl_scrollbar.cpp deleted file mode 100644 index 0301f43..0000000 --- a/src/c_fl_scrollbar.cpp +++ /dev/null @@ -1,92 +0,0 @@ - - -#include <FL/Fl_Scrollbar.H> -#include "c_fl_scrollbar.h" -#include "c_fl_type.h" - - - - -class My_Scrollbar : public Fl_Scrollbar { - public: - using Fl_Scrollbar::Fl_Scrollbar; - friend void scrollbar_set_draw_hook(SCROLLBAR s, void * d); - friend void fl_scrollbar_draw(SCROLLBAR s); - friend void scrollbar_set_handle_hook(SCROLLBAR s, void * h); - friend int fl_scrollbar_handle(SCROLLBAR s, 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_Scrollbar::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Scrollbar::real_draw() { - Fl_Scrollbar::draw(); -} - -int My_Scrollbar::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Scrollbar::real_handle(int e) { - return Fl_Scrollbar::handle(e); -} - -void scrollbar_set_draw_hook(SCROLLBAR s, void * d) { - reinterpret_cast<My_Scrollbar*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_scrollbar_draw(SCROLLBAR s) { - reinterpret_cast<My_Scrollbar*>(s)->real_draw(); -} - -void scrollbar_set_handle_hook(SCROLLBAR s, void * h) { - reinterpret_cast<My_Scrollbar*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_scrollbar_handle(SCROLLBAR s, int e) { - return reinterpret_cast<My_Scrollbar*>(s)->real_handle(e); -} - - - - -SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label) { - My_Scrollbar *s = new My_Scrollbar(x, y, w, h, label); - return s; -} - -void free_fl_scrollbar(SCROLLBAR s) { - delete reinterpret_cast<My_Scrollbar*>(s); -} - - - - -int fl_scrollbar_get_linesize(SCROLLBAR s) { - return reinterpret_cast<Fl_Scrollbar*>(s)->linesize(); -} - -void fl_scrollbar_set_linesize(SCROLLBAR s, int t) { - reinterpret_cast<Fl_Scrollbar*>(s)->linesize(t); -} - -int fl_scrollbar_get_value(SCROLLBAR s) { - return reinterpret_cast<Fl_Scrollbar*>(s)->value(); -} - -void fl_scrollbar_set_value(SCROLLBAR s, int t) { - reinterpret_cast<Fl_Scrollbar*>(s)->value(t); -} - -void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t) { - reinterpret_cast<Fl_Scrollbar*>(s)->value(p,w,f,t); -} - diff --git a/src/c_fl_scrollbar.h b/src/c_fl_scrollbar.h deleted file mode 100644 index 311abfa..0000000 --- a/src/c_fl_scrollbar.h +++ /dev/null @@ -1,36 +0,0 @@ - - -#ifndef FL_SCROLLBAR_GUARD -#define FL_SCROLLBAR_GUARD - - - - -typedef void* SCROLLBAR; - - - - -extern "C" void scrollbar_set_draw_hook(SCROLLBAR s, void * d); -extern "C" void fl_scrollbar_draw(SCROLLBAR s); -extern "C" void scrollbar_set_handle_hook(SCROLLBAR s, void * h); -extern "C" int fl_scrollbar_handle(SCROLLBAR s, int e); - - - - -extern "C" SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label); -extern "C" void free_fl_scrollbar(SCROLLBAR s); - - - - -extern "C" int fl_scrollbar_get_linesize(SCROLLBAR s); -extern "C" void fl_scrollbar_set_linesize(SCROLLBAR s, int t); -extern "C" int fl_scrollbar_get_value(SCROLLBAR s); -extern "C" void fl_scrollbar_set_value(SCROLLBAR s, int t); -extern "C" void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t); - - -#endif - diff --git a/src/c_fl_secret_input.cpp b/src/c_fl_secret_input.cpp deleted file mode 100644 index 1c91370..0000000 --- a/src/c_fl_secret_input.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Secret_Input.H> -#include "c_fl_secret_input.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Secret_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Secret_Input::real_draw() { - Fl_Secret_Input::draw(); -} - -int My_Secret_Input::handle(int e) { - return (*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<My_Secret_Input*>(i)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_secret_input_draw(SECRET_INPUT i) { - reinterpret_cast<My_Secret_Input*>(i)->real_draw(); -} - -void secret_input_set_handle_hook(SECRET_INPUT i, void * h) { - reinterpret_cast<My_Secret_Input*>(i)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_secret_input_handle(SECRET_INPUT i, int e) { - return reinterpret_cast<My_Secret_Input*>(i)->real_handle(e); -} - - - - -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 free_fl_secret_input(SECRET_INPUT i) { - delete reinterpret_cast<My_Secret_Input*>(i); -} - - diff --git a/src/c_fl_secret_input.h b/src/c_fl_secret_input.h deleted file mode 100644 index 604626d..0000000 --- a/src/c_fl_secret_input.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_SECRET_INPUT_GUARD -#define FL_SECRET_INPUT_GUARD - - - - -typedef void* SECRET_INPUT; - - - - -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); - - -#endif - diff --git a/src/c_fl_shared_image.cpp b/src/c_fl_shared_image.cpp deleted file mode 100644 index fd09519..0000000 --- a/src/c_fl_shared_image.cpp +++ /dev/null @@ -1,96 +0,0 @@ - - -#include <FL/Fl_Shared_Image.H> -#include <FL/Fl_RGB_Image.H> -#include "c_fl_shared_image.h" - - - - -SHARED_IMAGE fl_shared_image_get(const char * f, int w, int h) { - return Fl_Shared_Image::get(f, w, h); -} - -SHARED_IMAGE fl_shared_image_get2(void * r) { - return Fl_Shared_Image::get(reinterpret_cast<Fl_RGB_Image*>(r), 0); -} - -SHARED_IMAGE fl_shared_image_find(const char * n, int w, int h) { - return Fl_Shared_Image::find(n, w, h); -} - -void fl_shared_image_release(SHARED_IMAGE i) { - reinterpret_cast<Fl_Shared_Image*>(i)->release(); -} - -SHARED_IMAGE fl_shared_image_copy(SHARED_IMAGE i, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::copy(w, h); -} - -SHARED_IMAGE fl_shared_image_copy2(SHARED_IMAGE i) { - return reinterpret_cast<Fl_Shared_Image*>(i)->copy(); -} - - - - -void fl_shared_image_color_average(SHARED_IMAGE i, int c, float b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::color_average(c, b); -} - -void fl_shared_image_desaturate(SHARED_IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::desaturate(); -} - - - - -int fl_shared_image_num_images() { - return Fl_Shared_Image::num_images(); -} - -const char * fl_shared_image_name(SHARED_IMAGE i) { - return reinterpret_cast<Fl_Shared_Image*>(i)->name(); -} - -int fl_shared_image_original(SHARED_IMAGE i) { - return reinterpret_cast<Fl_Shared_Image*>(i)->original(); -} - -int fl_shared_image_refcount(SHARED_IMAGE i) { - return reinterpret_cast<Fl_Shared_Image*>(i)->refcount(); -} - -void fl_shared_image_reload(SHARED_IMAGE i) { - reinterpret_cast<Fl_Shared_Image*>(i)->reload(); -} - -void fl_shared_image_uncache(SHARED_IMAGE i) { - // virtual so disable dispatch - reinterpret_cast<Fl_Shared_Image*>(i)->uncache(); -} - - - - -void fl_shared_image_scaling_algorithm(int v) { - Fl_Shared_Image::scaling_algorithm(static_cast<Fl_RGB_Scaling>(v)); -} - -void fl_shared_image_scale(SHARED_IMAGE i, int w, int h, int p, int e) { - reinterpret_cast<Fl_Shared_Image*>(i)->scale(w, h, p, e); -} - -void fl_shared_image_draw(SHARED_IMAGE i, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::draw(x, y, w, h, cx, cy); -} - -void fl_shared_image_draw2(SHARED_IMAGE i, int x, int y) { - reinterpret_cast<Fl_Shared_Image*>(i)->draw(x, y); -} - - diff --git a/src/c_fl_shared_image.h b/src/c_fl_shared_image.h deleted file mode 100644 index d7d57f2..0000000 --- a/src/c_fl_shared_image.h +++ /dev/null @@ -1,43 +0,0 @@ - - -#ifndef FL_SHARED_IMAGE_GUARD -#define FL_SHARED_IMAGE_GUARD - - - - -typedef void* SHARED_IMAGE; - - - - -extern "C" SHARED_IMAGE fl_shared_image_get(const char * f, int w, int h); -extern "C" SHARED_IMAGE fl_shared_image_get2(void * r); -extern "C" SHARED_IMAGE fl_shared_image_find(const char * n, int w, int h); -extern "C" void fl_shared_image_release(SHARED_IMAGE i); -extern "C" SHARED_IMAGE fl_shared_image_copy(SHARED_IMAGE i, int w, int h); -extern "C" SHARED_IMAGE fl_shared_image_copy2(SHARED_IMAGE i); - - - - -extern "C" void fl_shared_image_color_average(SHARED_IMAGE i, int c, float b); -extern "C" void fl_shared_image_desaturate(SHARED_IMAGE i); - - -extern "C" int fl_shared_image_num_images(); -extern "C" const char * fl_shared_image_name(SHARED_IMAGE i); -extern "C" int fl_shared_image_original(SHARED_IMAGE i); -extern "C" int fl_shared_image_refcount(SHARED_IMAGE i); -extern "C" void fl_shared_image_reload(SHARED_IMAGE i); -extern "C" void fl_shared_image_uncache(SHARED_IMAGE i); - - -extern "C" void fl_shared_image_scaling_algorithm(int v); -extern "C" void fl_shared_image_scale(SHARED_IMAGE i, int w, int h, int p, int e); -extern "C" void fl_shared_image_draw(SHARED_IMAGE i, int x, int y, int w, int h, int cx, int cy); -extern "C" void fl_shared_image_draw2(SHARED_IMAGE i, int x, int y); - - -#endif - diff --git a/src/c_fl_simple_counter.cpp b/src/c_fl_simple_counter.cpp deleted file mode 100644 index 87ace91..0000000 --- a/src/c_fl_simple_counter.cpp +++ /dev/null @@ -1,70 +0,0 @@ - - -#include <FL/Fl_Simple_Counter.H> -#include "c_fl_simple_counter.h" -#include "c_fl_type.h" - - - - -class My_Simple_Counter : public Fl_Simple_Counter { - public: - using Fl_Simple_Counter::Fl_Simple_Counter; - friend void simple_counter_set_draw_hook(SIMPLE_COUNTER c, void * d); - friend void fl_simple_counter_draw(SIMPLE_COUNTER c); - friend void simple_counter_set_handle_hook(SIMPLE_COUNTER c, void * h); - friend int fl_simple_counter_handle(SIMPLE_COUNTER c, 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_Simple_Counter::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Simple_Counter::real_draw() { - Fl_Simple_Counter::draw(); -} - -int My_Simple_Counter::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Simple_Counter::real_handle(int e) { - return Fl_Simple_Counter::handle(e); -} - -void simple_counter_set_draw_hook(SIMPLE_COUNTER c, void * d) { - reinterpret_cast<My_Simple_Counter*>(c)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_simple_counter_draw(SIMPLE_COUNTER c) { - reinterpret_cast<My_Simple_Counter*>(c)->real_draw(); -} - -void simple_counter_set_handle_hook(SIMPLE_COUNTER c, void * h) { - reinterpret_cast<My_Simple_Counter*>(c)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_simple_counter_handle(SIMPLE_COUNTER c, int e) { - return reinterpret_cast<My_Simple_Counter*>(c)->real_handle(e); -} - - - - -SIMPLE_COUNTER new_fl_simple_counter(int x, int y, int w, int h, char* label) { - My_Simple_Counter *c = new My_Simple_Counter(x, y, w, h, label); - return c; -} - -void free_fl_simple_counter(SIMPLE_COUNTER c) { - delete reinterpret_cast<My_Simple_Counter*>(c); -} - - diff --git a/src/c_fl_simple_counter.h b/src/c_fl_simple_counter.h deleted file mode 100644 index 54c5f19..0000000 --- a/src/c_fl_simple_counter.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_SIMPLE_COUNTER_GUARD -#define FL_SIMPLE_COUNTER_GUARD - - - - -typedef void* SIMPLE_COUNTER; - - - - -extern "C" void simple_counter_set_draw_hook(SIMPLE_COUNTER c, void * d); -extern "C" void fl_simple_counter_draw(SIMPLE_COUNTER c); -extern "C" void simple_counter_set_handle_hook(SIMPLE_COUNTER c, void * h); -extern "C" int fl_simple_counter_handle(SIMPLE_COUNTER c, int e); - - - - -extern "C" SIMPLE_COUNTER new_fl_simple_counter(int x, int y, int w, int h, char* label); -extern "C" void free_fl_simple_counter(SIMPLE_COUNTER c); - - -#endif - diff --git a/src/c_fl_single_window.cpp b/src/c_fl_single_window.cpp deleted file mode 100644 index 35bdd29..0000000 --- a/src/c_fl_single_window.cpp +++ /dev/null @@ -1,85 +0,0 @@ - - -#include <FL/Fl_Single_Window.H> -#include "c_fl_single_window.h" -#include "c_fl_type.h" - - - - -class My_Single_Window : public Fl_Single_Window { - public: - using Fl_Single_Window::Fl_Single_Window; - friend void single_window_set_draw_hook(SINGLEWINDOW n, void * d); - friend void fl_single_window_draw(SINGLEWINDOW n); - friend void single_window_set_handle_hook(SINGLEWINDOW n, void * h); - friend int fl_single_window_handle(SINGLEWINDOW n, 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_Single_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Single_Window::real_draw() { - Fl_Single_Window::draw(); -} - -int My_Single_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Single_Window::real_handle(int e) { - return Fl_Single_Window::handle(e); -} - -void single_window_set_draw_hook(SINGLEWINDOW n, void * d) { - reinterpret_cast<My_Single_Window*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_single_window_draw(SINGLEWINDOW n) { - reinterpret_cast<My_Single_Window*>(n)->real_draw(); -} - -void single_window_set_handle_hook(SINGLEWINDOW n, void * h) { - reinterpret_cast<My_Single_Window*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_single_window_handle(SINGLEWINDOW n, int e) { - return reinterpret_cast<My_Single_Window*>(n)->real_handle(e); -} - - - - -SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) { - My_Single_Window *sw = new My_Single_Window(x, y, w, h, label); - return sw; -} - -SINGLEWINDOW new_fl_single_window2(int x, int y, char* label) { - My_Single_Window *sw = new My_Single_Window(x, y, label); - return sw; -} - -void free_fl_single_window(SINGLEWINDOW w) { - delete reinterpret_cast<My_Single_Window*>(w); -} - - - - -void fl_single_window_show(SINGLEWINDOW w) { - reinterpret_cast<Fl_Single_Window*>(w)->show(); -} - -void fl_single_window_flush(SINGLEWINDOW w) { - reinterpret_cast<Fl_Single_Window*>(w)->flush(); -} - diff --git a/src/c_fl_single_window.h b/src/c_fl_single_window.h deleted file mode 100644 index d1d87da..0000000 --- a/src/c_fl_single_window.h +++ /dev/null @@ -1,34 +0,0 @@ - - -#ifndef FL_SINGLE_WINDOW_GUARD -#define FL_SINGLE_WINDOW_GUARD - - - - -typedef void* SINGLEWINDOW; - - - - -extern "C" void single_window_set_draw_hook(SINGLEWINDOW n, void * d); -extern "C" void fl_single_window_draw(SINGLEWINDOW n); -extern "C" void single_window_set_handle_hook(SINGLEWINDOW n, void * h); -extern "C" int fl_single_window_handle(SINGLEWINDOW n, int e); - - - - -extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label); -extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y, char* label); -extern "C" void free_fl_single_window(SINGLEWINDOW w); - - - - -extern "C" void fl_single_window_show(SINGLEWINDOW w); -extern "C" void fl_single_window_flush(SINGLEWINDOW w); - - -#endif - diff --git a/src/c_fl_slider.cpp b/src/c_fl_slider.cpp deleted file mode 100644 index 48b007f..0000000 --- a/src/c_fl_slider.cpp +++ /dev/null @@ -1,108 +0,0 @@ - - -#include <FL/Fl_Slider.H> -#include "c_fl_slider.h" -#include "c_fl_type.h" - - - - -class My_Slider : public Fl_Slider { - public: - using Fl_Slider::Fl_Slider; - friend void slider_set_draw_hook(SLIDER s, void * d); - friend void fl_slider_draw(SLIDER s); - friend void slider_set_handle_hook(SLIDER s, void * h); - friend int fl_slider_handle(SLIDER s, 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_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Slider::real_draw() { - Fl_Slider::draw(); -} - -int My_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Slider::real_handle(int e) { - return Fl_Slider::handle(e); -} - -void slider_set_draw_hook(SLIDER s, void * d) { - reinterpret_cast<My_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_slider_draw(SLIDER s) { - reinterpret_cast<My_Slider*>(s)->real_draw(); -} - -void slider_set_handle_hook(SLIDER s, void * h) { - reinterpret_cast<My_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_slider_handle(SLIDER s, int e) { - return reinterpret_cast<My_Slider*>(s)->real_handle(e); -} - - - - -SLIDER new_fl_slider(int x, int y, int w, int h, char* label) { - My_Slider *s = new My_Slider(x, y, w, h, label); - return s; -} - -void free_fl_slider(SLIDER s) { - delete reinterpret_cast<My_Slider*>(s); -} - - - - -int fl_slider_get_type(SLIDER s) { - return reinterpret_cast<Fl_Slider*>(s)->type(); -} - -void fl_slider_set_type(SLIDER s, int t) { - reinterpret_cast<Fl_Slider*>(s)->type(t); -} - - - - -void fl_slider_set_bounds(SLIDER s, double a, double b) { - reinterpret_cast<Fl_Slider*>(s)->bounds(a,b); -} - -int fl_slider_get_slider(SLIDER s) { - return reinterpret_cast<Fl_Slider*>(s)->slider(); -} - -void fl_slider_set_slider(SLIDER s, int t) { - reinterpret_cast<Fl_Slider*>(s)->slider(static_cast<Fl_Boxtype>(t)); -} - -float fl_slider_get_slider_size(SLIDER s) { - return reinterpret_cast<Fl_Slider*>(s)->slider_size(); -} - -void fl_slider_set_slider_size(SLIDER s, float t) { - reinterpret_cast<Fl_Slider*>(s)->slider_size(t); -} - -int fl_slider_scrollvalue(SLIDER s, int p, int z, int f, int t) { - return reinterpret_cast<Fl_Slider*>(s)->scrollvalue(p,z,f,t); -} - - diff --git a/src/c_fl_slider.h b/src/c_fl_slider.h deleted file mode 100644 index 3ff6a46..0000000 --- a/src/c_fl_slider.h +++ /dev/null @@ -1,41 +0,0 @@ - - -#ifndef FL_SLIDER_GUARD -#define FL_SLIDER_GUARD - - - - -typedef void* SLIDER; - - - - -extern "C" void slider_set_draw_hook(SLIDER s, void * d); -extern "C" void fl_slider_draw(SLIDER s); -extern "C" void slider_set_handle_hook(SLIDER s, void * h); -extern "C" int fl_slider_handle(SLIDER s, int e); - - - - -extern "C" SLIDER new_fl_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_slider(SLIDER s); - - - - -extern "C" int fl_slider_get_type(SLIDER s); -extern "C" void fl_slider_set_type(SLIDER s, int t); - - -extern "C" void fl_slider_set_bounds(SLIDER s, double a, double b); -extern "C" int fl_slider_get_slider(SLIDER s); -extern "C" void fl_slider_set_slider(SLIDER s, int t); -extern "C" float fl_slider_get_slider_size(SLIDER s); -extern "C" void fl_slider_set_slider_size(SLIDER s, float t); -extern "C" int fl_slider_scrollvalue(SLIDER s, int p, int z, int f, int t); - - -#endif - diff --git a/src/c_fl_spinner.cpp b/src/c_fl_spinner.cpp deleted file mode 100644 index 7fd5938..0000000 --- a/src/c_fl_spinner.cpp +++ /dev/null @@ -1,159 +0,0 @@ - - -#include <FL/Fl_Spinner.H> -#include "c_fl_spinner.h" -#include "c_fl_type.h" - - - - -class My_Spinner : public Fl_Spinner { - public: - using Fl_Spinner::Fl_Spinner; - friend void spinner_set_draw_hook(SPINNER n, void * d); - friend void fl_spinner_draw(SPINNER n); - friend void spinner_set_handle_hook(SPINNER n, void * h); - friend int fl_spinner_handle(SPINNER n, 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_Spinner::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Spinner::real_draw() { - Fl_Spinner::draw(); -} - -int My_Spinner::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Spinner::real_handle(int e) { - return Fl_Spinner::handle(e); -} - -void spinner_set_draw_hook(SPINNER n, void * d) { - reinterpret_cast<My_Spinner*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_spinner_draw(SPINNER n) { - reinterpret_cast<My_Spinner*>(n)->real_draw(); -} - -void spinner_set_handle_hook(SPINNER n, void * h) { - reinterpret_cast<My_Spinner*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_spinner_handle(SPINNER n, int e) { - return reinterpret_cast<My_Spinner*>(n)->real_handle(e); -} - - - - -SPINNER new_fl_spinner(int x, int y, int w, int h, char* label) { - My_Spinner *n = new My_Spinner(x, y, w, h, label); - return n; -} - -void free_fl_spinner(SPINNER n) { - delete reinterpret_cast<My_Spinner*>(n); -} - - - - -unsigned int fl_spinner_get_color(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->color(); -} - -void fl_spinner_set_color(SPINNER n, unsigned int t) { - reinterpret_cast<Fl_Spinner*>(n)->color(t); -} - -unsigned int fl_spinner_get_selection_color(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->selection_color(); -} - -void fl_spinner_set_selection_color(SPINNER n, unsigned int t) { - reinterpret_cast<Fl_Spinner*>(n)->selection_color(t); -} - -unsigned int fl_spinner_get_textcolor(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->textcolor(); -} - -void fl_spinner_set_textcolor(SPINNER n, unsigned int t) { - reinterpret_cast<Fl_Spinner*>(n)->textcolor(t); -} - -int fl_spinner_get_textfont(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->textfont(); -} - -void fl_spinner_set_textfont(SPINNER n, int t) { - reinterpret_cast<Fl_Spinner*>(n)->textfont(t); -} - -int fl_spinner_get_textsize(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->textsize(); -} - -void fl_spinner_set_textsize(SPINNER n, int t) { - reinterpret_cast<Fl_Spinner*>(n)->textsize(t); -} - - - - -double fl_spinner_get_minimum(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->minimum(); -} - -void fl_spinner_set_minimum(SPINNER n, double t) { - reinterpret_cast<Fl_Spinner*>(n)->minimum(t); -} - -double fl_spinner_get_maximum(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->maximum(); -} - -void fl_spinner_set_maximum(SPINNER n, double t) { - reinterpret_cast<Fl_Spinner*>(n)->maximum(t); -} - -void fl_spinner_range(SPINNER n, double a, double b) { - reinterpret_cast<Fl_Spinner*>(n)->range(a,b); -} - -double fl_spinner_get_step(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->step(); -} - -void fl_spinner_set_step(SPINNER n, double t) { - reinterpret_cast<Fl_Spinner*>(n)->step(t); -} - -int fl_spinner_get_type(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->type(); -} - -void fl_spinner_set_type(SPINNER n, int t) { - reinterpret_cast<Fl_Spinner*>(n)->type(t); -} - -double fl_spinner_get_value(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->value(); -} - -void fl_spinner_set_value(SPINNER n, double t) { - reinterpret_cast<Fl_Spinner*>(n)->value(t); -} - diff --git a/src/c_fl_spinner.h b/src/c_fl_spinner.h deleted file mode 100644 index 81fb26f..0000000 --- a/src/c_fl_spinner.h +++ /dev/null @@ -1,54 +0,0 @@ - - -#ifndef FL_SPINNER_GUARD -#define FL_SPINNER_GUARD - - - - -typedef void* SPINNER; - - - - -extern "C" void spinner_set_draw_hook(SPINNER n, void * d); -extern "C" void fl_spinner_draw(SPINNER n); -extern "C" void spinner_set_handle_hook(SPINNER n, void * h); -extern "C" int fl_spinner_handle(SPINNER n, int e); - - - - -extern "C" SPINNER new_fl_spinner(int x, int y, int w, int h, char* label); -extern "C" void free_fl_spinner(SPINNER n); - - - - -extern "C" unsigned int fl_spinner_get_color(SPINNER n); -extern "C" void fl_spinner_set_color(SPINNER n, unsigned int t); -extern "C" unsigned int fl_spinner_get_selection_color(SPINNER n); -extern "C" void fl_spinner_set_selection_color(SPINNER n, unsigned int t); -extern "C" unsigned int fl_spinner_get_textcolor(SPINNER n); -extern "C" void fl_spinner_set_textcolor(SPINNER n, unsigned int t); -extern "C" int fl_spinner_get_textfont(SPINNER n); -extern "C" void fl_spinner_set_textfont(SPINNER n, int t); -extern "C" int fl_spinner_get_textsize(SPINNER n); -extern "C" void fl_spinner_set_textsize(SPINNER n, int t); - - -extern "C" double fl_spinner_get_minimum(SPINNER n); -extern "C" void fl_spinner_set_minimum(SPINNER n, double t); -extern "C" double fl_spinner_get_maximum(SPINNER n); -extern "C" void fl_spinner_set_maximum(SPINNER n, double t); -extern "C" void fl_spinner_range(SPINNER n, double a, double b); -extern "C" double fl_spinner_get_step(SPINNER n); -extern "C" void fl_spinner_set_step(SPINNER n, double t); -extern "C" int fl_spinner_get_type(SPINNER n); -extern "C" void fl_spinner_set_type(SPINNER n, int t); -extern "C" double fl_spinner_get_value(SPINNER n); -extern "C" void fl_spinner_set_value(SPINNER n, double t); - - -#endif - diff --git a/src/c_fl_static.cpp b/src/c_fl_static.cpp deleted file mode 100644 index e520d42..0000000 --- a/src/c_fl_static.cpp +++ /dev/null @@ -1,299 +0,0 @@ - - -#include <FL/Fl.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_static.h" - - - - -void fl_static_add_awake_handler(void * h, void * f) { - Fl::add_awake_handler_(reinterpret_cast<Fl_Awake_Handler>(h),f); -} - -void fl_static_get_awake_handler(void * &h, void * &f) { - Fl::get_awake_handler_(reinterpret_cast<Fl_Awake_Handler&>(h),f); -} - - - - -void fl_static_add_check(void * h, void * f) { - Fl::add_check(reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - -int fl_static_has_check(void * h, void * f) { - return Fl::has_check(reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - -void fl_static_remove_check(void * h, void * f) { - Fl::remove_check(reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - - - - -void fl_static_add_timeout(double s, void * h, void * f) { - Fl::add_timeout(s,reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - -int fl_static_has_timeout(void * h, void * f) { - return Fl::has_timeout(reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - -void fl_static_remove_timeout(void * h, void * f) { - Fl::remove_timeout(reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - -void fl_static_repeat_timeout(double s, void * h, void * f) { - Fl::repeat_timeout(s,reinterpret_cast<Fl_Timeout_Handler>(h),f); -} - - - - -void fl_static_add_clipboard_notify(void * h, void * f) { - Fl::add_clipboard_notify(reinterpret_cast<Fl_Clipboard_Notify_Handler>(h),f); -} - - - - -void fl_static_add_fd(int d, void * h, void * f) { - Fl::add_fd(d,reinterpret_cast<Fl_FD_Handler>(h),f); -} - -void fl_static_add_fd2(int d, int m, void * h, void * f) { - Fl::add_fd(d,m,reinterpret_cast<Fl_FD_Handler>(h),f); -} - -void fl_static_remove_fd(int d) { - Fl::remove_fd(d); -} - -void fl_static_remove_fd2(int d, int m) { - Fl::remove_fd(d,m); -} - - - - -void fl_static_add_idle(void * h, void * f) { - Fl::add_idle(reinterpret_cast<Fl_Idle_Handler>(h),f); -} - -int fl_static_has_idle(void * h, void * f) { - return Fl::has_idle(reinterpret_cast<Fl_Idle_Handler>(h),f); -} - -void fl_static_remove_idle(void * h, void * f) { - Fl::remove_idle(reinterpret_cast<Fl_Idle_Handler>(h),f); -} - - - - -void fl_static_get_color(unsigned int c, unsigned char &r, unsigned char &g, unsigned char &b) { - Fl::get_color(c,r,g,b); -} - -void fl_static_set_color(unsigned int c, unsigned char r, unsigned char g, unsigned char b) { - Fl::set_color(c,r,g,b); -} - -void fl_static_free_color(unsigned int c, int b) { - Fl::free_color(c,b); -} - -void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b) { - Fl::foreground(r,g,b); -} - -void fl_static_background(unsigned int r, unsigned int g, unsigned int b) { - Fl::background(r,g,b); -} - -void fl_static_background2(unsigned int r, unsigned int g, unsigned int b) { - Fl::background2(r,g,b); -} - - - - -const char * fl_static_get_font(int f) { - return Fl::get_font(f); -} - -const char * fl_static_get_font_name(int f) { - return Fl::get_font_name(f); -} - -void fl_static_set_font(int t, int f) { - Fl::set_font(t,f); -} - -int fl_static_get_font_sizes(int f, int * &a) { - return Fl::get_font_sizes(static_cast<Fl_Font>(f),a); -} - -int fl_static_font_size_array_get(int * a, int i) { - return *(a+((i-1)*sizeof(int))); -} - -int fl_static_set_fonts() { - return Fl::set_fonts(); -} - - - - -int fl_static_box_dh(int b) { - return Fl::box_dh(static_cast<Fl_Boxtype>(b)); -} - -int fl_static_box_dw(int b) { - return Fl::box_dw(static_cast<Fl_Boxtype>(b)); -} - -int fl_static_box_dx(int b) { - return Fl::box_dx(static_cast<Fl_Boxtype>(b)); -} - -int fl_static_box_dy(int b) { - return Fl::box_dy(static_cast<Fl_Boxtype>(b)); -} - -void fl_static_set_boxtype(int t, int f) { - Fl::set_boxtype(static_cast<Fl_Boxtype>(t),static_cast<Fl_Boxtype>(f)); -} - -int fl_static_draw_box_active() { - return Fl::draw_box_active(); -} - - - - -void fl_static_copy(const char * t, int l, int k) { - Fl::copy(t,l,k); -} - -void fl_static_paste(void * r, int s) { - Fl::paste(reinterpret_cast<Fl_Widget&>(r),s); -} - -void fl_static_selection(void * o, char * t, int l) { - Fl::selection(reinterpret_cast<Fl_Widget&>(o),t,l); -} - - - - -void fl_static_dnd() { - Fl::dnd(); -} - -int fl_static_get_dnd_text_ops() { - return Fl::dnd_text_ops(); -} - -void fl_static_set_dnd_text_ops(int t) { - Fl::dnd_text_ops(t); -} - - - - -void fl_static_enable_im() { - Fl::enable_im(); -} - -void fl_static_disable_im() { - Fl::disable_im(); -} - -int fl_static_get_visible_focus() { - return Fl::visible_focus(); -} - -void fl_static_set_visible_focus(int f) { - Fl::visible_focus(f); -} - - - - -void fl_static_default_atclose(void * w) { - Fl::default_atclose(reinterpret_cast<Fl_Window*>(w), 0); -} - -void * fl_static_get_first_window() { - return Fl::first_window(); -} - -void fl_static_set_first_window(void * w) { - Fl::first_window(reinterpret_cast<Fl_Window*>(w)); -} - -void * fl_static_next_window(void * w) { - return Fl::next_window(reinterpret_cast<Fl_Window*>(w)); -} - -void * fl_static_modal() { - return Fl::modal(); -} - - - - -void * fl_static_readqueue() { - return Fl::readqueue(); -} - -void fl_static_do_widget_deletion() { - Fl::do_widget_deletion(); -} - - - - -const char * fl_static_get_scheme() { - return Fl::scheme(); -} - -void fl_static_set_scheme(const char *n) { - Fl::scheme(n); -} - -int fl_static_is_scheme(const char *n) { - return Fl::is_scheme(n); -} - -void fl_static_reload_scheme() { - Fl::reload_scheme(); -} - - - - -int fl_static_get_option(int o) { - return Fl::option(static_cast<Fl::Fl_Option>(o)); -} - -void fl_static_set_option(int o, int t) { - Fl::option(static_cast<Fl::Fl_Option>(o),t); -} - - - - -int fl_static_get_scrollbar_size() { - return Fl::scrollbar_size(); -} - -void fl_static_set_scrollbar_size(int s) { - Fl::scrollbar_size(s); -} - - diff --git a/src/c_fl_static.h b/src/c_fl_static.h deleted file mode 100644 index 0163f58..0000000 --- a/src/c_fl_static.h +++ /dev/null @@ -1,104 +0,0 @@ - - -#ifndef FL_STATIC_GUARD -#define FL_STATIC_GUARD - - - - -extern "C" void fl_static_add_awake_handler(void * h, void * f); -extern "C" void fl_static_get_awake_handler(void * &h, void * &f); - - -extern "C" void fl_static_add_check(void * h, void * f); -extern "C" int fl_static_has_check(void * h, void * f); -extern "C" void fl_static_remove_check(void * h, void * f); - - -extern "C" void fl_static_add_timeout(double s, void * h, void * f); -extern "C" int fl_static_has_timeout(void * h, void * f); -extern "C" void fl_static_remove_timeout(void * h, void * f); -extern "C" void fl_static_repeat_timeout(double s, void * h, void * f); - - -extern "C" void fl_static_add_clipboard_notify(void * h, void * f); - - -extern "C" void fl_static_add_fd(int d, void * h, void * f); -extern "C" void fl_static_add_fd2(int d, int m, void * h, void * f); -extern "C" void fl_static_remove_fd(int d); -extern "C" void fl_static_remove_fd2(int d, int m); - - -extern "C" void fl_static_add_idle(void * h, void * f); -extern "C" int fl_static_has_idle(void * h, void * f); -extern "C" void fl_static_remove_idle(void * h, void * f); - - -extern "C" void fl_static_get_color(unsigned int c, unsigned char &r, unsigned char &g, unsigned char &b); -extern "C" void fl_static_set_color(unsigned int c, unsigned char r, unsigned char g, unsigned char b); -extern "C" void fl_static_free_color(unsigned int c, int b); -extern "C" void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b); -extern "C" void fl_static_background(unsigned int r, unsigned int g, unsigned int b); -extern "C" void fl_static_background2(unsigned int r, unsigned int g, unsigned int b); - - -extern "C" const char * fl_static_get_font(int f); -extern "C" const char * fl_static_get_font_name(int f); -extern "C" void fl_static_set_font(int t, int f); -extern "C" int fl_static_get_font_sizes(int f, int * &a); -extern "C" int fl_static_font_size_array_get(int * a, int i); -extern "C" int fl_static_set_fonts(); - - -extern "C" int fl_static_box_dh(int b); -extern "C" int fl_static_box_dw(int b); -extern "C" int fl_static_box_dx(int b); -extern "C" int fl_static_box_dy(int b); -extern "C" void fl_static_set_boxtype(int t, int f); -extern "C" int fl_static_draw_box_active(); - - -extern "C" void fl_static_copy(const char * t, int l, int k); -extern "C" void fl_static_paste(void * r, int s); -extern "C" void fl_static_selection(void * o, char * t, int l); - - -extern "C" void fl_static_dnd(); -extern "C" int fl_static_get_dnd_text_ops(); -extern "C" void fl_static_set_dnd_text_ops(int t); - - -extern "C" void fl_static_enable_im(); -extern "C" void fl_static_disable_im(); -extern "C" int fl_static_get_visible_focus(); -extern "C" void fl_static_set_visible_focus(int f); - - -extern "C" void fl_static_default_atclose(void * w); -extern "C" void * fl_static_get_first_window(); -extern "C" void fl_static_set_first_window(void * w); -extern "C" void * fl_static_next_window(void * w); -extern "C" void * fl_static_modal(); - - -extern "C" void * fl_static_readqueue(); -extern "C" void fl_static_do_widget_deletion(); - - -extern "C" const char * fl_static_get_scheme(); -extern "C" void fl_static_set_scheme(const char *n); -extern "C" int fl_static_is_scheme(const char *n); -extern "C" void fl_static_reload_scheme(); - - -extern "C" int fl_static_get_option(int o); -extern "C" void fl_static_set_option(int o, int t); - - -extern "C" int fl_static_get_scrollbar_size(); -extern "C" void fl_static_set_scrollbar_size(int s); - - -#endif - diff --git a/src/c_fl_surface.cpp b/src/c_fl_surface.cpp deleted file mode 100644 index ea37c9e..0000000 --- a/src/c_fl_surface.cpp +++ /dev/null @@ -1,39 +0,0 @@ - - -#include <FL/Fl_Device.H> -#include "c_fl_surface.h" - - - - -class My_Surface_Device : public Fl_Surface_Device { - public: - using Fl_Surface_Device::Fl_Surface_Device; - friend SURFACE new_fl_surface(void * g); -}; - - - - -SURFACE new_fl_surface(void * g) { - My_Surface_Device *s = new My_Surface_Device(reinterpret_cast<Fl_Graphics_Driver*>(g)); - return s; -} - -void free_fl_surface(SURFACE s) { - delete reinterpret_cast<My_Surface_Device*>(s); -} - - - - -void fl_surface_set_current(SURFACE s) { - // virtual so disable dispatch - reinterpret_cast<Fl_Surface_Device*>(s)->Fl_Surface_Device::set_current(); -} - -SURFACE fl_surface_get_surface(void) { - return Fl_Surface_Device::surface(); -} - - diff --git a/src/c_fl_surface.h b/src/c_fl_surface.h deleted file mode 100644 index dd8d8e9..0000000 --- a/src/c_fl_surface.h +++ /dev/null @@ -1,25 +0,0 @@ - - -#ifndef FL_SURFACE_GUARD -#define FL_SURFACE_GUARD - - - - -typedef void* SURFACE; - - - - -extern "C" SURFACE new_fl_surface(void * g); -extern "C" void free_fl_surface(SURFACE s); - - - - -extern "C" void fl_surface_set_current(SURFACE s); -extern "C" SURFACE fl_surface_get_surface(void); - - -#endif - diff --git a/src/c_fl_tabs.cpp b/src/c_fl_tabs.cpp deleted file mode 100644 index 3d8e7bc..0000000 --- a/src/c_fl_tabs.cpp +++ /dev/null @@ -1,99 +0,0 @@ - - -#include <FL/Fl_Tabs.H> -#include "c_fl_tabs.h" -#include "c_fl_type.h" - - - - -class My_Tabs : public Fl_Tabs { - public: - using Fl_Tabs::Fl_Tabs; - friend void tabs_set_draw_hook(TABS t, void * d); - friend void fl_tabs_draw(TABS t); - friend void tabs_set_handle_hook(TABS t, void * h); - friend int fl_tabs_handle(TABS t, 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_Tabs::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Tabs::real_draw() { - Fl_Tabs::draw(); -} - -int My_Tabs::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Tabs::real_handle(int e) { - return Fl_Tabs::handle(e); -} - -void tabs_set_draw_hook(TABS t, void * d) { - reinterpret_cast<My_Tabs*>(t)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_tabs_draw(TABS t) { - reinterpret_cast<My_Tabs*>(t)->real_draw(); -} - -void tabs_set_handle_hook(TABS t, void * h) { - reinterpret_cast<My_Tabs*>(t)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_tabs_handle(TABS t, int e) { - return reinterpret_cast<My_Tabs*>(t)->real_handle(e); -} - - - - -TABS new_fl_tabs(int x, int y, int w, int h, char* label) { - My_Tabs *t = new My_Tabs(x, y, w, h, label); - return t; -} - -void free_fl_tabs(TABS t) { - delete reinterpret_cast<My_Tabs*>(t); -} - - - - -void fl_tabs_client_area(TABS t, int * x, int * y, int * w, int * h, int i) { - reinterpret_cast<Fl_Tabs*>(t)->client_area(*x,*y,*w,*h,i); -} - - - - -void * fl_tabs_get_push(TABS t) { - return reinterpret_cast<Fl_Tabs*>(t)->push(); -} - -void fl_tabs_set_push(TABS t, void * w) { - reinterpret_cast<Fl_Tabs*>(t)->push(reinterpret_cast<Fl_Widget*>(w)); -} - -void * fl_tabs_get_value(TABS t) { - return reinterpret_cast<Fl_Tabs*>(t)->value(); -} - -void fl_tabs_set_value(TABS t, void * w) { - reinterpret_cast<Fl_Tabs*>(t)->value(reinterpret_cast<Fl_Widget*>(w)); -} - -void * fl_tabs_which(TABS t, int x, int y) { - return reinterpret_cast<Fl_Tabs*>(t)->which(x,y); -} - diff --git a/src/c_fl_tabs.h b/src/c_fl_tabs.h deleted file mode 100644 index 2d12500..0000000 --- a/src/c_fl_tabs.h +++ /dev/null @@ -1,39 +0,0 @@ - - -#ifndef FL_TABS_GUARD -#define FL_TABS_GUARD - - - - -typedef void* TABS; - - - - -extern "C" void tabs_set_draw_hook(TABS t, void * d); -extern "C" void fl_tabs_draw(TABS t); -extern "C" void tabs_set_handle_hook(TABS t, void * h); -extern "C" int fl_tabs_handle(TABS t, int e); - - - - -extern "C" TABS new_fl_tabs(int x, int y, int w, int h, char* label); -extern "C" void free_fl_tabs(TABS t); - - - - -extern "C" void fl_tabs_client_area(TABS t, int * x, int * y, int * w, int * h, int i); - - -extern "C" void * fl_tabs_get_push(TABS t); -extern "C" void fl_tabs_set_push(TABS t, void * w); -extern "C" void * fl_tabs_get_value(TABS t); -extern "C" void fl_tabs_set_value(TABS t, void * w); -extern "C" void * fl_tabs_which(TABS t, int x, int y); - - -#endif - diff --git a/src/c_fl_text_buffer.cpp b/src/c_fl_text_buffer.cpp deleted file mode 100644 index 2df65f6..0000000 --- a/src/c_fl_text_buffer.cpp +++ /dev/null @@ -1,273 +0,0 @@ - - -#include <FL/Fl_Text_Buffer.H> -#include "c_fl_text_buffer.h" - - - - -TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { - Fl_Text_Buffer *tb = new Fl_Text_Buffer(rs, pgs); - return tb; -} - -void free_fl_text_buffer(TEXTBUFFER tb) { - delete reinterpret_cast<Fl_Text_Buffer*>(tb); -} - - - - -void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->add_modify_callback(reinterpret_cast<Fl_Text_Modify_Cb>(cb), ud); -} - -void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->add_predelete_callback(reinterpret_cast<Fl_Text_Predelete_Cb>(cb), ud); -} - -void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->call_modify_callbacks(); -} - -void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->call_predelete_callbacks(); -} - - - - -int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n, int b) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->loadfile(n,b); -} - -int fl_text_buffer_appendfile(TEXTBUFFER tb, char * n, int b) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->appendfile(n,b); -} - -int fl_text_buffer_insertfile(TEXTBUFFER tb, char * n, int p, int b) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->insertfile(n,p,b); -} - -int fl_text_buffer_outputfile(TEXTBUFFER tb, char * n, int f, int t, int b) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->outputfile(n,f,t,b); -} - -int fl_text_buffer_savefile(TEXTBUFFER tb, char * n, int b) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->savefile(n,b); -} - - - - -void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->insert(p, item); -} - -void fl_text_buffer_append(TEXTBUFFER tb, const char * item) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->append(item); -} - -void fl_text_buffer_replace(TEXTBUFFER tb, int s, int f, const char * text) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->replace(s, f, text); -} - -void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->remove(s, f); -} - -char * fl_text_buffer_get_text(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->text(); -} - -void fl_text_buffer_set_text(TEXTBUFFER tb, char * t) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->text(t); -} - -char fl_text_buffer_byte_at(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->byte_at(p); -} - -unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->char_at(p); -} - -char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->text_range(s, f); -} - -int fl_text_buffer_next_char(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->next_char(p); -} - -int fl_text_buffer_prev_char(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->prev_char(p); -} - - - - -int fl_text_buffer_count_displayed_characters(TEXTBUFFER tb, int s, int f) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->count_displayed_characters(s,f); -} - -int fl_text_buffer_count_lines(TEXTBUFFER tb, int s, int f) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->count_lines(s,f); -} - -int fl_text_buffer_length(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->length(); -} - -int fl_text_buffer_get_tab_distance(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->tab_distance(); -} - -void fl_text_buffer_set_tab_distance(TEXTBUFFER tb, int t) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->tab_distance(t); -} - - - - -int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->selection_position(s, e); -} - -int fl_text_buffer_secondary_selection_position(TEXTBUFFER tb, int * s, int * e) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->secondary_selection_position(s,e); -} - -void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->select(s, e); -} - -void fl_text_buffer_secondary_select(TEXTBUFFER tb, int s, int e) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->secondary_select(s,e); -} - -int fl_text_buffer_selected(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->selected(); -} - -int fl_text_buffer_secondary_selected(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->secondary_selected(); -} - -char * fl_text_buffer_selection_text(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->selection_text(); -} - -char * fl_text_buffer_secondary_selection_text(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->secondary_selection_text(); -} - -void fl_text_buffer_replace_selection(TEXTBUFFER tb, char * t) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->replace_selection(t); -} - -void fl_text_buffer_replace_secondary_selection(TEXTBUFFER tb, char * t) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->replace_secondary_selection(t); -} - -void fl_text_buffer_remove_selection(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->remove_selection(); -} - -void fl_text_buffer_remove_secondary_selection(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->remove_secondary_selection(); -} - -void fl_text_buffer_unselect(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->unselect(); -} - -void fl_text_buffer_secondary_unselect(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->secondary_unselect(); -} - - - - -void fl_text_buffer_highlight(TEXTBUFFER tb, int f, int t) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->highlight(f,t); -} - -char * fl_text_buffer_highlight_text(TEXTBUFFER tb) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->highlight_text(); -} - -void fl_text_buffer_unhighlight(TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->unhighlight(); -} - - - - -int fl_text_buffer_findchar_forward(TEXTBUFFER tb, int start, unsigned int item, int * found) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->findchar_forward(start, item, found); -} - -int fl_text_buffer_findchar_backward(TEXTBUFFER tb, int start, unsigned int item, int * found) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->findchar_backward(start, item, found); -} - -int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->search_forward(start, item, found, mcase); -} - -int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->search_backward(start, item, found, mcase); -} - - - - -int fl_text_buffer_word_start(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->word_start(p); -} - -int fl_text_buffer_word_end(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->word_end(p); -} - -int fl_text_buffer_line_start(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->line_start(p); -} - -int fl_text_buffer_line_end(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->line_end(p); -} - -char * fl_text_buffer_line_text(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->line_text(p); -} - -int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->skip_lines(s, l); -} - -int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->rewind_lines(s, l); -} - -int fl_text_buffer_skip_displayed_characters(TEXTBUFFER tb, int s, int n) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->skip_displayed_characters(s,n); -} - - - - -void fl_text_buffer_canundo(TEXTBUFFER tb, char f) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->canUndo(f); -} - -void fl_text_buffer_copy(TEXTBUFFER tb, TEXTBUFFER tb2, int s, int f, int i) { - reinterpret_cast<Fl_Text_Buffer*>(tb)->copy(reinterpret_cast<Fl_Text_Buffer*>(tb2),s,f,i); -} - -int fl_text_buffer_utf8_align(TEXTBUFFER tb, int p) { - return reinterpret_cast<Fl_Text_Buffer*>(tb)->utf8_align(p); -} - - diff --git a/src/c_fl_text_buffer.h b/src/c_fl_text_buffer.h deleted file mode 100644 index 7258006..0000000 --- a/src/c_fl_text_buffer.h +++ /dev/null @@ -1,96 +0,0 @@ - - -#ifndef FL_TEXT_BUFFER_GUARD -#define FL_TEXT_BUFFER_GUARD - - - - -typedef void* TEXTBUFFER; - - - - -extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); -extern "C" void free_fl_text_buffer(TEXTBUFFER tb); - - - - -extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); -extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); -extern "C" void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb); -extern "C" void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb); - - -extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n, int b); -extern "C" int fl_text_buffer_appendfile(TEXTBUFFER tb, char * n, int b); -extern "C" int fl_text_buffer_insertfile(TEXTBUFFER tb, char * n, int p, int b); -extern "C" int fl_text_buffer_outputfile(TEXTBUFFER tb, char * n, int f, int t, int b); -extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n, int b); - - -extern "C" void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item); -extern "C" void fl_text_buffer_append(TEXTBUFFER tb, const char * item); -extern "C" void fl_text_buffer_replace(TEXTBUFFER tb, int s, int f, const char * text); -extern "C" void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f); -extern "C" char * fl_text_buffer_get_text(TEXTBUFFER tb); -extern "C" void fl_text_buffer_set_text(TEXTBUFFER tb, char * t); -extern "C" char fl_text_buffer_byte_at(TEXTBUFFER tb, int p); -extern "C" unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p); -extern "C" char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f); -extern "C" int fl_text_buffer_next_char(TEXTBUFFER tb, int p); -extern "C" int fl_text_buffer_prev_char(TEXTBUFFER tb, int p); - - -extern "C" int fl_text_buffer_count_displayed_characters(TEXTBUFFER tb, int s, int f); -extern "C" int fl_text_buffer_count_lines(TEXTBUFFER tb, int s, int f); -extern "C" int fl_text_buffer_length(TEXTBUFFER tb); -extern "C" int fl_text_buffer_get_tab_distance(TEXTBUFFER tb); -extern "C" void fl_text_buffer_set_tab_distance(TEXTBUFFER tb, int t); - - -extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e); -extern "C" int fl_text_buffer_secondary_selection_position(TEXTBUFFER tb, int * s, int * e); -extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); -extern "C" void fl_text_buffer_secondary_select(TEXTBUFFER tb, int s, int e); -extern "C" int fl_text_buffer_selected(TEXTBUFFER tb); -extern "C" int fl_text_buffer_secondary_selected(TEXTBUFFER tb); -extern "C" char * fl_text_buffer_selection_text(TEXTBUFFER tb); -extern "C" char * fl_text_buffer_secondary_selection_text(TEXTBUFFER tb); -extern "C" void fl_text_buffer_replace_selection(TEXTBUFFER tb, char * t); -extern "C" void fl_text_buffer_replace_secondary_selection(TEXTBUFFER tb, char * t); -extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); -extern "C" void fl_text_buffer_remove_secondary_selection(TEXTBUFFER tb); -extern "C" void fl_text_buffer_unselect(TEXTBUFFER tb); -extern "C" void fl_text_buffer_secondary_unselect(TEXTBUFFER tb); - - -extern "C" void fl_text_buffer_highlight(TEXTBUFFER tb, int f, int t); -extern "C" char * fl_text_buffer_highlight_text(TEXTBUFFER tb); -extern "C" void fl_text_buffer_unhighlight(TEXTBUFFER tb); - - -extern "C" int fl_text_buffer_findchar_forward(TEXTBUFFER tb, int start, unsigned int item, int * found); -extern "C" int fl_text_buffer_findchar_backward(TEXTBUFFER tb, int start, unsigned int item, int * found); -extern "C" int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); -extern "C" int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); - - -extern "C" int fl_text_buffer_word_start(TEXTBUFFER tb, int p); -extern "C" int fl_text_buffer_word_end(TEXTBUFFER tb, int p); -extern "C" int fl_text_buffer_line_start(TEXTBUFFER tb, int p); -extern "C" int fl_text_buffer_line_end(TEXTBUFFER tb, int p); -extern "C" char * fl_text_buffer_line_text(TEXTBUFFER tb, int p); -extern "C" int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l); -extern "C" int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l); -extern "C" int fl_text_buffer_skip_displayed_characters(TEXTBUFFER tb, int s, int n); - - -extern "C" void fl_text_buffer_canundo(TEXTBUFFER tb, char f); -extern "C" void fl_text_buffer_copy(TEXTBUFFER tb, TEXTBUFFER tb2, int s, int f, int i); -extern "C" int fl_text_buffer_utf8_align(TEXTBUFFER tb, int p); - - -#endif - diff --git a/src/c_fl_text_display.cpp b/src/c_fl_text_display.cpp deleted file mode 100644 index b56f368..0000000 --- a/src/c_fl_text_display.cpp +++ /dev/null @@ -1,337 +0,0 @@ - - -#include <FL/Fl_Text_Display.H> -#include <FL/Fl_Text_Buffer.H> -#include "c_fl_text_display.h" -#include "c_fl_text_buffer.h" -#include "c_fl_type.h" - - - - -class My_Text_Display : public Fl_Text_Display { - public: - using Fl_Text_Display::Fl_Text_Display; - friend void text_display_set_draw_hook(TEXTDISPLAY td, void * d); - friend void fl_text_display_draw(TEXTDISPLAY td); - friend void text_display_set_handle_hook(TEXTDISPLAY td, void * h); - friend int fl_text_display_handle(TEXTDISPLAY td, 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_Text_Display::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Text_Display::real_draw() { - Fl_Text_Display::draw(); -} - -int My_Text_Display::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Text_Display::real_handle(int e) { - return Fl_Text_Display::handle(e); -} - -void text_display_set_draw_hook(TEXTDISPLAY td, void * d) { - reinterpret_cast<My_Text_Display*>(td)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_text_display_draw(TEXTDISPLAY td) { - reinterpret_cast<My_Text_Display*>(td)->real_draw(); -} - -void text_display_set_handle_hook(TEXTDISPLAY td, void * h) { - reinterpret_cast<My_Text_Display*>(td)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_text_display_handle(TEXTDISPLAY td, int e) { - return reinterpret_cast<My_Text_Display*>(td)->real_handle(e); -} - - - - -TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) { - My_Text_Display *td = new My_Text_Display(x, y, w, h, label); - return td; -} - -void free_fl_text_display(TEXTDISPLAY td) { - delete reinterpret_cast<My_Text_Display*>(td); -} - - - - -// this actually never gets called, since an access to the text_buffer -// object is stored on the Ada side of things -TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->buffer(); -} - -void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) { - reinterpret_cast<Fl_Text_Display*>(td)->buffer(reinterpret_cast<Fl_Text_Buffer*>(tb)); -} - - - - -void fl_text_display_highlight_data(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len) { - reinterpret_cast<Fl_Text_Display*>(td)->highlight_data - (reinterpret_cast<Fl_Text_Buffer*>(tb), reinterpret_cast<Fl_Text_Display::Style_Table_Entry*>(st), len, 0, 0, 0); -} - -void fl_text_display_highlight_data2(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len, char us, void * cb, void * a) { - reinterpret_cast<Fl_Text_Display*>(td)->highlight_data - (reinterpret_cast<Fl_Text_Buffer*>(tb), reinterpret_cast<Fl_Text_Display::Style_Table_Entry*>(st), len, - us, reinterpret_cast<Fl_Text_Display::Unfinished_Style_Cb>(cb), a); -} - - - - -double fl_text_display_col_to_x(TEXTDISPLAY td, double c) { - return reinterpret_cast<Fl_Text_Display*>(td)->col_to_x(c); -} - -double fl_text_display_x_to_col(TEXTDISPLAY td, double x) { - return reinterpret_cast<Fl_Text_Display*>(td)->x_to_col(x); -} - -int fl_text_display_in_selection(TEXTDISPLAY td, int x, int y) { - return reinterpret_cast<Fl_Text_Display*>(td)->in_selection(x, y); -} - -int fl_text_display_position_to_xy(TEXTDISPLAY td, int p, int * x, int * y) { - return reinterpret_cast<Fl_Text_Display*>(td)->position_to_xy(p, x, y); -} - - - - -unsigned int fl_text_display_get_cursor_color(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->cursor_color(); -} - -void fl_text_display_set_cursor_color(TEXTDISPLAY td, unsigned int c) { - reinterpret_cast<Fl_Text_Display*>(td)->cursor_color(c); -} - -void fl_text_display_set_cursor_style(TEXTDISPLAY td, int s) { - reinterpret_cast<Fl_Text_Display*>(td)->cursor_style(s); -} - -void fl_text_display_hide_cursor(TEXTDISPLAY td) { - reinterpret_cast<Fl_Text_Display*>(td)->hide_cursor(); -} - -void fl_text_display_show_cursor(TEXTDISPLAY td) { - reinterpret_cast<Fl_Text_Display*>(td)->show_cursor(); -} - - - - -unsigned int fl_text_display_get_text_color(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->textcolor(); -} - -void fl_text_display_set_text_color(TEXTDISPLAY td, unsigned int c) { - reinterpret_cast<Fl_Text_Display*>(td)->textcolor(static_cast<Fl_Color>(c)); -} - -int fl_text_display_get_text_font(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->textfont(); -} - -void fl_text_display_set_text_font(TEXTDISPLAY td, int f) { - reinterpret_cast<Fl_Text_Display*>(td)->textfont(static_cast<Fl_Font>(f)); -} - -int fl_text_display_get_text_size(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->textsize(); -} - -void fl_text_display_set_text_size(TEXTDISPLAY td, int s) { - reinterpret_cast<Fl_Text_Display*>(td)->textsize(static_cast<Fl_Fontsize>(s)); -} - - - - -void fl_text_display_insert(TEXTDISPLAY td, char * i) { - reinterpret_cast<Fl_Text_Display*>(td)->insert(i); -} - -void fl_text_display_overstrike(TEXTDISPLAY td, char * t) { - reinterpret_cast<Fl_Text_Display*>(td)->overstrike(t); -} - -int fl_text_display_get_insert_pos(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->insert_position(); -} - -void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p) { - reinterpret_cast<Fl_Text_Display*>(td)->insert_position(p); -} - -void fl_text_display_show_insert_pos(TEXTDISPLAY td) { - reinterpret_cast<Fl_Text_Display*>(td)->show_insert_position(); -} - - - - -int fl_text_display_word_start(TEXTDISPLAY td, int p) { - return reinterpret_cast<Fl_Text_Display*>(td)->word_start(p); -} - -int fl_text_display_word_end(TEXTDISPLAY td, int p) { - return reinterpret_cast<Fl_Text_Display*>(td)->word_end(p); -} - -void fl_text_display_next_word(TEXTDISPLAY td) { - reinterpret_cast<Fl_Text_Display*>(td)->next_word(); -} - -void fl_text_display_previous_word(TEXTDISPLAY td) { - reinterpret_cast<Fl_Text_Display*>(td)->previous_word(); -} - -void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m) { - reinterpret_cast<Fl_Text_Display*>(td)->wrap_mode(w, m); -} - - - - -int fl_text_display_line_start(TEXTDISPLAY td, int s) { - return reinterpret_cast<Fl_Text_Display*>(td)->line_start(s); -} - -int fl_text_display_line_end(TEXTDISPLAY td, int s, int p) { - return reinterpret_cast<Fl_Text_Display*>(td)->line_end(s, p); -} - -int fl_text_display_count_lines(TEXTDISPLAY td, int s, int f, int p) { - return reinterpret_cast<Fl_Text_Display*>(td)->count_lines(s, f, p); -} - -int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p) { - return reinterpret_cast<Fl_Text_Display*>(td)->skip_lines(s, l, p); -} - -int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l) { - return reinterpret_cast<Fl_Text_Display*>(td)->rewind_lines(s, l); -} - - - - -unsigned int fl_text_display_get_linenumber_align(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_align(); -} - -void fl_text_display_set_linenumber_align(TEXTDISPLAY td, unsigned int a) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_align(a); -} - -unsigned int fl_text_display_get_linenumber_bgcolor(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_bgcolor(); -} - -void fl_text_display_set_linenumber_bgcolor(TEXTDISPLAY td, unsigned int c) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_bgcolor(c); -} - -unsigned int fl_text_display_get_linenumber_fgcolor(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_fgcolor(); -} - -void fl_text_display_set_linenumber_fgcolor(TEXTDISPLAY td, unsigned int c) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_fgcolor(c); -} - -int fl_text_display_get_linenumber_font(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_font(); -} - -void fl_text_display_set_linenumber_font(TEXTDISPLAY td, int f) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_font(f); -} - -int fl_text_display_get_linenumber_size(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_size(); -} - -void fl_text_display_set_linenumber_size(TEXTDISPLAY td, int s) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_size(s); -} - -int fl_text_display_get_linenumber_width(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->linenumber_width(); -} - -void fl_text_display_set_linenumber_width(TEXTDISPLAY td, int w) { - reinterpret_cast<Fl_Text_Display*>(td)->linenumber_width(w); -} - - - - -int fl_text_display_move_down(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->move_down(); -} - -int fl_text_display_move_left(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->move_left(); -} - -int fl_text_display_move_right(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->move_right(); -} - -int fl_text_display_move_up(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->move_up(); -} - - - - -void fl_text_display_scroll(TEXTDISPLAY td, int l) { - reinterpret_cast<Fl_Text_Display*>(td)->scroll(l, 1); -} - -unsigned int fl_text_display_get_scrollbar_align(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->scrollbar_align(); -} - -void fl_text_display_set_scrollbar_align(TEXTDISPLAY td, unsigned int a) { - reinterpret_cast<Fl_Text_Display*>(td)->scrollbar_align(a); -} - -int fl_text_display_get_scrollbar_width(TEXTDISPLAY td) { - return reinterpret_cast<Fl_Text_Display*>(td)->scrollbar_width(); -} - -void fl_text_display_set_scrollbar_width(TEXTDISPLAY td, int w) { - reinterpret_cast<Fl_Text_Display*>(td)->scrollbar_width(w); -} - - - - -void fl_text_display_redisplay_range(TEXTDISPLAY td, int s, int f) { - reinterpret_cast<Fl_Text_Display*>(td)->redisplay_range(s,f); -} - - diff --git a/src/c_fl_text_display.h b/src/c_fl_text_display.h deleted file mode 100644 index 028143d..0000000 --- a/src/c_fl_text_display.h +++ /dev/null @@ -1,111 +0,0 @@ - - -#ifndef FL_TEXT_DISPLAY_GUARD -#define FL_TEXT_DISPLAY_GUARD - -#include "c_fl_text_buffer.h" - - - - -typedef void* TEXTDISPLAY; - - - - -extern "C" void text_display_set_draw_hook(TEXTDISPLAY td, void * d); -extern "C" void fl_text_display_draw(TEXTDISPLAY td); -extern "C" void text_display_set_handle_hook(TEXTDISPLAY td, void * h); -extern "C" int fl_text_display_handle(TEXTDISPLAY td, int e); - - - - -extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_display(TEXTDISPLAY td); - - - - -extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); -extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); - - -extern "C" void fl_text_display_highlight_data(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len); -extern "C" void fl_text_display_highlight_data2(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len, char us, void * cb, void * a); - - -extern "C" double fl_text_display_col_to_x(TEXTDISPLAY td, double c); -extern "C" double fl_text_display_x_to_col(TEXTDISPLAY td, double x); -extern "C" int fl_text_display_in_selection(TEXTDISPLAY td, int x, int y); -extern "C" int fl_text_display_position_to_xy(TEXTDISPLAY td, int p, int * x, int * y); - - -extern "C" unsigned int fl_text_display_get_cursor_color(TEXTDISPLAY td); -extern "C" void fl_text_display_set_cursor_color(TEXTDISPLAY td, unsigned int c); -extern "C" void fl_text_display_set_cursor_style(TEXTDISPLAY td, int s); -extern "C" void fl_text_display_hide_cursor(TEXTDISPLAY td); -extern "C" void fl_text_display_show_cursor(TEXTDISPLAY td); - - -extern "C" unsigned int fl_text_display_get_text_color(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, unsigned int c); -extern "C" int fl_text_display_get_text_font(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_font(TEXTDISPLAY td, int f); -extern "C" int fl_text_display_get_text_size(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_size(TEXTDISPLAY td, int s); - - -extern "C" void fl_text_display_insert(TEXTDISPLAY td, char * i); -extern "C" void fl_text_display_overstrike(TEXTDISPLAY td, char * t); -extern "C" int fl_text_display_get_insert_pos(TEXTDISPLAY td); -extern "C" void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p); -extern "C" void fl_text_display_show_insert_pos(TEXTDISPLAY td); - - -extern "C" int fl_text_display_word_start(TEXTDISPLAY td, int p); -extern "C" int fl_text_display_word_end(TEXTDISPLAY td, int p); -extern "C" void fl_text_display_next_word(TEXTDISPLAY td); -extern "C" void fl_text_display_previous_word(TEXTDISPLAY td); -extern "C" void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m); - - -extern "C" int fl_text_display_line_start(TEXTDISPLAY td, int s); -extern "C" int fl_text_display_line_end(TEXTDISPLAY td, int s, int p); -extern "C" int fl_text_display_count_lines(TEXTDISPLAY td, int s, int f, int p); -extern "C" int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p); -extern "C" int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l); - - -extern "C" unsigned int fl_text_display_get_linenumber_align(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_align(TEXTDISPLAY td, unsigned int a); -extern "C" unsigned int fl_text_display_get_linenumber_bgcolor(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_bgcolor(TEXTDISPLAY td, unsigned int c); -extern "C" unsigned int fl_text_display_get_linenumber_fgcolor(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_fgcolor(TEXTDISPLAY td, unsigned int c); -extern "C" int fl_text_display_get_linenumber_font(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_font(TEXTDISPLAY td, int f); -extern "C" int fl_text_display_get_linenumber_size(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_size(TEXTDISPLAY td, int s); -extern "C" int fl_text_display_get_linenumber_width(TEXTDISPLAY td); -extern "C" void fl_text_display_set_linenumber_width(TEXTDISPLAY td, int w); - - -extern "C" int fl_text_display_move_down(TEXTDISPLAY td); -extern "C" int fl_text_display_move_left(TEXTDISPLAY td); -extern "C" int fl_text_display_move_right(TEXTDISPLAY td); -extern "C" int fl_text_display_move_up(TEXTDISPLAY td); - - -extern "C" void fl_text_display_scroll(TEXTDISPLAY td, int l); -extern "C" unsigned int fl_text_display_get_scrollbar_align(TEXTDISPLAY td); -extern "C" void fl_text_display_set_scrollbar_align(TEXTDISPLAY td, unsigned int a); -extern "C" int fl_text_display_get_scrollbar_width(TEXTDISPLAY td); -extern "C" void fl_text_display_set_scrollbar_width(TEXTDISPLAY td, int w); - - -extern "C" void fl_text_display_redisplay_range(TEXTDISPLAY td, int s, int f); - - -#endif - diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp deleted file mode 100644 index 54c7735..0000000 --- a/src/c_fl_text_editor.cpp +++ /dev/null @@ -1,303 +0,0 @@ - - -#include <FL/Fl_Text_Editor.H> -#include "c_fl_text_editor.h" -#include "c_fl_type.h" - - - - -class My_Text_Editor : public Fl_Text_Editor { - public: - using Fl_Text_Editor::Fl_Text_Editor; - friend void text_editor_set_draw_hook(TEXTEDITOR te, void * d); - friend void fl_text_editor_draw(TEXTEDITOR te); - friend void text_editor_set_handle_hook(TEXTEDITOR te, void * h); - friend int fl_text_editor_handle(TEXTEDITOR te, 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_Text_Editor::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Text_Editor::real_draw() { - Fl_Text_Editor::draw(); -} - -int My_Text_Editor::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Text_Editor::real_handle(int e) { - return Fl_Text_Editor::handle(e); -} - -void text_editor_set_draw_hook(TEXTEDITOR te, void * d) { - reinterpret_cast<My_Text_Editor*>(te)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_text_editor_draw(TEXTEDITOR te) { - reinterpret_cast<My_Text_Editor*>(te)->real_draw(); -} - -void text_editor_set_handle_hook(TEXTEDITOR te, void * h) { - reinterpret_cast<My_Text_Editor*>(te)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_text_editor_handle(TEXTEDITOR te, int e) { - return reinterpret_cast<My_Text_Editor*>(te)->real_handle(e); -} - - - - -TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) { - My_Text_Editor *te = new My_Text_Editor(x, y, w, h, label); - return te; -} - -void free_fl_text_editor(TEXTEDITOR te) { - delete reinterpret_cast<My_Text_Editor*>(te); -} - - - - -void fl_text_editor_default(TEXTEDITOR te, int k) { - Fl_Text_Editor::kf_default(k, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_undo(TEXTEDITOR te) { - Fl_Text_Editor::kf_undo(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_cut(TEXTEDITOR te) { - Fl_Text_Editor::kf_cut(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_copy(TEXTEDITOR te) { - Fl_Text_Editor::kf_copy(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_paste(TEXTEDITOR te) { - Fl_Text_Editor::kf_paste(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_delete(TEXTEDITOR te) { - Fl_Text_Editor::kf_delete(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_select_all(TEXTEDITOR te) { - Fl_Text_Editor::kf_select_all(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_backspace(TEXTEDITOR te) { - Fl_Text_Editor::kf_backspace(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_insert(TEXTEDITOR te) { - Fl_Text_Editor::kf_insert(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_enter(TEXTEDITOR te) { - Fl_Text_Editor::kf_enter(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ignore(TEXTEDITOR te) { - Fl_Text_Editor::kf_ignore(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_home(TEXTEDITOR te) { - Fl_Text_Editor::kf_home(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_end(TEXTEDITOR te) { - Fl_Text_Editor::kf_end(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_page_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_page_down(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_page_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_page_up(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_down(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_left(TEXTEDITOR te) { - Fl_Text_Editor::kf_left(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_right(TEXTEDITOR te) { - Fl_Text_Editor::kf_right(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_up(0, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_shift_home(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Home, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_end(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_End, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_page_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Page_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_page_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Page_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_left(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Left, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_right(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Right, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_shift_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_shift_move(FL_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_ctrl_home(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Home, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_end(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_End, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_page_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Page_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_page_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Page_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_left(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Left, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_right(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Right, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_ctrl_move(FL_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_ctrl_shift_home(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Home, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_end(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_End, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_page_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Page_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_page_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Page_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_down(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Down, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_left(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Left, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_right(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Right, reinterpret_cast<Fl_Text_Editor*>(te)); -} - -void fl_text_editor_ctrl_shift_up(TEXTEDITOR te) { - Fl_Text_Editor::kf_c_s_move(FL_Up, reinterpret_cast<Fl_Text_Editor*>(te)); -} - - - - -void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f) { - reinterpret_cast<Fl_Text_Editor*>(te)->add_key_binding(k, s, reinterpret_cast<Fl_Text_Editor::Key_Func>(f)); -} - -void fl_text_editor_remove_key_binding(TEXTEDITOR te, int k, int s) { - reinterpret_cast<Fl_Text_Editor*>(te)->remove_key_binding(k, s); -} - -void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te) { - reinterpret_cast<Fl_Text_Editor*>(te)->remove_all_key_bindings(); -} - -void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f) { - reinterpret_cast<Fl_Text_Editor*>(te)->default_key_function(reinterpret_cast<Fl_Text_Editor::Key_Func>(f)); -} - - - - -int fl_text_editor_get_insert_mode(TEXTEDITOR te) { - return reinterpret_cast<Fl_Text_Editor*>(te)->insert_mode(); -} - -void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i) { - reinterpret_cast<Fl_Text_Editor*>(te)->insert_mode(i); -} - - - - -//int fl_text_editor_get_tab_nav(TEXTEDITOR te) { -// return reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(); -//} - -//void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t) { -// reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(t); -//} - diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h deleted file mode 100644 index 5f73cbc..0000000 --- a/src/c_fl_text_editor.h +++ /dev/null @@ -1,100 +0,0 @@ - - -#ifndef FL_TEXT_EDITOR_GUARD -#define FL_TEXT_EDITOR_GUARD - - - - -typedef void* TEXTEDITOR; - - - - -extern "C" void text_editor_set_draw_hook(TEXTEDITOR te, void * d); -extern "C" void fl_text_editor_draw(TEXTEDITOR te); -extern "C" void text_editor_set_handle_hook(TEXTEDITOR te, void * h); -extern "C" int fl_text_editor_handle(TEXTEDITOR te, int e); - - - - -extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_editor(TEXTEDITOR te); - - - - -extern "C" void fl_text_editor_default(TEXTEDITOR te, int k); - - -extern "C" void fl_text_editor_undo(TEXTEDITOR te); -extern "C" void fl_text_editor_cut(TEXTEDITOR te); -extern "C" void fl_text_editor_copy(TEXTEDITOR te); -extern "C" void fl_text_editor_paste(TEXTEDITOR te); -extern "C" void fl_text_editor_delete(TEXTEDITOR te); -extern "C" void fl_text_editor_select_all(TEXTEDITOR te); - - -extern "C" void fl_text_editor_backspace(TEXTEDITOR te); -extern "C" void fl_text_editor_insert(TEXTEDITOR te); -extern "C" void fl_text_editor_enter(TEXTEDITOR te); -extern "C" void fl_text_editor_ignore(TEXTEDITOR te); - - -extern "C" void fl_text_editor_home(TEXTEDITOR te); -extern "C" void fl_text_editor_end(TEXTEDITOR te); -extern "C" void fl_text_editor_page_down(TEXTEDITOR te); -extern "C" void fl_text_editor_page_up(TEXTEDITOR te); -extern "C" void fl_text_editor_down(TEXTEDITOR te); -extern "C" void fl_text_editor_left(TEXTEDITOR te); -extern "C" void fl_text_editor_right(TEXTEDITOR te); -extern "C" void fl_text_editor_up(TEXTEDITOR te); - - -extern "C" void fl_text_editor_shift_home(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_end(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_page_down(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_page_up(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_down(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_left(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_right(TEXTEDITOR te); -extern "C" void fl_text_editor_shift_up(TEXTEDITOR te); - - -extern "C" void fl_text_editor_ctrl_home(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_end(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_page_down(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_page_up(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_down(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_left(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_right(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_up(TEXTEDITOR te); - - -extern "C" void fl_text_editor_ctrl_shift_home(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_end(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_page_down(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_page_up(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_down(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_left(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_right(TEXTEDITOR te); -extern "C" void fl_text_editor_ctrl_shift_up(TEXTEDITOR te); - - -extern "C" void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f); -extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, int k, int s); -extern "C" void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te); -extern "C" void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f); - - -extern "C" int fl_text_editor_get_insert_mode(TEXTEDITOR te); -extern "C" void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i); - - -//extern "C" int fl_text_editor_get_tab_nav(TEXTEDITOR te); -//extern "C" void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t); - - -#endif - diff --git a/src/c_fl_tile.cpp b/src/c_fl_tile.cpp deleted file mode 100644 index c891164..0000000 --- a/src/c_fl_tile.cpp +++ /dev/null @@ -1,77 +0,0 @@ - - -#include <FL/Fl_Tile.H> -#include "c_fl_tile.h" -#include "c_fl_type.h" - - - - -class My_Tile : public Fl_Tile { - public: - using Fl_Tile::Fl_Tile; - friend void tile_set_draw_hook(TILE n, void * d); - friend void fl_tile_draw(TILE n); - friend void tile_set_handle_hook(TILE n, void * h); - friend int fl_tile_handle(TILE n, 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_Tile::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Tile::real_draw() { - Fl_Tile::draw(); -} - -int My_Tile::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Tile::real_handle(int e) { - return Fl_Tile::handle(e); -} - -void tile_set_draw_hook(TILE n, void * d) { - reinterpret_cast<My_Tile*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_tile_draw(TILE n) { - reinterpret_cast<My_Tile*>(n)->real_draw(); -} - -void tile_set_handle_hook(TILE n, void * h) { - reinterpret_cast<My_Tile*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_tile_handle(TILE n, int e) { - return reinterpret_cast<My_Tile*>(n)->real_handle(e); -} - - - - -TILE new_fl_tile(int x, int y, int w, int h, char* label) { - My_Tile *b = new My_Tile(x, y, w, h, label); - return b; -} - -void free_fl_tile(TILE t) { - delete reinterpret_cast<My_Tile*>(t); -} - - - - -void fl_tile_position(TILE t, int ox, int oy, int nx, int ny) { - reinterpret_cast<Fl_Tile*>(t)->position(ox,oy,nx,ny); -} - - diff --git a/src/c_fl_tile.h b/src/c_fl_tile.h deleted file mode 100644 index b87e806..0000000 --- a/src/c_fl_tile.h +++ /dev/null @@ -1,32 +0,0 @@ - - -#ifndef FL_TILE_GUARD -#define FL_TILE_GUARD - - - - -typedef void* TILE; - - - - -extern "C" void tile_set_draw_hook(TILE n, void * d); -extern "C" void fl_tile_draw(TILE n); -extern "C" void tile_set_handle_hook(TILE n, void * h); -extern "C" int fl_tile_handle(TILE n, int e); - - - - -extern "C" TILE new_fl_tile(int x, int y, int w, int h, char * label); -extern "C" void free_fl_tile(TILE t); - - - - -extern "C" void fl_tile_position(TILE t, int ox, int oy, int nx, int ny); - - -#endif - diff --git a/src/c_fl_tiled_image.cpp b/src/c_fl_tiled_image.cpp deleted file mode 100644 index 8d7ecde..0000000 --- a/src/c_fl_tiled_image.cpp +++ /dev/null @@ -1,60 +0,0 @@ - - -#include <FL/Fl_Tiled_Image.H> -#include <FL/Fl_Image.H> -#include "c_fl_tiled_image.h" - - - - -TILED_IMAGE new_fl_tiled_image(void * i, int w, int h) { - Fl_Tiled_Image *t = new Fl_Tiled_Image(reinterpret_cast<Fl_Image*>(i), w, h); - return t; -} - -void free_fl_tiled_image(TILED_IMAGE t) { - delete reinterpret_cast<Fl_Tiled_Image*>(t); -} - -TILED_IMAGE fl_tiled_image_copy(TILED_IMAGE t, int w, int h) { - // virtual so disable dispatch - return reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::copy(w, h); -} - -TILED_IMAGE fl_tiled_image_copy2(TILED_IMAGE t) { - return reinterpret_cast<Fl_Tiled_Image*>(t)->copy(); -} - - - - -void * fl_tiled_image_get_image(TILED_IMAGE t) { - return reinterpret_cast<Fl_Tiled_Image*>(t)->image(); -} - - - - -void fl_tiled_image_color_average(TILED_IMAGE t, int c, float b) { - // virtual so disable dispatch - reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::color_average(c, b); -} - -void fl_tiled_image_desaturate(TILED_IMAGE t) { - // virtual so disable dispatch - reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::desaturate(); -} - - - - -void fl_tiled_image_draw(TILED_IMAGE t, int x, int y) { - reinterpret_cast<Fl_Tiled_Image*>(t)->draw(x, y); -} - -void fl_tiled_image_draw2(TILED_IMAGE t, int x, int y, int w, int h, int cx, int cy) { - // virtual so disable dispatch - reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::draw(x, y, w, h, cx, cy); -} - - diff --git a/src/c_fl_tiled_image.h b/src/c_fl_tiled_image.h deleted file mode 100644 index 12b1c1e..0000000 --- a/src/c_fl_tiled_image.h +++ /dev/null @@ -1,34 +0,0 @@ - - -#ifndef FL_TILED_IMAGE_GUARD -#define FL_TILED_IMAGE_GUARD - - - - -typedef void* TILED_IMAGE; - - - - -extern "C" TILED_IMAGE new_fl_tiled_image(void * i, int w, int h); -extern "C" void free_fl_tiled_image(TILED_IMAGE t); -extern "C" TILED_IMAGE fl_tiled_image_copy(TILED_IMAGE t, int w, int h); -extern "C" TILED_IMAGE fl_tiled_image_copy2(TILED_IMAGE t); - - - - -extern "C" void * fl_tiled_image_get_image(TILED_IMAGE t); - - -extern "C" void fl_tiled_image_color_average(TILED_IMAGE t, int c, float b); -extern "C" void fl_tiled_image_desaturate(TILED_IMAGE t); - - -extern "C" void fl_tiled_image_draw(TILED_IMAGE t, int x, int y); -extern "C" void fl_tiled_image_draw2(TILED_IMAGE t, int x, int y, int w, int h, int cx, int cy); - - -#endif - diff --git a/src/c_fl_toggle_button.cpp b/src/c_fl_toggle_button.cpp deleted file mode 100644 index 6a631c3..0000000 --- a/src/c_fl_toggle_button.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include <FL/Fl_Toggle_Button.H> -#include "c_fl_toggle_button.h" -#include "c_fl_type.h" - - - - -class My_Toggle_Button : public Fl_Toggle_Button { - public: - using Fl_Toggle_Button::Fl_Toggle_Button; - friend void toggle_button_set_draw_hook(TOGGLEBUTTON b, void * d); - friend void fl_toggle_button_draw(TOGGLEBUTTON b); - friend void toggle_button_set_handle_hook(TOGGLEBUTTON b, void * h); - friend int fl_toggle_button_handle(TOGGLEBUTTON b, 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_Toggle_Button::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Toggle_Button::real_draw() { - Fl_Toggle_Button::draw(); -} - -int My_Toggle_Button::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Toggle_Button::real_handle(int e) { - return Fl_Toggle_Button::handle(e); -} - -void toggle_button_set_draw_hook(TOGGLEBUTTON b, void * d) { - reinterpret_cast<My_Toggle_Button*>(b)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_toggle_button_draw(TOGGLEBUTTON b) { - reinterpret_cast<My_Toggle_Button*>(b)->real_draw(); -} - -void toggle_button_set_handle_hook(TOGGLEBUTTON b, void * h) { - reinterpret_cast<My_Toggle_Button*>(b)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_toggle_button_handle(TOGGLEBUTTON b, int e) { - return reinterpret_cast<My_Toggle_Button*>(b)->real_handle(e); -} - - - - -TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label) { - My_Toggle_Button *b = new My_Toggle_Button(x, y, w, h, label); - return b; -} - -void free_fl_toggle_button(TOGGLEBUTTON b) { - delete reinterpret_cast<My_Toggle_Button*>(b); -} - diff --git a/src/c_fl_toggle_button.h b/src/c_fl_toggle_button.h deleted file mode 100644 index 88dcbae..0000000 --- a/src/c_fl_toggle_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -#ifndef FL_TOGGLE_BUTTON_GUARD -#define FL_TOGGLE_BUTTON_GUARD - - - - -typedef void* TOGGLEBUTTON; - - - - -extern "C" void toggle_button_set_draw_hook(TOGGLEBUTTON b, void * d); -extern "C" void fl_toggle_button_draw(TOGGLEBUTTON b); -extern "C" void toggle_button_set_handle_hook(TOGGLEBUTTON b, void * h); -extern "C" int fl_toggle_button_handle(TOGGLEBUTTON b, int e); - - - - -extern "C" TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_toggle_button(TOGGLEBUTTON b); - - -#endif - diff --git a/src/c_fl_tooltip.cpp b/src/c_fl_tooltip.cpp deleted file mode 100644 index a281333..0000000 --- a/src/c_fl_tooltip.cpp +++ /dev/null @@ -1,111 +0,0 @@ - - -#include <FL/Fl_Tooltip.H> -#include <FL/Fl_Widget.H> -#include "c_fl_tooltip.h" - - - - -void * fl_tooltip_get_current(void) { - return Fl_Tooltip::current(); -} - -void fl_tooltip_set_current(void * i) { - Fl_Tooltip::current(reinterpret_cast<Fl_Widget*>(i)); -} - -int fl_tooltip_enabled(void) { - return Fl_Tooltip::enabled(); -} - -void fl_tooltip_enable(int v) { - Fl_Tooltip::enable(v); -} - -void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t) { - Fl_Tooltip::enter_area(reinterpret_cast<Fl_Widget*>(i),x,y,w,h,t); -} - - - - -float fl_tooltip_get_delay(void) { - return Fl_Tooltip::delay(); -} - -void fl_tooltip_set_delay(float v) { - Fl_Tooltip::delay(v); -} - -float fl_tooltip_get_hoverdelay(void) { - return Fl_Tooltip::hoverdelay(); -} - -void fl_tooltip_set_hoverdelay(float v) { - Fl_Tooltip::hoverdelay(v); -} - - - - -unsigned int fl_tooltip_get_color(void) { - return Fl_Tooltip::color(); -} - -void fl_tooltip_set_color(unsigned int v) { - Fl_Tooltip::color(v); -} - -int fl_tooltip_get_margin_height(void) { - return Fl_Tooltip::margin_height(); -} - -//void fl_tooltip_set_margin_height(int v) { -// Fl_Tooltip::margin_height(v); -//} - -int fl_tooltip_get_margin_width(void) { - return Fl_Tooltip::margin_width(); -} - -//void fl_tooltip_set_margin_width(int v) { -// Fl_Tooltip::margin_width(v); -//} - -int fl_tooltip_get_wrap_width(void) { - return Fl_Tooltip::wrap_width(); -} - -//void fl_tooltip_set_wrap_width(int v) { -// Fl_Tooltip::wrap_width(v); -//} - - - - -unsigned int fl_tooltip_get_textcolor(void) { - return Fl_Tooltip::textcolor(); -} - -void fl_tooltip_set_textcolor(unsigned int v) { - Fl_Tooltip::textcolor(v); -} - -int fl_tooltip_get_font(void) { - return Fl_Tooltip::font(); -} - -void fl_tooltip_set_font(int v) { - Fl_Tooltip::font(v); -} - -int fl_tooltip_get_size(void) { - return Fl_Tooltip::size(); -} - -void fl_tooltip_set_size(int v) { - Fl_Tooltip::size(v); -} - - diff --git a/src/c_fl_tooltip.h b/src/c_fl_tooltip.h deleted file mode 100644 index b5a3644..0000000 --- a/src/c_fl_tooltip.h +++ /dev/null @@ -1,41 +0,0 @@ - - -#ifndef FL_TOOLTIP_GUARD -#define FL_TOOLTIP_GUARD - - - - -extern "C" void * fl_tooltip_get_current(void); -extern "C" void fl_tooltip_set_current(void * i); -extern "C" int fl_tooltip_enabled(void); -extern "C" void fl_tooltip_enable(int v); -extern "C" void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t); - - -extern "C" float fl_tooltip_get_delay(void); -extern "C" void fl_tooltip_set_delay(float v); -extern "C" float fl_tooltip_get_hoverdelay(void); -extern "C" void fl_tooltip_set_hoverdelay(float v); - - -extern "C" unsigned int fl_tooltip_get_color(void); -extern "C" void fl_tooltip_set_color(unsigned int v); -extern "C" int fl_tooltip_get_margin_height(void); -//extern "C" void fl_tooltip_set_margin_height(int v); -extern "C" int fl_tooltip_get_margin_width(void); -//extern "C" void fl_tooltip_set_margin_width(int v); -extern "C" int fl_tooltip_get_wrap_width(void); -//extern "C" void fl_tooltip_set_wrap_width(int v); - - -extern "C" unsigned int fl_tooltip_get_textcolor(void); -extern "C" void fl_tooltip_set_textcolor(unsigned int v); -extern "C" int fl_tooltip_get_font(void); -extern "C" void fl_tooltip_set_font(int v); -extern "C" int fl_tooltip_get_size(void); -extern "C" void fl_tooltip_set_size(int v); - - -#endif - diff --git a/src/c_fl_type.h b/src/c_fl_type.h deleted file mode 100644 index 750ae6c..0000000 --- a/src/c_fl_type.h +++ /dev/null @@ -1,16 +0,0 @@ - - -#ifndef FL_TYPE_GUARD -#define FL_TYPE_GUARD - - -typedef void (d_hook)(void*); -typedef d_hook* d_hook_p; - - -typedef int (h_hook)(void*,int); -typedef h_hook* h_hook_p; - - -#endif - diff --git a/src/c_fl_valuator.cpp b/src/c_fl_valuator.cpp deleted file mode 100644 index 37f8ad8..0000000 --- a/src/c_fl_valuator.cpp +++ /dev/null @@ -1,122 +0,0 @@ - - -#include <FL/Fl_Valuator.H> -#include "c_fl_valuator.h" -#include "c_fl_type.h" - - - - -class My_Valuator : public Fl_Valuator { - public: - using Fl_Valuator::Fl_Valuator; - friend void valuator_set_draw_hook(VALUATOR v, void * d); - friend void valuator_set_handle_hook(VALUATOR v, void * h); - friend int fl_valuator_handle(VALUATOR v, int e); - friend VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label); - protected: - void draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; - -void My_Valuator::draw() { - (*draw_hook)(this->user_data()); -} - -int My_Valuator::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Valuator::real_handle(int e) { - return Fl_Valuator::handle(e); -} - -void valuator_set_draw_hook(VALUATOR v, void * d) { - reinterpret_cast<My_Valuator*>(v)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void valuator_set_handle_hook(VALUATOR v, void * h) { - reinterpret_cast<My_Valuator*>(v)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_valuator_handle(VALUATOR v, int e) { - return reinterpret_cast<My_Valuator*>(v)->real_handle(e); -} - - - - -VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label) { - My_Valuator *v = new My_Valuator(x, y, w, h, label); - return v; -} - -void free_fl_valuator(VALUATOR v) { - delete reinterpret_cast<My_Valuator*>(v); -} - - - - -double fl_valuator_clamp(VALUATOR v, double a) { - return reinterpret_cast<Fl_Valuator*>(v)->clamp(a); -} - -double fl_valuator_round(VALUATOR v, double a) { - return reinterpret_cast<Fl_Valuator*>(v)->round(a); -} - -double fl_valuator_increment(VALUATOR v, double a, int s) { - return reinterpret_cast<Fl_Valuator*>(v)->increment(a,s); -} - - - - -double fl_valuator_get_minimum(VALUATOR v) { - return reinterpret_cast<Fl_Valuator*>(v)->minimum(); -} - -void fl_valuator_set_minimum(VALUATOR v, double t) { - reinterpret_cast<Fl_Valuator*>(v)->minimum(t); -} - -double fl_valuator_get_maximum(VALUATOR v) { - return reinterpret_cast<Fl_Valuator*>(v)->maximum(); -} - -void fl_valuator_set_maximum(VALUATOR v, double t) { - reinterpret_cast<Fl_Valuator*>(v)->maximum(t); -} - -double fl_valuator_get_step(VALUATOR v) { - return reinterpret_cast<Fl_Valuator*>(v)->step(); -} - -void fl_valuator_set_step(VALUATOR v, double t) { - reinterpret_cast<Fl_Valuator*>(v)->step(t); -} - -double fl_valuator_get_value(VALUATOR v) { - return reinterpret_cast<Fl_Valuator*>(v)->value(); -} - -void fl_valuator_set_value(VALUATOR v, double t) { - reinterpret_cast<Fl_Valuator*>(v)->value(t); -} - -void fl_valuator_bounds(VALUATOR v, double a, double b) { - reinterpret_cast<Fl_Valuator*>(v)->bounds(a,b); -} - -void fl_valuator_precision(VALUATOR v, int s) { - reinterpret_cast<Fl_Valuator*>(v)->precision(s); -} - -void fl_valuator_range(VALUATOR v, double a, double b) { - reinterpret_cast<Fl_Valuator*>(v)->range(a,b); -} - diff --git a/src/c_fl_valuator.h b/src/c_fl_valuator.h deleted file mode 100644 index 4a6bbe9..0000000 --- a/src/c_fl_valuator.h +++ /dev/null @@ -1,48 +0,0 @@ - - -#ifndef FL_VALUATOR_GUARD -#define FL_VALUATOR_GUARD - - - - -typedef void* VALUATOR; - - - - -extern "C" void valuator_set_draw_hook(VALUATOR v, void * d); -extern "C" void valuator_set_handle_hook(VALUATOR v, void * h); -extern "C" int fl_valuator_handle(VALUATOR v, int e); - - - - -extern "C" VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label); -extern "C" void free_fl_valuator(VALUATOR v); - - - - -extern "C" double fl_valuator_clamp(VALUATOR v, double a); -extern "C" double fl_valuator_round(VALUATOR v, double a); -extern "C" double fl_valuator_increment(VALUATOR v, double a, int s); - - - - -extern "C" double fl_valuator_get_minimum(VALUATOR v); -extern "C" void fl_valuator_set_minimum(VALUATOR v, double t); -extern "C" double fl_valuator_get_maximum(VALUATOR v); -extern "C" void fl_valuator_set_maximum(VALUATOR v, double t); -extern "C" double fl_valuator_get_step(VALUATOR v); -extern "C" void fl_valuator_set_step(VALUATOR v, double t); -extern "C" double fl_valuator_get_value(VALUATOR v); -extern "C" void fl_valuator_set_value(VALUATOR v, double t); -extern "C" void fl_valuator_bounds(VALUATOR v, double a, double b); -extern "C" void fl_valuator_precision(VALUATOR v, int s); -extern "C" void fl_valuator_range(VALUATOR v, double a, double b); - - -#endif - diff --git a/src/c_fl_value_input.cpp b/src/c_fl_value_input.cpp deleted file mode 100644 index 91404a6..0000000 --- a/src/c_fl_value_input.cpp +++ /dev/null @@ -1,137 +0,0 @@ - - -#include <FL/Fl_Value_Input.H> -#include "c_fl_value_input.h" -#include "c_fl_type.h" - - - - -class My_Value_Input : public Fl_Value_Input { - public: - using Fl_Value_Input::Fl_Value_Input; - friend void value_input_set_draw_hook(VALUE_INPUT a, void * d); - friend void fl_value_input_draw(VALUE_INPUT a); - friend void value_input_set_handle_hook(VALUE_INPUT a, void * h); - friend int fl_value_input_handle(VALUE_INPUT a, 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_Value_Input::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Value_Input::real_draw() { - Fl_Value_Input::draw(); -} - -int My_Value_Input::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Value_Input::real_handle(int e) { - return Fl_Value_Input::handle(e); -} - -void value_input_set_draw_hook(VALUE_INPUT a, void * d) { - reinterpret_cast<My_Value_Input*>(a)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_value_input_draw(VALUE_INPUT a) { - reinterpret_cast<My_Value_Input*>(a)->real_draw(); -} - -void value_input_set_handle_hook(VALUE_INPUT a, void * h) { - reinterpret_cast<My_Value_Input*>(a)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_value_input_handle(VALUE_INPUT a, int e) { - return reinterpret_cast<My_Value_Input*>(a)->real_handle(e); -} - - - - -VALUE_INPUT new_fl_value_input(int x, int y, int w, int h, char* label) { - My_Value_Input *a = new My_Value_Input(x, y, w, h, label); - return a; -} - -void free_fl_value_input(VALUE_INPUT a) { - delete reinterpret_cast<My_Value_Input*>(a); -} - - - - -void * fl_value_input_get_input(VALUE_INPUT v) { - return &(reinterpret_cast<Fl_Value_Input*>(v)->input); -} - - - - -unsigned int fl_value_input_get_cursor_color(VALUE_INPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->cursor_color(); -} - -void fl_value_input_set_cursor_color(VALUE_INPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Input*>(v)->cursor_color(c); -} - - - - -int fl_value_input_get_shortcut(VALUE_INPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut(); -} - -void fl_value_input_set_shortcut(VALUE_INPUT v, int k) { - reinterpret_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut(k); -} - - - - -int fl_value_input_is_soft(VALUE_INPUT a) { - return reinterpret_cast<Fl_Value_Input*>(a)->soft(); -} - -void fl_value_input_set_soft(VALUE_INPUT a, int t) { - reinterpret_cast<Fl_Value_Input*>(a)->soft(t); -} - - - - -unsigned int fl_value_input_get_text_color(VALUE_INPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textcolor(); -} - -void fl_value_input_set_text_color(VALUE_INPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Input*>(v)->textcolor(static_cast<Fl_Color>(c)); -} - -int fl_value_input_get_text_font(VALUE_INPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textfont(); -} - -void fl_value_input_set_text_font(VALUE_INPUT v, int f) { - reinterpret_cast<Fl_Value_Input*>(v)->textfont(static_cast<Fl_Font>(f)); -} - -int fl_value_input_get_text_size(VALUE_INPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textsize(); -} - -void fl_value_input_set_text_size(VALUE_INPUT v, int s) { - reinterpret_cast<Fl_Value_Input*>(v)->textsize(static_cast<Fl_Fontsize>(s)); -} - - diff --git a/src/c_fl_value_input.h b/src/c_fl_value_input.h deleted file mode 100644 index ff360bd..0000000 --- a/src/c_fl_value_input.h +++ /dev/null @@ -1,52 +0,0 @@ - - -#ifndef FL_VALUE_INPUT_GUARD -#define FL_VALUE_INPUT_GUARD - - - - -typedef void* VALUE_INPUT; - - - - -extern "C" void value_input_set_draw_hook(VALUE_INPUT a, void * d); -extern "C" void fl_value_input_draw(VALUE_INPUT a); -extern "C" void value_input_set_handle_hook(VALUE_INPUT a, void * h); -extern "C" int fl_value_input_handle(VALUE_INPUT a, int e); - - - - -extern "C" VALUE_INPUT new_fl_value_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_input(VALUE_INPUT a); - - - - -extern "C" void * fl_value_input_get_input(VALUE_INPUT v); - - -extern "C" unsigned int fl_value_input_get_cursor_color(VALUE_INPUT v); -extern "C" void fl_value_input_set_cursor_color(VALUE_INPUT v, unsigned int c); - - -extern "C" int fl_value_input_get_shortcut(VALUE_INPUT v); -extern "C" void fl_value_input_set_shortcut(VALUE_INPUT v, int k); - - -extern "C" int fl_value_input_is_soft(VALUE_INPUT a); -extern "C" void fl_value_input_set_soft(VALUE_INPUT a, int t); - - -extern "C" unsigned int fl_value_input_get_text_color(VALUE_INPUT v); -extern "C" void fl_value_input_set_text_color(VALUE_INPUT v, unsigned int c); -extern "C" int fl_value_input_get_text_font(VALUE_INPUT v); -extern "C" void fl_value_input_set_text_font(VALUE_INPUT v, int f); -extern "C" int fl_value_input_get_text_size(VALUE_INPUT v); -extern "C" void fl_value_input_set_text_size(VALUE_INPUT v, int s); - - -#endif - diff --git a/src/c_fl_value_output.cpp b/src/c_fl_value_output.cpp deleted file mode 100644 index 5e874f9..0000000 --- a/src/c_fl_value_output.cpp +++ /dev/null @@ -1,108 +0,0 @@ - - -#include <FL/Fl_Value_Output.H> -#include "c_fl_value_output.h" -#include "c_fl_type.h" - - - - -class My_Value_Output : public Fl_Value_Output { - public: - using Fl_Value_Output::Fl_Value_Output; - friend void value_output_set_draw_hook(VALUE_OUTPUT a, void * d); - friend void fl_value_output_draw(VALUE_OUTPUT a); - friend void value_output_set_handle_hook(VALUE_OUTPUT a, void * h); - friend int fl_value_output_handle(VALUE_OUTPUT a, 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_Value_Output::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Value_Output::real_draw() { - Fl_Value_Output::draw(); -} - -int My_Value_Output::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Value_Output::real_handle(int e) { - return Fl_Value_Output::handle(e); -} - -void value_output_set_draw_hook(VALUE_OUTPUT a, void * d) { - reinterpret_cast<My_Value_Output*>(a)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_value_output_draw(VALUE_OUTPUT a) { - reinterpret_cast<My_Value_Output*>(a)->real_draw(); -} - -void value_output_set_handle_hook(VALUE_OUTPUT a, void * h) { - reinterpret_cast<My_Value_Output*>(a)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_value_output_handle(VALUE_OUTPUT a, int e) { - return reinterpret_cast<My_Value_Output*>(a)->real_handle(e); -} - - - - -VALUE_OUTPUT new_fl_value_output(int x, int y, int w, int h, char* label) { - My_Value_Output *a = new My_Value_Output(x, y, w, h, label); - return a; -} - -void free_fl_value_output(VALUE_OUTPUT a) { - delete reinterpret_cast<My_Value_Output*>(a); -} - - - - -int fl_value_output_is_soft(VALUE_OUTPUT a) { - return reinterpret_cast<Fl_Value_Output*>(a)->soft(); -} - -void fl_value_output_set_soft(VALUE_OUTPUT a, int t) { - reinterpret_cast<Fl_Value_Output*>(a)->soft(t); -} - - - - -unsigned int fl_value_output_get_text_color(VALUE_OUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textcolor(); -} - -void fl_value_output_set_text_color(VALUE_OUTPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Output*>(v)->textcolor(static_cast<Fl_Color>(c)); -} - -int fl_value_output_get_text_font(VALUE_OUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textfont(); -} - -void fl_value_output_set_text_font(VALUE_OUTPUT v, int f) { - reinterpret_cast<Fl_Value_Output*>(v)->textfont(static_cast<Fl_Font>(f)); -} - -int fl_value_output_get_text_size(VALUE_OUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textsize(); -} - -void fl_value_output_set_text_size(VALUE_OUTPUT v, int s) { - reinterpret_cast<Fl_Value_Output*>(v)->textsize(static_cast<Fl_Fontsize>(s)); -} - - diff --git a/src/c_fl_value_output.h b/src/c_fl_value_output.h deleted file mode 100644 index 62e8426..0000000 --- a/src/c_fl_value_output.h +++ /dev/null @@ -1,41 +0,0 @@ - - -#ifndef FL_VALUE_OUTPUT_GUARD -#define FL_VALUE_OUTPUT_GUARD - - - - -typedef void* VALUE_OUTPUT; - - - - -extern "C" void value_output_set_draw_hook(VALUE_OUTPUT a, void * d); -extern "C" void fl_value_output_draw(VALUE_OUTPUT a); -extern "C" void value_output_set_handle_hook(VALUE_OUTPUT a, void * h); -extern "C" int fl_value_output_handle(VALUE_OUTPUT a, int e); - - - - -extern "C" VALUE_OUTPUT new_fl_value_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_output(VALUE_OUTPUT a); - - - - -extern "C" int fl_value_output_is_soft(VALUE_OUTPUT a); -extern "C" void fl_value_output_set_soft(VALUE_OUTPUT a, int t); - - -extern "C" unsigned int fl_value_output_get_text_color(VALUE_OUTPUT v); -extern "C" void fl_value_output_set_text_color(VALUE_OUTPUT v, unsigned int c); -extern "C" int fl_value_output_get_text_font(VALUE_OUTPUT v); -extern "C" void fl_value_output_set_text_font(VALUE_OUTPUT v, int f); -extern "C" int fl_value_output_get_text_size(VALUE_OUTPUT v); -extern "C" void fl_value_output_set_text_size(VALUE_OUTPUT v, int s); - - -#endif - diff --git a/src/c_fl_value_slider.cpp b/src/c_fl_value_slider.cpp deleted file mode 100644 index aa819af..0000000 --- a/src/c_fl_value_slider.cpp +++ /dev/null @@ -1,96 +0,0 @@ - - -#include <FL/Fl_Value_Slider.H> -#include "c_fl_value_slider.h" -#include "c_fl_type.h" - - - - -class My_Value_Slider : public Fl_Value_Slider { - public: - using Fl_Value_Slider::Fl_Value_Slider; - friend void value_slider_set_draw_hook(VALUE_SLIDER s, void * d); - friend void fl_value_slider_draw(VALUE_SLIDER s); - friend void value_slider_set_handle_hook(VALUE_SLIDER s, void * h); - friend int fl_value_slider_handle(VALUE_SLIDER s, 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_Value_Slider::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Value_Slider::real_draw() { - Fl_Value_Slider::draw(); -} - -int My_Value_Slider::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Value_Slider::real_handle(int e) { - return Fl_Value_Slider::handle(e); -} - -void value_slider_set_draw_hook(VALUE_SLIDER s, void * d) { - reinterpret_cast<My_Value_Slider*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_value_slider_draw(VALUE_SLIDER s) { - reinterpret_cast<My_Value_Slider*>(s)->real_draw(); -} - -void value_slider_set_handle_hook(VALUE_SLIDER s, void * h) { - reinterpret_cast<My_Value_Slider*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_value_slider_handle(VALUE_SLIDER s, int e) { - return reinterpret_cast<My_Value_Slider*>(s)->real_handle(e); -} - - - - -VALUE_SLIDER new_fl_value_slider(int x, int y, int w, int h, char* label) { - My_Value_Slider *s = new My_Value_Slider(x, y, w, h, label); - return s; -} - -void free_fl_value_slider(VALUE_SLIDER s) { - delete reinterpret_cast<My_Value_Slider*>(s); -} - - - - -unsigned int fl_value_slider_get_textcolor(VALUE_SLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textcolor(); -} - -void fl_value_slider_set_textcolor(VALUE_SLIDER s, unsigned int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textcolor(t); -} - -int fl_value_slider_get_textfont(VALUE_SLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textfont(); -} - -void fl_value_slider_set_textfont(VALUE_SLIDER s, int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textfont(t); -} - -int fl_value_slider_get_textsize(VALUE_SLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textsize(); -} - -void fl_value_slider_set_textsize(VALUE_SLIDER s, int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textsize(t); -} - diff --git a/src/c_fl_value_slider.h b/src/c_fl_value_slider.h deleted file mode 100644 index 9229fe6..0000000 --- a/src/c_fl_value_slider.h +++ /dev/null @@ -1,37 +0,0 @@ - - -#ifndef FL_VALUE_SLIDER_GUARD -#define FL_VALUE_SLIDER_GUARD - - - - -typedef void* VALUE_SLIDER; - - - - -extern "C" void value_slider_set_draw_hook(VALUE_SLIDER s, void * d); -extern "C" void fl_value_slider_draw(VALUE_SLIDER s); -extern "C" void value_slider_set_handle_hook(VALUE_SLIDER s, void * h); -extern "C" int fl_value_slider_handle(VALUE_SLIDER s, int e); - - - - -extern "C" VALUE_SLIDER new_fl_value_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_slider(VALUE_SLIDER s); - - - - -extern "C" unsigned int fl_value_slider_get_textcolor(VALUE_SLIDER s); -extern "C" void fl_value_slider_set_textcolor(VALUE_SLIDER s, unsigned int t); -extern "C" int fl_value_slider_get_textfont(VALUE_SLIDER s); -extern "C" void fl_value_slider_set_textfont(VALUE_SLIDER s, int t); -extern "C" int fl_value_slider_get_textsize(VALUE_SLIDER s); -extern "C" void fl_value_slider_set_textsize(VALUE_SLIDER s, int t); - - -#endif - diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp deleted file mode 100644 index 5f0c904..0000000 --- a/src/c_fl_widget.cpp +++ /dev/null @@ -1,359 +0,0 @@ - - -#include <FL/Fl_Widget.H> -#include <FL/Fl_Image.H> -#include "c_fl_widget.h" -#include "c_fl_type.h" - - - - -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; -}; - -void My_Widget::draw() { - (*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<My_Widget*>(w)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void widget_set_handle_hook(WIDGET w, void * h) { - reinterpret_cast<My_Widget*>(w)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - - - - -WIDGET new_fl_widget(int x, int y, int w, int h, char* label) { - My_Widget *wd = new My_Widget(x, y, w, h, label); - return wd; -} - -void free_fl_widget(WIDGET w) { - delete reinterpret_cast<My_Widget*>(w); -} - - - - -void * fl_widget_get_user_data(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->user_data(); -} - -void fl_widget_set_user_data(WIDGET w, void * d) { - reinterpret_cast<Fl_Widget*>(w)->user_data(d); -} - - - - -void fl_widget_activate(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->activate(); -} - -void fl_widget_deactivate(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->deactivate(); -} - -int fl_widget_active(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->active(); -} - -int fl_widget_active_r(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->active_r(); -} - -void fl_widget_set_active(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->set_active(); -} - -void fl_widget_clear_active(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->clear_active(); -} - - - - -unsigned int fl_widget_changed(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->changed(); -} - -void fl_widget_set_changed(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->set_changed(); -} - -void fl_widget_clear_changed(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->clear_changed(); -} - -int fl_widget_output(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->output(); -} - -void fl_widget_set_output(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->set_output(); -} - -void fl_widget_clear_output(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->clear_output(); -} - -int fl_widget_visible(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->visible(); -} - -int fl_widget_visible_r(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->visible_r(); -} - -void fl_widget_set_visible(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->set_visible(); -} - -void fl_widget_clear_visible(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->clear_visible(); -} - - - - -int fl_widget_get_visible_focus(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->visible_focus(); -} - -void fl_widget_set_visible_focus(WIDGET w, int f) { - reinterpret_cast<Fl_Widget*>(w)->visible_focus(f); -} - -int fl_widget_take_focus(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->take_focus(); -} - -int fl_widget_takesevents(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->takesevents(); -} - - - - -unsigned int fl_widget_get_color(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->color(); -} - -void fl_widget_set_color(WIDGET w, unsigned int b) { - reinterpret_cast<Fl_Widget*>(w)->color(b); -} - -unsigned int fl_widget_get_selection_color(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->selection_color(); -} - -void fl_widget_set_selection_color(WIDGET w, unsigned int c) { - reinterpret_cast<Fl_Widget*>(w)->selection_color(c); -} - - - - -void * fl_widget_get_parent(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->parent(); -} - -int fl_widget_contains(WIDGET w, WIDGET i) { - return reinterpret_cast<Fl_Widget*>(w)->contains(reinterpret_cast<Fl_Widget*>(i)); -} - -int fl_widget_inside(WIDGET w, WIDGET p) { - return reinterpret_cast<Fl_Widget*>(w)->inside(reinterpret_cast<Fl_Widget*>(p)); -} - -void * fl_widget_window(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->window(); -} - -void * fl_widget_top_window(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->top_window(); -} - -void * fl_widget_top_window_offset(WIDGET w, int &x, int &y) { - return reinterpret_cast<Fl_Widget*>(w)->top_window_offset(x,y); -} - - - - -unsigned int fl_widget_get_align(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->align(); -} - -void fl_widget_set_align(WIDGET w, unsigned int a) { - reinterpret_cast<Fl_Widget*>(w)->align(a); -} - -int fl_widget_get_box(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->box(); -} - -void fl_widget_set_box(WIDGET w, int b) { - reinterpret_cast<Fl_Widget*>(w)->box(static_cast<Fl_Boxtype>(b)); -} - -const char * fl_widget_tooltip(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->tooltip(); -} - -void fl_widget_copy_tooltip(WIDGET w, const char * t) { - reinterpret_cast<Fl_Widget*>(w)->copy_tooltip(t); -} - - - - -const char* fl_widget_get_label(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->label(); -} - -void fl_widget_set_label(WIDGET w, const char* t) { - reinterpret_cast<Fl_Widget*>(w)->copy_label(t); -} - -unsigned int fl_widget_get_labelcolor(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->labelcolor(); -} - -void fl_widget_set_labelcolor(WIDGET w, unsigned int v) { - reinterpret_cast<Fl_Widget*>(w)->labelcolor(v); -} - -int fl_widget_get_labelfont(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->labelfont(); -} - -void fl_widget_set_labelfont(WIDGET w, int f) { - reinterpret_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f)); -} - -int fl_widget_get_labelsize(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->labelsize(); -} - -void fl_widget_set_labelsize(WIDGET w, int s) { - reinterpret_cast<Fl_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s)); -} - -int fl_widget_get_labeltype(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->labeltype(); -} - -void fl_widget_set_labeltype(WIDGET w, int l) { - reinterpret_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l)); -} - -void fl_widget_measure_label(WIDGET w, int &d, int &h) { - reinterpret_cast<Fl_Widget*>(w)->measure_label(d,h); -} - - - - -void fl_widget_set_callback(WIDGET w, void * cb) { - reinterpret_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb)); -} - -unsigned int fl_widget_get_when(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->when(); -} - -void fl_widget_set_when(WIDGET w, unsigned int c) { - reinterpret_cast<Fl_Widget*>(w)->when(c); -} - - - - -int fl_widget_get_x(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->x(); -} - -int fl_widget_get_y(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->y(); -} - -int fl_widget_get_w(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->w(); -} - -int fl_widget_get_h(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->h(); -} - -void fl_widget_size(WIDGET w, int d, int h) { - reinterpret_cast<Fl_Widget*>(w)->size(d, h); -} - -void fl_widget_position(WIDGET w, int x, int y) { - reinterpret_cast<Fl_Widget*>(w)->position(x, y); -} - - - - -void fl_widget_set_image(WIDGET w, void * img) { - reinterpret_cast<Fl_Widget*>(w)->image(reinterpret_cast<Fl_Image*>(img)); -} - -void fl_widget_set_deimage(WIDGET w, void * img) { - reinterpret_cast<Fl_Widget*>(w)->deimage(reinterpret_cast<Fl_Image*>(img)); -} - - - - -int fl_widget_damage(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->damage(); -} - -void fl_widget_set_damage(WIDGET w, int t) { - if (t != 0) { - reinterpret_cast<Fl_Widget*>(w)->damage(0xff); - } else { - reinterpret_cast<Fl_Widget*>(w)->damage(0x00); - } -} - -void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h) { - if (t != 0) { - reinterpret_cast<Fl_Widget*>(w)->damage(0xff,x,y,d,h); - } else { - reinterpret_cast<Fl_Widget*>(w)->damage(0x00,x,y,d,h); - } -} - -void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a) { - reinterpret_cast<Fl_Widget*>(w)->draw_label(x,y,d,h,a); -} - -void fl_widget_redraw(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->redraw(); -} - -void fl_widget_redraw_label(WIDGET w) { - reinterpret_cast<Fl_Widget*>(w)->redraw_label(); -} - diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h deleted file mode 100644 index c1b8e92..0000000 --- a/src/c_fl_widget.h +++ /dev/null @@ -1,117 +0,0 @@ - - -#ifndef FL_WIDGET_GUARD -#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); - - -extern "C" void fl_widget_activate(WIDGET w); -extern "C" void fl_widget_deactivate(WIDGET w); -extern "C" int fl_widget_active(WIDGET w); -extern "C" int fl_widget_active_r(WIDGET w); -extern "C" void fl_widget_set_active(WIDGET w); -extern "C" void fl_widget_clear_active(WIDGET w); - - -extern "C" unsigned int fl_widget_changed(WIDGET w); -extern "C" void fl_widget_set_changed(WIDGET w); -extern "C" void fl_widget_clear_changed(WIDGET w); -extern "C" int fl_widget_output(WIDGET w); -extern "C" void fl_widget_set_output(WIDGET w); -extern "C" void fl_widget_clear_output(WIDGET w); -extern "C" int fl_widget_visible(WIDGET w); -extern "C" int fl_widget_visible_r(WIDGET w); -extern "C" void fl_widget_set_visible(WIDGET w); -extern "C" void fl_widget_clear_visible(WIDGET w); - - -extern "C" int fl_widget_get_visible_focus(WIDGET w); -extern "C" void fl_widget_set_visible_focus(WIDGET w, int f); -extern "C" int fl_widget_take_focus(WIDGET w); -extern "C" int fl_widget_takesevents(WIDGET w); - - -extern "C" unsigned int fl_widget_get_color(WIDGET w); -extern "C" void fl_widget_set_color(WIDGET w, unsigned int b); -extern "C" unsigned int fl_widget_get_selection_color(WIDGET w); -extern "C" void fl_widget_set_selection_color(WIDGET w, unsigned int c); - - -extern "C" void * fl_widget_get_parent(WIDGET w); -extern "C" int fl_widget_contains(WIDGET w, WIDGET i); -extern "C" int fl_widget_inside(WIDGET w, WIDGET p); -extern "C" void * fl_widget_window(WIDGET w); -extern "C" void * fl_widget_top_window(WIDGET w); -extern "C" void * fl_widget_top_window_offset(WIDGET w, int &x, int &y); - - -extern "C" unsigned int fl_widget_get_align(WIDGET w); -extern "C" void fl_widget_set_align(WIDGET w, unsigned int a); -extern "C" int fl_widget_get_box(WIDGET w); -extern "C" void fl_widget_set_box(WIDGET w, int b); -extern "C" const char * fl_widget_tooltip(WIDGET w); -extern "C" void fl_widget_copy_tooltip(WIDGET w, const char * t); - - -extern "C" const char* fl_widget_get_label(WIDGET w); -extern "C" void fl_widget_set_label(WIDGET w, const char* t); -extern "C" unsigned int fl_widget_get_labelcolor(WIDGET w); -extern "C" void fl_widget_set_labelcolor(WIDGET w, unsigned int v); -extern "C" int fl_widget_get_labelfont(WIDGET w); -extern "C" void fl_widget_set_labelfont(WIDGET w, int f); -extern "C" int fl_widget_get_labelsize(WIDGET w); -extern "C" void fl_widget_set_labelsize(WIDGET w, int s); -extern "C" int fl_widget_get_labeltype(WIDGET w); -extern "C" void fl_widget_set_labeltype(WIDGET w, int l); -extern "C" void fl_widget_measure_label(WIDGET w, int &d, int &h); - - -extern "C" void fl_widget_set_callback(WIDGET w, void * cb); -extern "C" unsigned int fl_widget_get_when(WIDGET w); -extern "C" void fl_widget_set_when(WIDGET w, unsigned int c); - - -extern "C" int fl_widget_get_x(WIDGET w); -extern "C" int fl_widget_get_y(WIDGET w); -extern "C" int fl_widget_get_w(WIDGET w); -extern "C" int fl_widget_get_h(WIDGET w); -extern "C" void fl_widget_size(WIDGET w, int d, int h); -extern "C" void fl_widget_position(WIDGET w, int x, int y); - - -extern "C" void fl_widget_set_image(WIDGET w, void * img); -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_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); - - -#endif - diff --git a/src/c_fl_window.cpp b/src/c_fl_window.cpp deleted file mode 100644 index d6bb262..0000000 --- a/src/c_fl_window.cpp +++ /dev/null @@ -1,247 +0,0 @@ - - -#include <FL/Fl_Window.H> -#include <FL/Fl_RGB_Image.H> -#include "c_fl_window.h" -#include "c_fl_type.h" - - - - -class My_Window : public Fl_Window { - public: - using Fl_Window::Fl_Window; - friend void window_set_draw_hook(WINDOW n, void * d); - friend void fl_window_draw(WINDOW n); - friend void window_set_handle_hook(WINDOW n, void * h); - friend int fl_window_handle(WINDOW n, 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_Window::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Window::real_draw() { - Fl_Window::draw(); -} - -int My_Window::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Window::real_handle(int e) { - return Fl_Window::handle(e); -} - -void window_set_draw_hook(WINDOW n, void * d) { - reinterpret_cast<My_Window*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_window_draw(WINDOW n) { - reinterpret_cast<My_Window*>(n)->real_draw(); -} - -void window_set_handle_hook(WINDOW n, void * h) { - reinterpret_cast<My_Window*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_window_handle(WINDOW n, int e) { - return reinterpret_cast<My_Window*>(n)->real_handle(e); -} - - - - -WINDOW new_fl_window(int x, int y, int w, int h, char* label) { - My_Window *n = new My_Window(x, y, w, h, label); - return n; -} - -WINDOW new_fl_window2(int w, int h, char* label) { - My_Window *n = new My_Window(w, h, label); - return n; -} - -void free_fl_window(WINDOW n) { - delete reinterpret_cast<My_Window*>(n); -} - - - - -void fl_window_show(WINDOW n) { - // virtual, so disable dispatch - reinterpret_cast<Fl_Window*>(n)->Fl_Window::show(); -} - -void fl_window_hide(WINDOW n) { - // virtual, so disable dispatch - reinterpret_cast<Fl_Window*>(n)->Fl_Window::hide(); -} - -int fl_window_shown(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->shown(); -} - -void fl_window_wait_for_expose(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->wait_for_expose(); -} - -void fl_window_iconize(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->iconize(); -} - -void fl_window_make_current(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->make_current(); -} - -void fl_window_free_position(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->free_position(); -} - - - - -unsigned int fl_window_fullscreen_active(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->fullscreen_active(); -} - -void fl_window_fullscreen(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->fullscreen(); -} - -void fl_window_fullscreen_off(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->fullscreen_off(); -} - -void fl_window_fullscreen_off2(WINDOW n, int x, int y, int w, int h) { - reinterpret_cast<Fl_Window*>(n)->fullscreen_off(x,y,w,h); -} - -void fl_window_fullscreen_screens(WINDOW n, int t, int b, int l, int r) { - reinterpret_cast<Fl_Window*>(n)->fullscreen_screens(t,b,l,r); -} - - - - -void fl_window_set_icon(WINDOW n, void * img) { - reinterpret_cast<Fl_Window*>(n)->icon(reinterpret_cast<Fl_RGB_Image*>(img)); -} - -void fl_window_default_icon(void * img) { - Fl_Window::default_icon(reinterpret_cast<Fl_RGB_Image*>(img)); -} - -const char * fl_window_get_iconlabel(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->iconlabel(); -} - -void fl_window_set_iconlabel(WINDOW n, const char * s) { - reinterpret_cast<Fl_Window*>(n)->iconlabel(s); -} - -void fl_window_set_cursor(WINDOW n, int c) { - reinterpret_cast<Fl_Window*>(n)->cursor(static_cast<Fl_Cursor>(c)); -} - -void fl_window_set_cursor2(WINDOW n, void * img, int x, int y) { - reinterpret_cast<Fl_Window*>(n)->cursor(reinterpret_cast<Fl_RGB_Image*>(img),x,y); -} - -void fl_window_set_default_cursor(WINDOW n, int c) { - reinterpret_cast<Fl_Window*>(n)->default_cursor(static_cast<Fl_Cursor>(c)); -} - - - - -unsigned int fl_window_get_border(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->border(); -} - -void fl_window_set_border(WINDOW n, int b) { - reinterpret_cast<Fl_Window*>(n)->border(b); -} - -unsigned int fl_window_get_override(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->override(); -} - -void fl_window_set_override(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->set_override(); -} - -unsigned int fl_window_modal(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->modal(); -} - -unsigned int fl_window_non_modal(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->non_modal(); -} - -void fl_window_clear_modal_states(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->clear_modal_states(); -} - -void fl_window_set_modal(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->set_modal(); -} - -void fl_window_set_non_modal(WINDOW n) { - reinterpret_cast<Fl_Window*>(n)->set_non_modal(); -} - - - - -const char * fl_window_get_label(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->label(); -} - -void fl_window_set_label(WINDOW n, char* text) { - reinterpret_cast<Fl_Window*>(n)->copy_label(text); -} - -void fl_window_hotspot(WINDOW n, int x, int y, int s) { - reinterpret_cast<Fl_Window*>(n)->hotspot(x,y,s); -} - -void fl_window_hotspot2(WINDOW n, void * i, int s) { - reinterpret_cast<Fl_Window*>(n)->hotspot(reinterpret_cast<Fl_Widget*>(i),s); -} - -void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) { - reinterpret_cast<Fl_Window*>(n)->size_range(lw, lh, hw, hh, dw, dh, a); -} - -void fl_window_shape(WINDOW n, void * p) { - reinterpret_cast<Fl_Window*>(n)->shape(reinterpret_cast<Fl_Image*>(p)); -} - - - - -int fl_window_get_x_root(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->x_root(); -} - -int fl_window_get_y_root(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->y_root(); -} - -int fl_window_get_decorated_w(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->decorated_w(); -} - -int fl_window_get_decorated_h(WINDOW n) { - return reinterpret_cast<Fl_Window*>(n)->decorated_h(); -} - diff --git a/src/c_fl_window.h b/src/c_fl_window.h deleted file mode 100644 index e65b6f7..0000000 --- a/src/c_fl_window.h +++ /dev/null @@ -1,80 +0,0 @@ - - -#ifndef FL_WINDOW_GUARD -#define FL_WINDOW_GUARD - - - - -typedef void* WINDOW; - - - - -extern "C" void window_set_draw_hook(WINDOW n, void * d); -extern "C" void fl_window_draw(WINDOW n); -extern "C" void window_set_handle_hook(WINDOW n, void * h); -extern "C" int fl_window_handle(WINDOW n, int e); - - - - -extern "C" WINDOW new_fl_window(int x, int y, int w, int h, char* label); -extern "C" WINDOW new_fl_window2(int w, int h, char* label); -extern "C" void free_fl_window(WINDOW n); - - - - -extern "C" void fl_window_show(WINDOW n); -extern "C" void fl_window_hide(WINDOW n); -extern "C" int fl_window_shown(WINDOW n); -extern "C" void fl_window_wait_for_expose(WINDOW n); -extern "C" void fl_window_iconize(WINDOW n); -extern "C" void fl_window_make_current(WINDOW n); -extern "C" void fl_window_free_position(WINDOW n); - - -extern "C" unsigned int fl_window_fullscreen_active(WINDOW n); -extern "C" void fl_window_fullscreen(WINDOW n); -extern "C" void fl_window_fullscreen_off(WINDOW n); -extern "C" void fl_window_fullscreen_off2(WINDOW n, int x, int y, int w, int h); -extern "C" void fl_window_fullscreen_screens(WINDOW n, int t, int b, int l, int r); - - -extern "C" void fl_window_set_icon(WINDOW n, void * img); -extern "C" void fl_window_default_icon(void * img); -extern "C" const char * fl_window_get_iconlabel(WINDOW n); -extern "C" void fl_window_set_iconlabel(WINDOW n, const char * s); -extern "C" void fl_window_set_cursor(WINDOW n, int c); -extern "C" void fl_window_set_cursor2(WINDOW n, void * img, int x, int y); -extern "C" void fl_window_set_default_cursor(WINDOW n, int c); - - -extern "C" unsigned int fl_window_get_border(WINDOW n); -extern "C" void fl_window_set_border(WINDOW n, int b); -extern "C" unsigned int fl_window_get_override(WINDOW n); -extern "C" void fl_window_set_override(WINDOW n); -extern "C" unsigned int fl_window_modal(WINDOW n); -extern "C" unsigned int fl_window_non_modal(WINDOW n); -extern "C" void fl_window_clear_modal_states(WINDOW n); -extern "C" void fl_window_set_modal(WINDOW n); -extern "C" void fl_window_set_non_modal(WINDOW n); - - -extern "C" const char * fl_window_get_label(WINDOW n); -extern "C" void fl_window_set_label(WINDOW n, char* text); -extern "C" void fl_window_hotspot(WINDOW n, int x, int y, int s); -extern "C" void fl_window_hotspot2(WINDOW n, void * i, int s); -extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); -extern "C" void fl_window_shape(WINDOW n, void * p); - - -extern "C" int fl_window_get_x_root(WINDOW n); -extern "C" int fl_window_get_y_root(WINDOW n); -extern "C" int fl_window_get_decorated_w(WINDOW n); -extern "C" int fl_window_get_decorated_h(WINDOW n); - - -#endif - diff --git a/src/c_fl_wizard.cpp b/src/c_fl_wizard.cpp deleted file mode 100644 index 0d7ba4b..0000000 --- a/src/c_fl_wizard.cpp +++ /dev/null @@ -1,106 +0,0 @@ - - -#include <FL/Fl_Wizard.H> -#include "c_fl_wizard.h" -#include "c_fl_type.h" - - - - -class My_Wizard : public Fl_Wizard { - public: - using Fl_Wizard::Fl_Wizard; - friend void wizard_set_draw_hook(WIZARD w, void * d); - friend void fl_wizard_draw(WIZARD w); - friend void wizard_set_handle_hook(WIZARD w, void * h); - friend int fl_wizard_handle(WIZARD w, int e); - protected: - void draw(); - void real_draw(); - int handle(int e); - int real_handle(int e); - d_hook_p draw_hook; - h_hook_p handle_hook; -}; - -void My_Wizard::draw() { - (*draw_hook)(this->user_data()); -} - -void My_Wizard::real_draw() { - //Fl_Wizard::draw(); - - // required because of Fl_Wizard::draw() being private - // probably a bug in FLTK? - Fl_Widget *kid = value(); - if (damage() & FL_DAMAGE_ALL) { - if (kid) { - draw_box(box(), x(), y(), w(), h(), kid->color()); - draw_child(*kid); - } else { - draw_box(box(), x(), y(), w(), h(), color()); - } - } else if (kid) { - update_child(*kid); - } -} - -int My_Wizard::handle(int e) { - return (*handle_hook)(this->user_data(), e); -} - -int My_Wizard::real_handle(int e) { - return Fl_Wizard::handle(e); -} - -void wizard_set_draw_hook(WIZARD w, void * d) { - reinterpret_cast<My_Wizard*>(w)->draw_hook = reinterpret_cast<d_hook_p>(d); -} - -void fl_wizard_draw(WIZARD w) { - reinterpret_cast<My_Wizard*>(w)->real_draw(); -} - -void wizard_set_handle_hook(WIZARD w, void * h) { - reinterpret_cast<My_Wizard*>(w)->handle_hook = reinterpret_cast<h_hook_p>(h); -} - -int fl_wizard_handle(WIZARD w, int e) { - return reinterpret_cast<My_Wizard*>(w)->real_handle(e); -} - - - - -WIZARD new_fl_wizard(int x, int y, int w, int h, char* label) { - My_Wizard *g = new My_Wizard(x, y, w, h, label); - return g; -} - -void free_fl_wizard(WIZARD w) { - delete reinterpret_cast<My_Wizard*>(w); -} - - - - -void fl_wizard_next(WIZARD w) { - reinterpret_cast<Fl_Wizard*>(w)->next(); -} - -void fl_wizard_prev(WIZARD w) { - reinterpret_cast<Fl_Wizard*>(w)->prev(); -} - - - - -void * fl_wizard_get_visible(WIZARD w) { - return reinterpret_cast<Fl_Wizard*>(w)->value(); -} - -void fl_wizard_set_visible(WIZARD w, void * i) { - reinterpret_cast<Fl_Wizard*>(w)->value(reinterpret_cast<Fl_Widget*>(i)); -} - - diff --git a/src/c_fl_wizard.h b/src/c_fl_wizard.h deleted file mode 100644 index 2068683..0000000 --- a/src/c_fl_wizard.h +++ /dev/null @@ -1,37 +0,0 @@ - - -#ifndef FL_WIZARD_GUARD -#define FL_WIZARD_GUARD - - - - -typedef void* WIZARD; - - - - -extern "C" void wizard_set_draw_hook(WIZARD w, void * d); -extern "C" void fl_wizard_draw(WIZARD w); -extern "C" void wizard_set_handle_hook(WIZARD w, void * h); -extern "C" int fl_wizard_handle(WIZARD w, int e); - - - - -extern "C" WIZARD new_fl_wizard(int x, int y, int w, int h, char* label); -extern "C" void free_fl_wizard(WIZARD w); - - - - -extern "C" void fl_wizard_next(WIZARD w); -extern "C" void fl_wizard_prev(WIZARD w); - - -extern "C" void * fl_wizard_get_visible(WIZARD w); -extern "C" void fl_wizard_set_visible(WIZARD w, void * i); - - -#endif - diff --git a/src/c_fl_xbm_image.cpp b/src/c_fl_xbm_image.cpp deleted file mode 100644 index e44cbb2..0000000 --- a/src/c_fl_xbm_image.cpp +++ /dev/null @@ -1,17 +0,0 @@ - - -#include <FL/Fl_XBM_Image.H> -#include "c_fl_xbm_image.h" - - - - -XBM_IMAGE new_fl_xbm_image(const char * f) { - Fl_XBM_Image *b = new Fl_XBM_Image(f); - return b; -} - -void free_fl_xbm_image(XBM_IMAGE b) { - delete reinterpret_cast<Fl_XBM_Image*>(b); -} - diff --git a/src/c_fl_xbm_image.h b/src/c_fl_xbm_image.h deleted file mode 100644 index 9b0c967..0000000 --- a/src/c_fl_xbm_image.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_XBM_IMAGE_GUARD -#define FL_XBM_IMAGE_GUARD - - - - -typedef void* XBM_IMAGE; - - - - -extern "C" XBM_IMAGE new_fl_xbm_image(const char * f); -extern "C" void free_fl_xbm_image(XBM_IMAGE b); - - -#endif - diff --git a/src/c_fl_xpm_image.cpp b/src/c_fl_xpm_image.cpp deleted file mode 100644 index dae1c12..0000000 --- a/src/c_fl_xpm_image.cpp +++ /dev/null @@ -1,17 +0,0 @@ - - -#include <FL/Fl_XPM_Image.H> -#include "c_fl_xpm_image.h" - - - - -XPM_IMAGE new_fl_xpm_image(const char * f) { - Fl_XPM_Image *j = new Fl_XPM_Image(f); - return j; -} - -void free_fl_xpm_image(XPM_IMAGE j) { - delete reinterpret_cast<Fl_XPM_Image*>(j); -} - diff --git a/src/c_fl_xpm_image.h b/src/c_fl_xpm_image.h deleted file mode 100644 index 3d01e61..0000000 --- a/src/c_fl_xpm_image.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_XPM_IMAGE_GUARD -#define FL_XPM_IMAGE_GUARD - - - - -typedef void* XPM_IMAGE; - - - - -extern "C" XPM_IMAGE new_fl_xpm_image(const char * f); -extern "C" void free_fl_xpm_image(XPM_IMAGE j); - - -#endif - diff --git a/src/fltk-devices-graphics.adb b/src/fltk-devices-graphics.adb deleted file mode 100644 index e267690..0000000 --- a/src/fltk-devices-graphics.adb +++ /dev/null @@ -1,168 +0,0 @@ - - -with - - Interfaces.C, - System; - - -package body FLTK.Devices.Graphics is - - - function fl_graphics_driver_color - (G : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_graphics_driver_color, "fl_graphics_driver_color"); - pragma Inline (fl_graphics_driver_color); - - - - - function fl_graphics_driver_descent - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_graphics_driver_descent, "fl_graphics_driver_descent"); - pragma Inline (fl_graphics_driver_descent); - - function fl_graphics_driver_height - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_graphics_driver_height, "fl_graphics_driver_height"); - pragma Inline (fl_graphics_driver_height); - - function fl_graphics_driver_width - (G : in System.Address; - C : in Interfaces.C.unsigned) - return Interfaces.C.double; - pragma Import (C, fl_graphics_driver_width, "fl_graphics_driver_width"); - pragma Inline (fl_graphics_driver_width); - - function fl_graphics_driver_width2 - (G : in System.Address; - S : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.double; - pragma Import (C, fl_graphics_driver_width2, "fl_graphics_driver_width2"); - pragma Inline (fl_graphics_driver_width2); - - function fl_graphics_driver_get_font - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_graphics_driver_get_font, "fl_graphics_driver_get_font"); - pragma Inline (fl_graphics_driver_get_font); - - function fl_graphics_driver_size - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_graphics_driver_size, "fl_graphics_driver_size"); - pragma Inline (fl_graphics_driver_size); - - procedure fl_graphics_driver_set_font - (G : in System.Address; - K, S : in Interfaces.C.int); - pragma Import (C, fl_graphics_driver_set_font, "fl_graphics_driver_set_font"); - pragma Inline (fl_graphics_driver_set_font); - - - - - procedure fl_graphics_driver_draw_scaled - (G, I : in System.Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_graphics_driver_draw_scaled, "fl_graphics_driver_draw_scaled"); - pragma Inline (fl_graphics_driver_draw_scaled); - - - - - function Get_Color - (This : in Graphics_Driver) - return Color is - begin - return Color (fl_graphics_driver_color (This.Void_Ptr)); - end Get_Color; - - - - - function Get_Text_Descent - (This : in Graphics_Driver) - return Integer is - begin - return Integer (fl_graphics_driver_descent (This.Void_Ptr)); - end Get_Text_Descent; - - - function Get_Line_Height - (This : in Graphics_Driver) - return Integer is - begin - return Integer (fl_graphics_driver_height (This.Void_Ptr)); - end Get_Line_Height; - - - function Get_Width - (This : in Graphics_Driver; - Char : in Character) - return Long_Float is - begin - return Long_Float (fl_graphics_driver_width (This.Void_Ptr, Character'Pos (Char))); - end Get_Width; - - - function Get_Width - (This : in Graphics_Driver; - Str : in String) - return Long_Float is - begin - return Long_Float (fl_graphics_driver_width2 - (This.Void_Ptr, - Interfaces.C.To_C (Str), - Str'Length)); - end Get_Width; - - - function Get_Font_Kind - (This : in Graphics_Driver) - return Font_Kind is - begin - return Font_Kind'Val (fl_graphics_driver_get_font (This.Void_Ptr)); - end Get_Font_Kind; - - - function Get_Font_Size - (This : in Graphics_Driver) - return Font_Size is - begin - return Font_Size (fl_graphics_driver_size (This.Void_Ptr)); - end Get_Font_Size; - - - procedure Set_Font - (This : in Graphics_Driver; - Face : in Font_Kind; - Size : in Font_Size) is - begin - fl_graphics_driver_set_font (This.Void_Ptr, Font_Kind'Pos (Face), Interfaces.C.int (Size)); - end Set_Font; - - - - - procedure Draw_Scaled_Image - (This : in Graphics_Driver; - Img : in FLTK.Images.Image'Class; - X, Y, W, H : in Integer) is - begin - fl_graphics_driver_draw_scaled - (This.Void_Ptr, - Wrapper (Img).Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Draw_Scaled_Image; - - -end FLTK.Devices.Graphics; - diff --git a/src/fltk-devices-graphics.ads b/src/fltk-devices-graphics.ads deleted file mode 100644 index abb6c5f..0000000 --- a/src/fltk-devices-graphics.ads +++ /dev/null @@ -1,89 +0,0 @@ - - -with - - FLTK.Images; - - -package FLTK.Devices.Graphics is - - - type Graphics_Driver is new Device with private; - - type Graphics_Driver_Reference (Data : not null access Graphics_Driver'Class) is - limited null record with Implicit_Dereference => Data; - - - - - function Get_Color - (This : in Graphics_Driver) - return Color; - - - - - function Get_Text_Descent - (This : in Graphics_Driver) - return Integer; - - function Get_Line_Height - (This : in Graphics_Driver) - return Integer; - - function Get_Width - (This : in Graphics_Driver; - Char : in Character) - return Long_Float; - - function Get_Width - (This : in Graphics_Driver; - Str : in String) - return Long_Float; - - function Get_Font_Kind - (This : in Graphics_Driver) - return Font_Kind; - - function Get_Font_Size - (This : in Graphics_Driver) - return Font_Size; - - procedure Set_Font - (This : in Graphics_Driver; - Face : in Font_Kind; - Size : in Font_Size); - - - - - procedure Draw_Scaled_Image - (This : in Graphics_Driver; - Img : in FLTK.Images.Image'Class; - X, Y, W, H : in Integer); - - -private - - - type Graphics_Driver is new Device with null record; - - - - - pragma Inline (Get_Color); - - - pragma Inline (Get_Text_Descent); - pragma Inline (Get_Line_Height); - pragma Inline (Get_Width); - pragma Inline (Get_Font_Kind); - pragma Inline (Get_Font_Size); - pragma Inline (Set_Font); - - - pragma Inline (Draw_Scaled_Image); - - -end FLTK.Devices.Graphics; - diff --git a/src/fltk-devices-surfaces-copy.adb b/src/fltk-devices-surfaces-copy.adb deleted file mode 100644 index cceb945..0000000 --- a/src/fltk-devices-surfaces-copy.adb +++ /dev/null @@ -1,157 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Devices.Surfaces.Copy is - - - function new_fl_copy_surface - (W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_copy_surface, "new_fl_copy_surface"); - pragma Inline (new_fl_copy_surface); - - procedure free_fl_copy_surface - (S : in System.Address); - pragma Import (C, free_fl_copy_surface, "free_fl_copy_surface"); - pragma Inline (free_fl_copy_surface); - - - - - function fl_copy_surface_get_w - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_copy_surface_get_w, "fl_copy_surface_get_w"); - pragma Inline (fl_copy_surface_get_w); - - function fl_copy_surface_get_h - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_copy_surface_get_h, "fl_copy_surface_get_h"); - pragma Inline (fl_copy_surface_get_h); - - - - - procedure fl_copy_surface_draw - (S, W : in System.Address; - OX, OY : in Interfaces.C.int); - pragma Import (C, fl_copy_surface_draw, "fl_copy_surface_draw"); - pragma Inline (fl_copy_surface_draw); - - procedure fl_copy_surface_draw_decorated_window - (S, W : in System.Address; - OX, OY : in Interfaces.C.int); - pragma Import (C, fl_copy_surface_draw_decorated_window, - "fl_copy_surface_draw_decorated_window"); - pragma Inline (fl_copy_surface_draw_decorated_window); - - - - - procedure fl_copy_surface_set_current - (S : in System.Address); - pragma Import (C, fl_copy_surface_set_current, "fl_copy_surface_set_current"); - pragma Inline (fl_copy_surface_set_current); - - - - - procedure Finalize - (This : in out Copy_Surface) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Copy_Surface'Class - then - free_fl_copy_surface (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Surface_Device (This)); - end Finalize; - - - - - package body Forge is - - function Create - (W, H : in Natural) - return Copy_Surface is - begin - return This : Copy_Surface do - This.Void_Ptr := new_fl_copy_surface - (Interfaces.C.int (W), - Interfaces.C.int (H)); - end return; - end Create; - - end Forge; - - - - - function Get_W - (This : in Copy_Surface) - return Integer is - begin - return Integer (fl_copy_surface_get_w (This.Void_Ptr)); - end Get_W; - - - function Get_H - (This : in Copy_Surface) - return Integer is - begin - return Integer (fl_copy_surface_get_h (This.Void_Ptr)); - end Get_H; - - - - - procedure Draw_Widget - (This : in out Copy_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_copy_surface_draw - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Draw_Widget; - - - procedure Draw_Decorated_Window - (This : in out Copy_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_copy_surface_draw_decorated_window - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Draw_Decorated_Window; - - - - - procedure Set_Current - (This : in out Copy_Surface) is - begin - fl_copy_surface_set_current (This.Void_Ptr); - Current_Ptr := This'Unchecked_Access; - end Set_Current; - - -end FLTK.Devices.Surfaces.Copy; - diff --git a/src/fltk-devices-surfaces-copy.ads b/src/fltk-devices-surfaces-copy.ads deleted file mode 100644 index d0a0d2f..0000000 --- a/src/fltk-devices-surfaces-copy.ads +++ /dev/null @@ -1,81 +0,0 @@ - - -with - - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surfaces.Copy is - - - type Copy_Surface is new Surface_Device with private; - - type Copy_Surface_Reference (Data : not null access Copy_Surface'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (W, H : in Natural) - return Copy_Surface; - - end Forge; - - - - - function Get_W - (This : in Copy_Surface) - return Integer; - - function Get_H - (This : in Copy_Surface) - return Integer; - - - - - procedure Draw_Widget - (This : in out Copy_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Draw_Decorated_Window - (This : in out Copy_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0); - - - - - procedure Set_Current - (This : in out Copy_Surface); - - -private - - - type Copy_Surface is new Surface_Device with null record; - - overriding procedure Finalize - (This : in out Copy_Surface); - - - - - pragma Inline (Get_W); - pragma Inline (Get_H); - - - pragma Inline (Draw_Widget); - pragma Inline (Draw_Decorated_Window); - - - pragma Inline (Set_Current); - - -end FLTK.Devices.Surfaces.Copy; - diff --git a/src/fltk-devices-surfaces-image.adb b/src/fltk-devices-surfaces-image.adb deleted file mode 100644 index 570f729..0000000 --- a/src/fltk-devices-surfaces-image.adb +++ /dev/null @@ -1,174 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Devices.Surfaces.Image is - - - function new_fl_image_surface - (W, H, R : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_image_surface, "new_fl_image_surface"); - pragma Inline (new_fl_image_surface); - - procedure free_fl_image_surface - (S : in System.Address); - pragma Import (C, free_fl_image_surface, "free_fl_image_surface"); - pragma Inline (free_fl_image_surface); - - - - - procedure fl_image_surface_draw - (S, I : in System.Address; - OX, OY : in Interfaces.C.int); - pragma Import (C, fl_image_surface_draw, "fl_image_surface_draw"); - pragma Inline (fl_image_surface_draw); - - procedure fl_image_surface_draw_decorated_window - (S, I : in System.Address; - OX, OY : in Interfaces.C.int); - pragma Import (C, fl_image_surface_draw_decorated_window, - "fl_image_surface_draw_decorated_window"); - pragma Inline (fl_image_surface_draw_decorated_window); - - - - - function fl_image_surface_image - (S : in System.Address) - return System.Address; - pragma Import (C, fl_image_surface_image, "fl_image_surface_image"); - pragma Inline (fl_image_surface_image); - - function fl_image_surface_highres_image - (S : in System.Address) - return System.Address; - pragma Import (C, fl_image_surface_highres_image, "fl_image_surface_highres_image"); - pragma Inline (fl_image_surface_highres_image); - - - - - procedure fl_image_surface_set_current - (S : in System.Address); - pragma Import (C, fl_image_surface_set_current, "fl_image_surface_set_current"); - pragma Inline (fl_image_surface_set_current); - - - - - procedure Finalize - (This : in out Image_Surface) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Image_Surface'Class - then - free_fl_image_surface (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Surface_Device (This)); - end Finalize; - - - - - package body Forge is - - function Create - (W, H : in Integer; - Highres : in Boolean := False) - return Image_Surface is - begin - return This : Image_Surface do - This.Void_Ptr := new_fl_image_surface - (Interfaces.C.int (W), - Interfaces.C.int (H), - Boolean'Pos (Highres)); - This.High := Highres; - end return; - end Create; - - end Forge; - - - - - function Is_Highres - (This : in Image_Surface) - return Boolean is - begin - return This.High; - end Is_Highres; - - - - - procedure Draw_Widget - (This : in out Image_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_image_surface_draw - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Draw_Widget; - - - procedure Draw_Decorated_Window - (This : in out Image_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_image_surface_draw_decorated_window - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Draw_Decorated_Window; - - - - - function Get_Image - (This : in Image_Surface) - return FLTK.Images.RGB.RGB_Image is - begin - return Img : FLTK.Images.RGB.RGB_Image do - Wrapper (Img).Void_Ptr := fl_image_surface_image (This.Void_Ptr); - end return; - end Get_Image; - - - function Get_Highres_Image - (This : in Image_Surface) - return FLTK.Images.Shared.Shared_Image is - begin - return Img : FLTK.Images.Shared.Shared_Image do - Wrapper (Img).Void_Ptr := fl_image_surface_highres_image (This.Void_Ptr); - end return; - end Get_Highres_Image; - - - - - procedure Set_Current - (This : in out Image_Surface) is - begin - fl_image_surface_set_current (This.Void_Ptr); - Current_Ptr := This'Unchecked_Access; - end Set_Current; - - -end FLTK.Devices.Surfaces.Image; - diff --git a/src/fltk-devices-surfaces-image.ads b/src/fltk-devices-surfaces-image.ads deleted file mode 100644 index 21870dd..0000000 --- a/src/fltk-devices-surfaces-image.ads +++ /dev/null @@ -1,96 +0,0 @@ - - -with - - FLTK.Images.RGB, - FLTK.Images.Shared, - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surfaces.Image is - - - type Image_Surface is new Surface_Device with private; - - type Image_Surface_Reference (Data : not null access Image_Surface'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (W, H : in Integer; - Highres : in Boolean := False) - return Image_Surface; - - end Forge; - - - - - function Is_Highres - (This : in Image_Surface) - return Boolean; - - - - - procedure Draw_Widget - (This : in out Image_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Draw_Decorated_Window - (This : in out Image_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0); - - - - - function Get_Image - (This : in Image_Surface) - return FLTK.Images.RGB.RGB_Image; - - function Get_Highres_Image - (This : in Image_Surface) - return FLTK.Images.Shared.Shared_Image; - - - - - procedure Set_Current - (This : in out Image_Surface); - - -private - - - type Image_Surface is new Surface_Device with record - High : Boolean := False; - end record; - - overriding procedure Finalize - (This : in out Image_Surface); - - - - - pragma Inline (Is_Highres); - - - pragma Inline (Draw_Widget); - pragma Inline (Draw_Decorated_Window); - - - pragma Inline (Get_Image); - pragma Inline (Get_Highres_Image); - - - pragma Inline (Set_Current); - - -end FLTK.Devices.Surfaces.Image; - diff --git a/src/fltk-devices-surfaces-paged-printers.adb b/src/fltk-devices-surfaces-paged-printers.adb deleted file mode 100644 index bdc34b0..0000000 --- a/src/fltk-devices-surfaces-paged-printers.adb +++ /dev/null @@ -1,358 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Devices.Surfaces.Paged.Printers is - - - function new_fl_printer - return System.Address; - pragma Import (C, new_fl_printer, "new_fl_printer"); - pragma Inline (new_fl_printer); - - procedure free_fl_printer - (D : in System.Address); - pragma Import (C, free_fl_printer, "free_fl_printer"); - pragma Inline (free_fl_printer); - - - - - function fl_printer_start_job - (D : in System.Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_printer_start_job, "fl_printer_start_job"); - pragma Inline (fl_printer_start_job); - - function fl_printer_start_job2 - (D : in System.Address; - C, F, T : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_printer_start_job2, "fl_printer_start_job2"); - pragma Inline (fl_printer_start_job2); - - procedure fl_printer_end_job - (D : in System.Address); - pragma Import (C, fl_printer_end_job, "fl_printer_end_job"); - pragma Inline (fl_printer_end_job); - - function fl_printer_start_page - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_printer_start_page, "fl_printer_start_page"); - pragma Inline (fl_printer_start_page); - - function fl_printer_end_page - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_printer_end_page, "fl_printer_end_page"); - pragma Inline (fl_printer_end_page); - - - - - procedure fl_printer_margins - (D : in System.Address; - L, T, R, B : out Interfaces.C.int); - pragma Import (C, fl_printer_margins, "fl_printer_margins"); - pragma Inline (fl_printer_margins); - - function fl_printer_printable_rect - (D : in System.Address; - W, H : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_printer_printable_rect, "fl_printer_printable_rect"); - pragma Inline (fl_printer_printable_rect); - - procedure fl_printer_get_origin - (D : in System.Address; - X, Y : out Interfaces.C.int); - pragma Import (C, fl_printer_get_origin, "fl_printer_get_origin"); - pragma Inline (fl_printer_get_origin); - - procedure fl_printer_set_origin - (D : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_printer_set_origin, "fl_printer_set_origin"); - pragma Inline (fl_printer_set_origin); - - procedure fl_printer_rotate - (D : in System.Address; - R : in Interfaces.C.C_float); - pragma Import (C, fl_printer_rotate, "fl_printer_rotate"); - pragma Inline (fl_printer_rotate); - - procedure fl_printer_scale - (D : in System.Address; - X, Y : in Interfaces.C.C_float); - pragma Import (C, fl_printer_scale, "fl_printer_scale"); - pragma Inline (fl_printer_scale); - - procedure fl_printer_translate - (D : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_printer_translate, "fl_printer_translate"); - pragma Inline (fl_printer_translate); - - procedure fl_printer_untranslate - (D : in System.Address); - pragma Import (C, fl_printer_untranslate, "fl_printer_untranslate"); - pragma Inline (fl_printer_untranslate); - - - - - procedure fl_printer_print_widget - (D, I : in System.Address; - DX, DY : in Interfaces.C.int); - pragma Import (C, fl_printer_print_widget, "fl_printer_print_widget"); - pragma Inline (fl_printer_print_widget); - - procedure fl_printer_print_window_part - (D, I : in System.Address; - X, Y, W, H, DX, DY : in Interfaces.C.int); - pragma Import (C, fl_printer_print_window_part, "fl_printer_print_window_part"); - pragma Inline (fl_printer_print_window_part); - - - - - procedure fl_printer_set_current - (D : in System.Address); - pragma Import (C, fl_printer_set_current, "fl_printer_set_current"); - pragma Inline (fl_printer_set_current); - - - - - procedure Finalize - (This : in out Printer) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Printer'Class - then - free_fl_printer (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Paged_Surface (This)); - end Finalize; - - - - - package body Forge is - - function Create - return Printer is - begin - return This : Printer do - This.Void_Ptr := new_fl_printer; - end return; - end Create; - - pragma Inline (Create); - - end Forge; - - - - - procedure Start_Job - (This : in out Printer; - Count : in Natural) is - begin - if fl_printer_start_job - (This.Void_Ptr, Interfaces.C.int (Count)) /= 0 - then - raise Page_Error; - end if; - end Start_Job; - - - procedure Start_Job - (This : in out Printer; - Count : in Natural; - From, To : in Positive) is - begin - if fl_printer_start_job2 - (This.Void_Ptr, - Interfaces.C.int (Count), - Interfaces.C.int (From), - Interfaces.C.int (To)) /= 0 - then - raise Page_Error; - end if; - end Start_Job; - - - procedure End_Job - (This : in out Printer) is - begin - fl_printer_end_job (This.Void_Ptr); - end End_Job; - - - procedure Start_Page - (This : in out Printer) is - begin - if fl_printer_start_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end Start_Page; - - - procedure End_Page - (This : in out Printer) is - begin - if fl_printer_end_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end End_Page; - - - - - procedure Get_Margins - (This : in Printer; - Left, Top, Right, Bottom : out Integer) is - begin - fl_printer_margins - (This.Void_Ptr, - Interfaces.C.int (Left), - Interfaces.C.int (Top), - Interfaces.C.int (Right), - Interfaces.C.int (Bottom)); - end Get_Margins; - - - procedure Get_Printable_Rect - (This : in Printer; - W, H : out Integer) is - begin - if fl_printer_printable_rect - (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0 - then - raise Page_Error; - end if; - end Get_Printable_Rect; - - - procedure Get_Origin - (This : in Printer; - X, Y : out Integer) is - begin - fl_printer_get_origin (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)); - end Get_Origin; - - - procedure Set_Origin - (This : in out Printer; - X, Y : in Integer) is - begin - fl_printer_set_origin - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Set_Origin; - - - procedure Rotate - (This : in out Printer; - Degrees : in Float) is - begin - fl_printer_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); - end Rotate; - - - procedure Scale - (This : in out Printer; - Factor : in Float) is - begin - fl_printer_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); - end Scale; - - - procedure Scale - (This : in out Printer; - Factor_X, Factor_Y : in Float) is - begin - fl_printer_scale - (This.Void_Ptr, - Interfaces.C.C_float (Factor_X), - Interfaces.C.C_float (Factor_Y)); - end Scale; - - - procedure Translate - (This : in out Printer; - Delta_X, Delta_Y : in Integer) is - begin - fl_printer_translate - (This.Void_Ptr, - Interfaces.C.int (Delta_X), - Interfaces.C.int (Delta_Y)); - end Translate; - - - procedure Untranslate - (This : in out Printer) is - begin - fl_printer_untranslate (This.Void_Ptr); - end Untranslate; - - - - - procedure Print_Widget - (This : in out Printer; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_printer_print_widget - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Print_Widget; - - - procedure Print_Window_Part - (This : in out Printer; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - X, Y, W, H : in Integer; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_printer_print_window_part - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Print_Window_Part; - - - - - procedure Set_Current - (This : in out Printer) is - begin - fl_printer_set_current (This.Void_Ptr); - Current_Ptr := This'Unchecked_Access; - end Set_Current; - - -end FLTK.Devices.Surfaces.Paged.Printers; - diff --git a/src/fltk-devices-surfaces-paged-printers.ads b/src/fltk-devices-surfaces-paged-printers.ads deleted file mode 100644 index b336373..0000000 --- a/src/fltk-devices-surfaces-paged-printers.ads +++ /dev/null @@ -1,141 +0,0 @@ - - -with - - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surfaces.Paged.Printers is - - - type Printer is new Paged_Surface with private; - - type Printer_Reference (Data : not null access Printer'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - return Printer; - - end Forge; - - - - - procedure Start_Job - (This : in out Printer; - Count : in Natural); - - procedure Start_Job - (This : in out Printer; - Count : in Natural; - From, To : in Positive); - - procedure End_Job - (This : in out Printer); - - procedure Start_Page - (This : in out Printer); - - procedure End_Page - (This : in out Printer); - - - - - procedure Get_Margins - (This : in Printer; - Left, Top, Right, Bottom : out Integer); - - procedure Get_Printable_Rect - (This : in Printer; - W, H : out Integer); - - procedure Get_Origin - (This : in Printer; - X, Y : out Integer); - - procedure Set_Origin - (This : in out Printer; - X, Y : in Integer); - - procedure Rotate - (This : in out Printer; - Degrees : in Float); - - procedure Scale - (This : in out Printer; - Factor : in Float); - - procedure Scale - (This : in out Printer; - Factor_X, Factor_Y : in Float); - - procedure Translate - (This : in out Printer; - Delta_X, Delta_Y : in Integer); - - procedure Untranslate - (This : in out Printer); - - - - - procedure Print_Widget - (This : in out Printer; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Print_Window_Part - (This : in out Printer; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - X, Y, W, H : in Integer; - Offset_X, Offset_Y : in Integer := 0); - - - - - procedure Set_Current - (This : in out Printer); - - -private - - - type Printer is new Paged_Surface with null record; - - overriding procedure Finalize - (This : in out Printer); - - - - - pragma Inline (Start_Job); - pragma Inline (End_Job); - pragma Inline (Start_Page); - pragma Inline (End_Page); - - - pragma Inline (Get_Margins); - pragma Inline (Get_Printable_Rect); - pragma Inline (Get_Origin); - pragma Inline (Set_Origin); - pragma Inline (Rotate); - pragma Inline (Scale); - pragma Inline (Translate); - pragma Inline (Untranslate); - - - pragma Inline (Print_Widget); - pragma Inline (Print_Window_Part); - - - pragma Inline (Set_Current); - - -end FLTK.Devices.Surfaces.Paged.Printers; - diff --git a/src/fltk-devices-surfaces-paged.adb b/src/fltk-devices-surfaces-paged.adb deleted file mode 100644 index c615078..0000000 --- a/src/fltk-devices-surfaces-paged.adb +++ /dev/null @@ -1,359 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Devices.Surfaces.Paged is - - - function new_fl_paged_device - return System.Address; - pragma Import (C, new_fl_paged_device, "new_fl_paged_device"); - pragma Inline (new_fl_paged_device); - - procedure free_fl_paged_device - (D : in System.Address); - pragma Import (C, free_fl_paged_device, "free_fl_paged_device"); - pragma Inline (free_fl_paged_device); - - - - - function fl_paged_device_start_job - (D : in System.Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_paged_device_start_job, "fl_paged_device_start_job"); - pragma Inline (fl_paged_device_start_job); - - function fl_paged_device_start_job2 - (D : in System.Address; - C, F, T : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_paged_device_start_job2, "fl_paged_device_start_job2"); - pragma Inline (fl_paged_device_start_job2); - - procedure fl_paged_device_end_job - (D : in System.Address); - pragma Import (C, fl_paged_device_end_job, "fl_paged_device_end_job"); - pragma Inline (fl_paged_device_end_job); - - function fl_paged_device_start_page - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_paged_device_start_page, "fl_paged_device_start_page"); - pragma Inline (fl_paged_device_start_page); - - function fl_paged_device_end_page - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_paged_device_end_page, "fl_paged_device_end_page"); - pragma Inline (fl_paged_device_end_page); - - - - - procedure fl_paged_device_margins - (D : in System.Address; - L, T, R, B : out Interfaces.C.int); - pragma Import (C, fl_paged_device_margins, "fl_paged_device_margins"); - pragma Inline (fl_paged_device_margins); - - function fl_paged_device_printable_rect - (D : in System.Address; - W, H : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_paged_device_printable_rect, "fl_paged_device_printable_rect"); - pragma Inline (fl_paged_device_printable_rect); - - procedure fl_paged_device_get_origin - (D : in System.Address; - X, Y : out Interfaces.C.int); - pragma Import (C, fl_paged_device_get_origin, "fl_paged_device_get_origin"); - pragma Inline (fl_paged_device_get_origin); - - procedure fl_paged_device_set_origin - (D : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_paged_device_set_origin, "fl_paged_device_set_origin"); - pragma Inline (fl_paged_device_set_origin); - - procedure fl_paged_device_rotate - (D : in System.Address; - R : in Interfaces.C.C_float); - pragma Import (C, fl_paged_device_rotate, "fl_paged_device_rotate"); - pragma Inline (fl_paged_device_rotate); - - procedure fl_paged_device_scale - (D : in System.Address; - X, Y : in Interfaces.C.C_float); - pragma Import (C, fl_paged_device_scale, "fl_paged_device_scale"); - pragma Inline (fl_paged_device_scale); - - procedure fl_paged_device_translate - (D : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_paged_device_translate, "fl_paged_device_translate"); - pragma Inline (fl_paged_device_translate); - - procedure fl_paged_device_untranslate - (D : in System.Address); - pragma Import (C, fl_paged_device_untranslate, "fl_paged_device_untranslate"); - pragma Inline (fl_paged_device_untranslate); - - - - - procedure fl_paged_device_print_widget - (D, I : in System.Address; - DX, DY : in Interfaces.C.int); - pragma Import (C, fl_paged_device_print_widget, "fl_paged_device_print_widget"); - pragma Inline (fl_paged_device_print_widget); - - procedure fl_paged_device_print_window - (D, I : in System.Address; - DX, DY : in Interfaces.C.int); - pragma Import (C, fl_paged_device_print_window, "fl_paged_device_print_window"); - pragma Inline (fl_paged_device_print_window); - - procedure fl_paged_device_print_window_part - (D, I : in System.Address; - X, Y, W, H, DX, DY : in Interfaces.C.int); - pragma Import (C, fl_paged_device_print_window_part, "fl_paged_device_print_window_part"); - pragma Inline (fl_paged_device_print_window_part); - - - - - procedure Finalize - (This : in out Paged_Surface) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Paged_Surface'Class - then - free_fl_paged_device (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Surface_Device (This)); - end Finalize; - - - - - package body Forge is - - function Create - return Paged_Surface is - begin - return This : Paged_Surface do - This.Void_Ptr := new_fl_paged_device; - end return; - end Create; - - pragma Inline (Create); - - end Forge; - - - - - procedure Start_Job - (This : in out Paged_Surface; - Count : in Natural) is - begin - if fl_paged_device_start_job - (This.Void_Ptr, Interfaces.C.int (Count)) /= 0 - then - raise Page_Error; - end if; - end Start_Job; - - - procedure Start_Job - (This : in out Paged_Surface; - Count : in Natural; - From, To : in Positive) is - begin - if fl_paged_device_start_job2 - (This.Void_Ptr, - Interfaces.C.int (Count), - Interfaces.C.int (From), - Interfaces.C.int (To)) /= 0 - then - raise Page_Error; - end if; - end Start_Job; - - - procedure End_Job - (This : in out Paged_Surface) is - begin - fl_paged_device_end_job (This.Void_Ptr); - end End_Job; - - - procedure Start_Page - (This : in out Paged_Surface) is - begin - if fl_paged_device_start_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end Start_Page; - - - procedure End_Page - (This : in out Paged_Surface) is - begin - if fl_paged_device_end_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end End_Page; - - - - - procedure Get_Margins - (This : in Paged_Surface; - Left, Top, Right, Bottom : out Integer) is - begin - fl_paged_device_margins - (This.Void_Ptr, - Interfaces.C.int (Left), - Interfaces.C.int (Top), - Interfaces.C.int (Right), - Interfaces.C.int (Bottom)); - end Get_Margins; - - - procedure Get_Printable_Rect - (This : in Paged_Surface; - W, H : out Integer) is - begin - if fl_paged_device_printable_rect - (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0 - then - raise Page_Error; - end if; - end Get_Printable_Rect; - - - procedure Get_Origin - (This : in Paged_Surface; - X, Y : out Integer) is - begin - fl_paged_device_get_origin (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)); - end Get_Origin; - - - procedure Set_Origin - (This : in out Paged_Surface; - X, Y : in Integer) is - begin - fl_paged_device_set_origin - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Set_Origin; - - - procedure Rotate - (This : in out Paged_Surface; - Degrees : in Float) is - begin - fl_paged_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); - end Rotate; - - - procedure Scale - (This : in out Paged_Surface; - Factor : in Float) is - begin - fl_paged_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); - end Scale; - - - procedure Scale - (This : in out Paged_Surface; - Factor_X, Factor_Y : in Float) is - begin - fl_paged_device_scale - (This.Void_Ptr, - Interfaces.C.C_float (Factor_X), - Interfaces.C.C_float (Factor_Y)); - end Scale; - - - procedure Translate - (This : in out Paged_Surface; - Delta_X, Delta_Y : in Integer) is - begin - fl_paged_device_translate - (This.Void_Ptr, - Interfaces.C.int (Delta_X), - Interfaces.C.int (Delta_Y)); - end Translate; - - - procedure Untranslate - (This : in out Paged_Surface) is - begin - fl_paged_device_untranslate (This.Void_Ptr); - end Untranslate; - - - - - procedure Print_Widget - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_paged_device_print_widget - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Print_Widget; - - - procedure Print_Window - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_paged_device_print_window - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Print_Window; - - - procedure Print_Window_Part - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - X, Y, W, H : in Integer; - Offset_X, Offset_Y : in Integer := 0) is - begin - fl_paged_device_print_window_part - (This.Void_Ptr, - Wrapper (Item).Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - end Print_Window_Part; - - -end FLTK.Devices.Surfaces.Paged; - diff --git a/src/fltk-devices-surfaces-paged.ads b/src/fltk-devices-surfaces-paged.ads deleted file mode 100644 index 15d0276..0000000 --- a/src/fltk-devices-surfaces-paged.ads +++ /dev/null @@ -1,152 +0,0 @@ - - -with - - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surfaces.Paged is - - - type Paged_Surface is new Surface_Device with private; - - type Paged_Surface_Reference (Data : not null access Paged_Surface'Class) is - limited null record with Implicit_Dereference => Data; - - type Page_Format is - (A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, - B0, B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, - C5E, DLE, Executive, Folio, Ledger, - Legal, Letter, Tabloid, Envelope); - - type Page_Layout is - (Potrait, Landscape, Reversed, Orientation); - - - - - Page_Error : exception; - - - - - package Forge is - - function Create - return Paged_Surface; - - end Forge; - - - - - procedure Start_Job - (This : in out Paged_Surface; - Count : in Natural); - - procedure Start_Job - (This : in out Paged_Surface; - Count : in Natural; - From, To : in Positive); - - procedure End_Job - (This : in out Paged_Surface); - - procedure Start_Page - (This : in out Paged_Surface); - - procedure End_Page - (This : in out Paged_Surface); - - - - - procedure Get_Margins - (This : in Paged_Surface; - Left, Top, Right, Bottom : out Integer); - - procedure Get_Printable_Rect - (This : in Paged_Surface; - W, H : out Integer); - - procedure Get_Origin - (This : in Paged_Surface; - X, Y : out Integer); - - procedure Set_Origin - (This : in out Paged_Surface; - X, Y : in Integer); - - procedure Rotate - (This : in out Paged_Surface; - Degrees : in Float); - - procedure Scale - (This : in out Paged_Surface; - Factor : in Float); - - procedure Scale - (This : in out Paged_Surface; - Factor_X, Factor_Y : in Float); - - procedure Translate - (This : in out Paged_Surface; - Delta_X, Delta_Y : in Integer); - - procedure Untranslate - (This : in out Paged_Surface); - - - - - procedure Print_Widget - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Print_Window - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Print_Window_Part - (This : in out Paged_Surface; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - X, Y, W, H : in Integer; - Offset_X, Offset_Y : in Integer := 0); - - -private - - - type Paged_Surface is new Surface_Device with null record; - - overriding procedure Finalize - (This : in out Paged_Surface); - - - - - pragma Inline (Start_Job); - pragma Inline (End_Job); - pragma Inline (Start_Page); - pragma Inline (End_Page); - - - pragma Inline (Get_Margins); - pragma Inline (Get_Printable_Rect); - pragma Inline (Get_Origin); - pragma Inline (Set_Origin); - pragma Inline (Rotate); - pragma Inline (Scale); - pragma Inline (Translate); - pragma Inline (Untranslate); - - - pragma Inline (Print_Widget); - pragma Inline (Print_Window); - pragma Inline (Print_Window_Part); - - -end FLTK.Devices.Surfaces.Paged; - diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb deleted file mode 100644 index 400bd87..0000000 --- a/src/fltk-devices-surfaces.adb +++ /dev/null @@ -1,100 +0,0 @@ - - -with - - System; - -use type - - System.Address; - - -package body FLTK.Devices.Surfaces is - - - function new_fl_surface - (G : in System.Address) - return System.Address; - pragma Import (C, new_fl_surface, "new_fl_surface"); - pragma Inline (new_fl_surface); - - procedure free_fl_surface - (S : in System.Address); - pragma Import (C, free_fl_surface, "free_fl_surface"); - pragma Inline (free_fl_surface); - - - - - procedure fl_surface_set_current - (S : in System.Address); - pragma Import (C, fl_surface_set_current, "fl_surface_set_current"); - pragma Inline (fl_surface_set_current); - - function fl_surface_get_surface - return System.Address; - pragma Import (C, fl_surface_get_surface, "fl_surface_get_surface"); - pragma Inline (fl_surface_get_surface); - - - - - procedure Finalize - (This : in out Surface_Device) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Surface_Device'Class - then - if This.Needs_Dealloc then - free_fl_surface (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Device (This)); - end Finalize; - - - - - package body Forge is - - function Create - (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) - return Surface_Device is - begin - return This : Surface_Device do - This.Void_Ptr := new_fl_surface (Wrapper (Graphics).Void_Ptr); - end return; - end Create; - - end Forge; - - - - - function Get_Current - return access Surface_Device'Class is - begin - return Current_Ptr; - end Get_Current; - - - procedure Set_Current - (This : in out Surface_Device) is - begin - fl_surface_set_current (This.Void_Ptr); - Current_Ptr := This'Unchecked_Access; - end Set_Current; - - - - -begin - - - Original_Surface.Void_Ptr := fl_surface_get_surface; - Original_Surface.Needs_Dealloc := False; - - -end FLTK.Devices.Surfaces; - diff --git a/src/fltk-devices-surfaces.ads b/src/fltk-devices-surfaces.ads deleted file mode 100644 index 2d3678f..0000000 --- a/src/fltk-devices-surfaces.ads +++ /dev/null @@ -1,64 +0,0 @@ - - -with - - FLTK.Devices.Graphics; - - -package FLTK.Devices.Surfaces is - - - pragma Elaborate_Body (FLTK.Devices.Surfaces); - - - - - type Surface_Device is new Device with private; - - type Surface_Device_Reference (Data : not null access Surface_Device'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) - return Surface_Device; - - end Forge; - - - - - function Get_Current - return access Surface_Device'Class; - - procedure Set_Current - (This : in out Surface_Device); - - -private - - - type Surface_Device is new Device with null record; - - overriding procedure Finalize - (This : in out Surface_Device); - - - - - Original_Surface : aliased Surface_Device; - Current_Ptr : access Surface_Device'Class := Original_Surface'Access; - - - - - pragma Inline (Get_Current); - pragma Inline (Set_Current); - - -end FLTK.Devices.Surfaces; - diff --git a/src/fltk-devices.ads b/src/fltk-devices.ads deleted file mode 100644 index fcf9848..0000000 --- a/src/fltk-devices.ads +++ /dev/null @@ -1,16 +0,0 @@ - - -package FLTK.Devices is - - - type Device is new Wrapper with private; - - -private - - - type Device is new Wrapper with null record; - - -end FLTK.Devices; - diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb deleted file mode 100644 index 349fd1f..0000000 --- a/src/fltk-dialogs.adb +++ /dev/null @@ -1,342 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Dialogs is - - - procedure dialog_fl_alert - (M : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_alert, "dialog_fl_alert"); - pragma Inline (dialog_fl_alert); - - -- function dialog_fl_ask - -- (M : in Interfaces.C.char_array) - -- return Interfaces.C.int; - -- pragma Import (C, dialog_fl_ask, "dialog_fl_ask"); - -- pragma Inline (dialog_fl_ask); - - procedure dialog_fl_beep - (B : in Interfaces.C.int); - pragma Import (C, dialog_fl_beep, "dialog_fl_beep"); - pragma Inline (dialog_fl_beep); - - function dialog_fl_choice - (M, A, B, C : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, dialog_fl_choice, "dialog_fl_choice"); - pragma Inline (dialog_fl_choice); - - function dialog_fl_input - (M, D : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, dialog_fl_input, "dialog_fl_input"); - pragma Inline (dialog_fl_input); - - procedure dialog_fl_message - (M : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_message, "dialog_fl_message"); - pragma Inline (dialog_fl_message); - - function dialog_fl_password - (M, D : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, dialog_fl_password, "dialog_fl_password"); - pragma Inline (dialog_fl_password); - - - - - function dialog_fl_color_chooser - (N : in Interfaces.C.char_array; - R, G, B : in out Interfaces.C.double; - M : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, dialog_fl_color_chooser, "dialog_fl_color_chooser"); - pragma Inline (dialog_fl_color_chooser); - - function dialog_fl_color_chooser2 - (N : in Interfaces.C.char_array; - R, G, B : in out Interfaces.C.unsigned_char; - M : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, dialog_fl_color_chooser2, "dialog_fl_color_chooser2"); - pragma Inline (dialog_fl_color_chooser2); - - function dialog_fl_dir_chooser - (M, D : in Interfaces.C.char_array; - R : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, dialog_fl_dir_chooser, "dialog_fl_dir_chooser"); - pragma Inline (dialog_fl_dir_chooser); - - function dialog_fl_file_chooser - (M, P, D : in Interfaces.C.char_array; - R : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, dialog_fl_file_chooser, "dialog_fl_file_chooser"); - pragma Inline (dialog_fl_file_chooser); - - - - - function dialog_fl_get_message_hotspot - return Interfaces.C.int; - pragma Import (C, dialog_fl_get_message_hotspot, "dialog_fl_get_message_hotspot"); - pragma Inline (dialog_fl_get_message_hotspot); - - procedure dialog_fl_set_message_hotspot - (V : in Interfaces.C.int); - pragma Import (C, dialog_fl_set_message_hotspot, "dialog_fl_set_message_hotspot"); - pragma Inline (dialog_fl_set_message_hotspot); - - procedure dialog_fl_message_font - (F, S : in Interfaces.C.int); - pragma Import (C, dialog_fl_message_font, "dialog_fl_message_font"); - pragma Inline (dialog_fl_message_font); - - function dialog_fl_message_icon - return System.Address; - pragma Import (C, dialog_fl_message_icon, "dialog_fl_message_icon"); - pragma Inline (dialog_fl_message_icon); - - procedure dialog_fl_message_title - (T : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_message_title, "dialog_fl_message_title"); - pragma Inline (dialog_fl_message_title); - - procedure dialog_fl_message_title_default - (T : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_message_title_default, "dialog_fl_message_title_default"); - pragma Inline (dialog_fl_message_title_default); - - - - - procedure Alert - (Message : String) is - begin - dialog_fl_alert (Interfaces.C.To_C (Message)); - end Alert; - - - -- function Ask - -- (Message : in String) - -- return Boolean is - -- begin - -- return dialog_fl_ask (Interfaces.C.To_C (Message)) /= 0; - -- end Ask; - - - procedure Beep - (Kind : in Beep_Kind) is - begin - dialog_fl_beep (Beep_Kind'Pos (Kind)); - end Beep; - - - function Three_Way_Choice - (Message, Button1, Button2, Button3 : in String) - return Choice - is - Result : Interfaces.C.int := dialog_fl_choice - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.To_C (Button2), - Interfaces.C.To_C (Button3)); - begin - return Choice'Val (Result); - end Three_Way_Choice; - - - function Text_Input - (Message : in String; - Default : in String := "") - return String - is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default)); - begin - -- string does not need dealloc - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Text_Input; - - - procedure Message_Box - (Message : in String) is - begin - dialog_fl_message (Interfaces.C.To_C (Message)); - end Message_Box; - - - function Password - (Message : in String; - Default : in String := "") - return String - is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_password - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default)); - begin - -- string does not need dealloc - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Password; - - - - - function Color_Chooser - (Title : in String; - R, G, B : in out RGB_Float; - Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode := - FLTK.Widgets.Groups.Color_Choosers.RGB) - return Boolean - is - C_R : Interfaces.C.double := Interfaces.C.double (R); - C_G : Interfaces.C.double := Interfaces.C.double (G); - C_B : Interfaces.C.double := Interfaces.C.double (B); - M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); - Result : Boolean := dialog_fl_color_chooser - (Interfaces.C.To_C (Title), C_R, C_G, C_B, M) /= 0; - begin - R := RGB_Float (C_R); - G := RGB_Float (C_G); - B := RGB_Float (C_B); - return Result; - end Color_Chooser; - - - function Color_Chooser - (Title : in String; - R, G, B : in out RGB_Int; - Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode := - FLTK.Widgets.Groups.Color_Choosers.RGB) - return Boolean - is - C_R : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (R); - C_G : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (G); - C_B : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (B); - M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); - Result : Boolean := dialog_fl_color_chooser2 - (Interfaces.C.To_C (Title), C_R, C_G, C_B, M) /= 0; - begin - R := RGB_Int (C_R); - G := RGB_Int (C_G); - B := RGB_Int (C_B); - return Result; - end Color_Chooser; - - - function Dir_Chooser - (Message, Default : in String; - Relative : in Boolean := False) - return String - is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_dir_chooser - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default), - Boolean'Pos (Relative)); - begin - -- I'm... fairly sure the string does not need dealloc? - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Dir_Chooser; - - - function File_Chooser - (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) - return String - is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_file_chooser - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Filter_Pattern), - Interfaces.C.To_C (Default), - Boolean'Pos (Relative)); - begin - -- I'm... fairly sure the string does not need dealloc? - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end File_Chooser; - - - - - function Get_Hotspot - return Boolean is - begin - return dialog_fl_get_message_hotspot /= 0; - end Get_Hotspot; - - - procedure Set_Hotspot - (To : in Boolean) is - begin - dialog_fl_set_message_hotspot (Boolean'Pos (To)); - end Set_Hotspot; - - - procedure Set_Message_Font - (Font : in Font_Kind; - Size : in Font_Size) is - begin - dialog_fl_message_font (Font_Kind'Pos (Font), Interfaces.C.int (Size)); - end Set_Message_Font; - - - function Get_Message_Icon - return FLTK.Widgets.Boxes.Box_Reference is - begin - return (Data => Icon_Box'Access); - end Get_Message_Icon; - - - procedure Set_Message_Title - (To : in String) is - begin - dialog_fl_message_title (Interfaces.C.To_C (To)); - end Set_Message_Title; - - - procedure Set_Message_Title_Default - (To : in String) is - begin - dialog_fl_message_title_default (Interfaces.C.To_C (To)); - end Set_Message_Title_Default; - - - - -begin - - - Wrapper (Icon_Box).Void_Ptr := dialog_fl_message_icon; - Wrapper (Icon_Box).Needs_Dealloc := False; - - -end FLTK.Dialogs; - diff --git a/src/fltk-dialogs.ads b/src/fltk-dialogs.ads deleted file mode 100644 index 96a6bcf..0000000 --- a/src/fltk-dialogs.ads +++ /dev/null @@ -1,133 +0,0 @@ - - -with - - FLTK.Widgets.Boxes, - FLTK.Widgets.Groups.Color_Choosers; - - -package FLTK.Dialogs is - - - type Beep_Kind is - (Default_Beep, Message_Beep, Error_Beep, - Question_Beep, Password_Beep, Notification_Beep); - - type Choice is (First, Second, Third); - - type RGB_Float is new Long_Float range 0.0 .. 1.0; - - type RGB_Int is mod 256; - - - - - procedure Alert - (Message : String); - - -- function Ask - -- (Message : in String) - -- return Boolean; - - procedure Beep - (Kind : in Beep_Kind); - - function Three_Way_Choice - (Message, Button1, Button2, Button3 : in String) - return Choice; - - function Text_Input - (Message : in String; - Default : in String := "") - return String; - - procedure Message_Box - (Message : in String); - - function Password - (Message : in String; - Default : in String := "") - return String; - - - - - function Color_Chooser - (Title : in String; - R, G, B : in out RGB_Float; - Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode := - FLTK.Widgets.Groups.Color_Choosers.RGB) - return Boolean; - - function Color_Chooser - (Title : in String; - R, G, B : in out RGB_Int; - Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode := - FLTK.Widgets.Groups.Color_Choosers.RGB) - return Boolean; - - function Dir_Chooser - (Message, Default : in String; - Relative : in Boolean := False) - return String; - - function File_Chooser - (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) - return String; - - - - - function Get_Hotspot - return Boolean; - - procedure Set_Hotspot - (To : in Boolean); - - procedure Set_Message_Font - (Font : in Font_Kind; - Size : in Font_Size); - - function Get_Message_Icon - return FLTK.Widgets.Boxes.Box_Reference; - - procedure Set_Message_Title - (To : in String); - - procedure Set_Message_Title_Default - (To : in String); - - -private - - - Icon_Box : aliased FLTK.Widgets.Boxes.Box; - - - - - pragma Inline (Alert); - -- pragma Inline (Ask); - pragma Inline (Beep); - pragma Inline (Three_Way_Choice); - pragma Inline (Text_Input); - pragma Inline (Message_Box); - pragma Inline (Password); - - - pragma Inline (Color_Chooser); - pragma Inline (Dir_Chooser); - pragma Inline (File_Chooser); - - - pragma Inline (Get_Hotspot); - pragma Inline (Set_Hotspot); - pragma Inline (Set_Message_Font); - pragma Inline (Get_Message_Icon); - pragma Inline (Set_Message_Title); - pragma Inline (Set_Message_Title_Default); - - -end FLTK.Dialogs; - diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb deleted file mode 100644 index 4c17674..0000000 --- a/src/fltk-draw.adb +++ /dev/null @@ -1,1877 +0,0 @@ - - -with - - Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.size_t, - System.Address; - - -package body FLTK.Draw is - - - procedure fl_draw_reset_spot; - pragma Import (C, fl_draw_reset_spot, "fl_draw_reset_spot"); - pragma Inline (fl_draw_reset_spot); - - procedure fl_draw_set_spot - (F, S : in Interfaces.C.int; - X, Y, W, H : in Interfaces.C.int; - Ptr : in System.Address); - pragma Import (C, fl_draw_set_spot, "fl_draw_set_spot"); - pragma Inline (fl_draw_set_spot); - - procedure fl_draw_set_status - (X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_set_status, "fl_draw_set_status"); - pragma Inline (fl_draw_set_status); - - - - - function fl_draw_can_do_alpha_blending - return Interfaces.C.int; - pragma Import (C, fl_draw_can_do_alpha_blending, "fl_draw_can_do_alpha_blending"); - pragma Inline (fl_draw_can_do_alpha_blending); - - function fl_draw_shortcut_label - (Shortcut : in Interfaces.C.unsigned_long) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_draw_shortcut_label, "fl_draw_shortcut_label"); - pragma Inline (fl_draw_shortcut_label); - - - - - function fl_draw_latin1_to_local - (T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_draw_latin1_to_local, "fl_draw_latin1_to_local"); - pragma Inline (fl_draw_latin1_to_local); - - function fl_draw_local_to_latin1 - (T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_draw_local_to_latin1, "fl_draw_local_to_latin1"); - pragma Inline (fl_draw_local_to_latin1); - - function fl_draw_mac_roman_to_local - (T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_draw_mac_roman_to_local, "fl_draw_mac_roman_to_local"); - pragma Inline (fl_draw_mac_roman_to_local); - - function fl_draw_local_to_mac_roman - (T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_draw_local_to_mac_roman, "fl_draw_local_to_mac_roman"); - pragma Inline (fl_draw_local_to_mac_roman); - - - - - function fl_draw_clip_box - (X, Y, W, H : in Interfaces.C.int; - BX, BY, BW, BH : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_draw_clip_box, "fl_draw_clip_box"); - pragma Inline (fl_draw_clip_box); - - function fl_draw_not_clipped - (X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_draw_not_clipped, "fl_draw_not_clipped"); - pragma Inline (fl_draw_not_clipped); - - procedure fl_draw_pop_clip; - pragma Import (C, fl_draw_pop_clip, "fl_draw_pop_clip"); - pragma Inline (fl_draw_pop_clip); - - procedure fl_draw_push_clip - (X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_push_clip, "fl_draw_push_clip"); - pragma Inline (fl_draw_push_clip); - - procedure fl_draw_push_no_clip; - pragma Import (C, fl_draw_push_no_clip, "fl_draw_push_no_clip"); - pragma Inline (fl_draw_push_no_clip); - - procedure fl_draw_restore_clip; - pragma Import (C, fl_draw_restore_clip, "fl_draw_restore_clip"); - pragma Inline (fl_draw_restore_clip); - - - - - procedure fl_draw_overlay_clear; - pragma Import (C, fl_draw_overlay_clear, "fl_draw_overlay_clear"); - pragma Inline (fl_draw_overlay_clear); - - procedure fl_draw_overlay_rect - (X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_overlay_rect, "fl_draw_overlay_rect"); - pragma Inline (fl_draw_overlay_rect); - - - - - function fl_draw_get_color - return Interfaces.C.unsigned; - pragma Import (C, fl_draw_get_color, "fl_draw_get_color"); - pragma Inline (fl_draw_get_color); - - procedure fl_draw_set_color - (C : in Interfaces.C.unsigned); - pragma Import (C, fl_draw_set_color, "fl_draw_set_color"); - pragma Inline (fl_draw_set_color); - - procedure fl_draw_set_color2 - (R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_draw_set_color2, "fl_draw_set_color2"); - pragma Inline (fl_draw_set_color2); - - procedure fl_draw_set_cursor - (M : in Interfaces.C.int); - pragma Import (C, fl_draw_set_cursor, "fl_draw_set_cursor"); - pragma Inline (fl_draw_set_cursor); - - procedure fl_draw_set_cursor2 - (M : in Interfaces.C.int; - F, B : in Interfaces.C.unsigned); - pragma Import (C, fl_draw_set_cursor2, "fl_draw_set_cursor2"); - pragma Inline (fl_draw_set_cursor2); - - function fl_draw_get_font - return Interfaces.C.unsigned; - pragma Import (C, fl_draw_get_font, "fl_draw_get_font"); - pragma Inline (fl_draw_get_font); - - function fl_draw_size - return Interfaces.C.int; - pragma Import (C, fl_draw_size, "fl_draw_size"); - pragma Inline (fl_draw_size); - - procedure fl_draw_set_font - (F : in Interfaces.C.unsigned; - S : in Interfaces.C.int); - pragma Import (C, fl_draw_set_font, "fl_draw_set_font"); - pragma Inline (fl_draw_set_font); - - function fl_draw_height - return Interfaces.C.int; - pragma Import (C, fl_draw_height, "fl_draw_height"); - pragma Inline (fl_draw_height); - - function fl_draw_descent - return Interfaces.C.int; - pragma Import (C, fl_draw_descent, "fl_draw_descent"); - pragma Inline (fl_draw_descent); - - function fl_draw_height2 - (F : in Interfaces.C.unsigned; - S : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_draw_height2, "fl_draw_height2"); - pragma Inline (fl_draw_height2); - - procedure fl_draw_line_style - (Style : in Interfaces.C.int; - Width : in Interfaces.C.int; - Dashes : in Interfaces.C.char_array); - pragma Import (C, fl_draw_line_style, "fl_draw_line_style"); - pragma Inline (fl_draw_line_style); - - - - - procedure fl_draw_mult_matrix - (A, B, C, D, X, Y : in Interfaces.C.double); - pragma Import (C, fl_draw_mult_matrix, "fl_draw_mult_matrix"); - pragma Inline (fl_draw_mult_matrix); - - procedure fl_draw_pop_matrix; - pragma Import (C, fl_draw_pop_matrix, "fl_draw_pop_matrix"); - pragma Inline (fl_draw_pop_matrix); - - procedure fl_draw_push_matrix; - pragma Import (C, fl_draw_push_matrix, "fl_draw_push_matrix"); - pragma Inline (fl_draw_push_matrix); - - procedure fl_draw_rotate - (D : in Interfaces.C.double); - pragma Import (C, fl_draw_rotate, "fl_draw_rotate"); - pragma Inline (fl_draw_rotate); - - procedure fl_draw_scale - (X : in Interfaces.C.double); - pragma Import (C, fl_draw_scale, "fl_draw_scale"); - pragma Inline (fl_draw_scale); - - procedure fl_draw_scale2 - (X, Y : in Interfaces.C.double); - pragma Import (C, fl_draw_scale2, "fl_draw_scale2"); - pragma Inline (fl_draw_scale2); - - function fl_draw_transform_dx - (X, Y : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_draw_transform_dx, "fl_draw_transform_dx"); - pragma Inline (fl_draw_transform_dx); - - function fl_draw_transform_dy - (X, Y : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_draw_transform_dy, "fl_draw_transform_dy"); - pragma Inline (fl_draw_transform_dy); - - function fl_draw_transform_x - (X, Y : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_draw_transform_x, "fl_draw_transform_x"); - pragma Inline (fl_draw_transform_x); - - function fl_draw_transform_y - (X, Y : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_draw_transform_y, "fl_draw_transform_y"); - pragma Inline (fl_draw_transform_y); - - procedure fl_draw_transformed_vertex - (XF, YF : in Interfaces.C.double); - pragma Import (C, fl_draw_transformed_vertex, "fl_draw_transformed_vertex"); - pragma Inline (fl_draw_transformed_vertex); - - procedure fl_draw_translate - (X, Y : in Interfaces.C.double); - pragma Import (C, fl_draw_translate, "fl_draw_translate"); - pragma Inline (fl_draw_translate); - - procedure fl_draw_vertex - (X, Y : in Interfaces.C.double); - pragma Import (C, fl_draw_vertex, "fl_draw_vertex"); - pragma Inline (fl_draw_vertex); - - - - - procedure fl_draw_draw_image - (Buf : in System.Address; - X, Y, W, H : in Interfaces.C.int; - D, L : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_image, "fl_draw_draw_image"); - pragma Inline (fl_draw_draw_image); - - procedure fl_draw_draw_image2 - (Call, User : in System.Address; - X, Y, W, H, D : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_image2, "fl_draw_draw_image2"); - pragma Inline (fl_draw_draw_image2); - - procedure fl_draw_draw_image_mono - (Buf : in System.Address; - X, Y, W, H : in Interfaces.C.int; - D, L : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_image_mono, "fl_draw_draw_image_mono"); - pragma Inline (fl_draw_draw_image_mono); - - procedure fl_draw_draw_image_mono2 - (Call, User : in System.Address; - X, Y, W, H, D : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_image_mono2, "fl_draw_draw_image_mono2"); - pragma Inline (fl_draw_draw_image_mono2); - - function fl_draw_read_image - (Buf : in System.Address; - X, Y, W, H : in Interfaces.C.int; - Alpha : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_draw_read_image, "fl_draw_read_image"); - pragma Inline (fl_draw_read_image); - - - - - function fl_draw_add_symbol - (Name : in Interfaces.C.char_array; - Drawit : in System.Address; - Scalable : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_draw_add_symbol, "fl_draw_add_symbol"); - pragma Inline (fl_draw_add_symbol); - - procedure fl_draw_draw_text - (Str : in Interfaces.C.char_array; - N, X, Y : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_text, "fl_draw_draw_text"); - pragma Inline (fl_draw_draw_text); - - procedure fl_draw_draw_text2 - (Str : in Interfaces.C.char_array; - X, Y, W, H : in Interfaces.C.int; - Ali : in Interfaces.Unsigned_16; - Img : in System.Address; - Sym : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_text2, "fl_draw_draw_text2"); - pragma Inline (fl_draw_draw_text2); - - procedure fl_draw_draw_text3 - (Str : in Interfaces.C.char_array; - X, Y, W, H : in Interfaces.C.int; - Ali : in Interfaces.Unsigned_16; - Func : in System.Address; - Img : in System.Address; - Sym : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_text3, "fl_draw_draw_text3"); - pragma Inline (fl_draw_draw_text3); - - procedure fl_draw_draw_text4 - (Ang : in Interfaces.C.int; - Str : in Interfaces.C.char_array; - N, X, Y : in Interfaces.C.int); - pragma Import (C, fl_draw_draw_text4, "fl_draw_draw_text4"); - pragma Inline (fl_draw_draw_text4); - - procedure fl_draw_rtl_draw - (Str : in Interfaces.C.char_array; - N, X, Y : in Interfaces.C.int); - pragma Import (C, fl_draw_rtl_draw, "fl_draw_rtl_draw"); - pragma Inline (fl_draw_rtl_draw); - - procedure fl_draw_draw_box - (BK : in Interfaces.C.int; - X, Y, W, H : in Interfaces.C.int; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_draw_draw_box, "fl_draw_draw_box"); - pragma Inline (fl_draw_draw_box); - - function fl_draw_draw_symbol - (Lab : in Interfaces.C.char_array; - X, Y, W, H : in Interfaces.C.int; - Hue : in Interfaces.C.unsigned) - return Interfaces.C.int; - pragma Import (C, fl_draw_draw_symbol, "fl_draw_draw_symbol"); - pragma Inline (fl_draw_draw_symbol); - - procedure fl_draw_measure - (Str : in Interfaces.C.char_array; - W, H : in out Interfaces.C.int; - S : in Interfaces.C.int); - pragma Import (C, fl_draw_measure, "fl_draw_measure"); - pragma Inline (fl_draw_measure); - - procedure fl_draw_scroll - (X, Y, W, H : in Interfaces.C.int; - DX, DY : in Interfaces.C.int; - Func, Data : in System.Address); - pragma Import (C, fl_draw_scroll, "fl_draw_scroll"); - pragma Inline (fl_draw_scroll); - - procedure fl_draw_text_extents - (Str : in Interfaces.C.char_array; - N : in Interfaces.C.int; - DX, DY, W, H : out Interfaces.C.int); - pragma Import (C, fl_draw_text_extents, "fl_draw_text_extents"); - pragma Inline (fl_draw_text_extents); - - function fl_draw_width - (Str : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Interfaces.C.double; - pragma Import (C, fl_draw_width, "fl_draw_width"); - pragma Inline (fl_draw_width); - - function fl_draw_width2 - (C : in Interfaces.C.unsigned_long) - return Interfaces.C.double; - pragma Import (C, fl_draw_width2, "fl_draw_width2"); - pragma Inline (fl_draw_width2); - - - - - procedure fl_draw_begin_complex_polygon; - pragma Import (C, fl_draw_begin_complex_polygon, "fl_draw_begin_complex_polygon"); - pragma Inline (fl_draw_begin_complex_polygon); - - procedure fl_draw_begin_line; - pragma Import (C, fl_draw_begin_line, "fl_draw_begin_line"); - pragma Inline (fl_draw_begin_line); - - procedure fl_draw_begin_loop; - pragma Import (C, fl_draw_begin_loop, "fl_draw_begin_loop"); - pragma Inline (fl_draw_begin_loop); - - procedure fl_draw_begin_points; - pragma Import (C, fl_draw_begin_points, "fl_draw_begin_points"); - pragma Inline (fl_draw_begin_points); - - procedure fl_draw_begin_polygon; - pragma Import (C, fl_draw_begin_polygon, "fl_draw_begin_polygon"); - pragma Inline (fl_draw_begin_polygon); - - - - - procedure fl_draw_arc - (X, Y, R, Start, Finish : in Interfaces.C.double); - pragma Import (C, fl_draw_arc, "fl_draw_arc"); - pragma Inline (fl_draw_arc); - - procedure fl_draw_arc2 - (X, Y, W, H : in Interfaces.C.int; - A1, A2 : in Interfaces.C.double); - pragma Import (C, fl_draw_arc2, "fl_draw_arc2"); - pragma Inline (fl_draw_arc2); - - procedure fl_draw_chord - (X, Y, W, H : in Interfaces.C.int; - A1, A2 : in Interfaces.C.double); - pragma Import (C, fl_draw_chord, "fl_draw_chord"); - pragma Inline (fl_draw_chord); - - procedure fl_draw_circle - (X, Y, R : in Interfaces.C.double); - pragma Import (C, fl_draw_circle, "fl_draw_circle"); - pragma Inline (fl_draw_circle); - - procedure fl_draw_curve - (X0, Y0 : in Interfaces.C.double; - X1, Y1 : in Interfaces.C.double; - X2, Y2 : in Interfaces.C.double; - X3, Y3 : in Interfaces.C.double); - pragma Import (C, fl_draw_curve, "fl_draw_curve"); - pragma Inline (fl_draw_curve); - - procedure fl_draw_frame - (S : in Interfaces.C.char_array; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_frame, "fl_draw_frame"); - pragma Inline (fl_draw_frame); - - procedure fl_draw_gap; - pragma Import (C, fl_draw_gap, "fl_draw_gap"); - pragma Inline (fl_draw_gap); - - procedure fl_draw_line - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int); - pragma Import (C, fl_draw_line, "fl_draw_line"); - pragma Inline (fl_draw_line); - - procedure fl_draw_line2 - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int; - X2, Y2 : in Interfaces.C.int); - pragma Import (C, fl_draw_line2, "fl_draw_line2"); - pragma Inline (fl_draw_line2); - - procedure fl_draw_loop - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int; - X2, Y2 : in Interfaces.C.int); - pragma Import (C, fl_draw_loop, "fl_draw_loop"); - pragma Inline (fl_draw_loop); - - procedure fl_draw_loop2 - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int; - X2, Y2 : in Interfaces.C.int; - X3, Y3 : in Interfaces.C.int); - pragma Import (C, fl_draw_loop2, "fl_draw_loop2"); - pragma Inline (fl_draw_loop2); - - procedure fl_draw_pie - (X, Y, W, H : in Interfaces.C.int; - A1, A2 : in Interfaces.C.double); - pragma Import (C, fl_draw_pie, "fl_draw_pie"); - pragma Inline (fl_draw_pie); - - procedure fl_draw_point - (X, Y : in Interfaces.C.int); - pragma Import (C, fl_draw_point, "fl_draw_point"); - pragma Inline (fl_draw_point); - - procedure fl_draw_polygon - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int; - X2, Y2 : in Interfaces.C.int); - pragma Import (C, fl_draw_polygon, "fl_draw_polygon"); - pragma Inline (fl_draw_polygon); - - procedure fl_draw_polygon2 - (X0, Y0 : in Interfaces.C.int; - X1, Y1 : in Interfaces.C.int; - X2, Y2 : in Interfaces.C.int; - X3, Y3 : in Interfaces.C.int); - pragma Import (C, fl_draw_polygon2, "fl_draw_polygon2"); - pragma Inline (fl_draw_polygon2); - - procedure fl_draw_rect - (X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_rect, "fl_draw_rect"); - pragma Inline (fl_draw_rect); - - procedure fl_draw_rect2 - (X, Y, W, H : in Interfaces.C.int; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_draw_rect2, "fl_draw_rect2"); - pragma Inline (fl_draw_rect2); - - procedure fl_draw_rect_fill - (X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_draw_rect_fill, "fl_draw_rect_fill"); - pragma Inline (fl_draw_rect_fill); - - procedure fl_draw_rect_fill2 - (X, Y, W, H : in Interfaces.C.int; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_draw_rect_fill2, "fl_draw_rect_fill2"); - pragma Inline (fl_draw_rect_fill2); - - procedure fl_draw_rect_fill3 - (X, Y, W, H : in Interfaces.C.int; - R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_draw_rect_fill3, "fl_draw_rect_fill3"); - pragma Inline (fl_draw_rect_fill3); - - procedure fl_draw_xy_line - (X0, Y0, X1 : in Interfaces.C.int); - pragma Import (C, fl_draw_xy_line, "fl_draw_xy_line"); - pragma Inline (fl_draw_xy_line); - - procedure fl_draw_xy_line2 - (X0, Y0, X1, Y2 : in Interfaces.C.int); - pragma Import (C, fl_draw_xy_line2, "fl_draw_xy_line2"); - pragma Inline (fl_draw_xy_line2); - - procedure fl_draw_xy_line3 - (X0, Y0, X1, Y2, X3 : in Interfaces.C.int); - pragma Import (C, fl_draw_xy_line3, "fl_draw_xy_line3"); - pragma Inline (fl_draw_xy_line3); - - procedure fl_draw_yx_line - (X0, Y0, Y1 : in Interfaces.C.int); - pragma Import (C, fl_draw_yx_line, "fl_draw_yx_line"); - pragma Inline (fl_draw_yx_line); - - procedure fl_draw_yx_line2 - (X0, Y0, Y1, X2 : in Interfaces.C.int); - pragma Import (C, fl_draw_yx_line2, "fl_draw_yx_line2"); - pragma Inline (fl_draw_yx_line2); - - procedure fl_draw_yx_line3 - (X0, Y0, Y1, X2, Y3 : in Interfaces.C.int); - pragma Import (C, fl_draw_yx_line3, "fl_draw_yx_line3"); - pragma Inline (fl_draw_yx_line3); - - - - - procedure fl_draw_end_complex_polygon; - pragma Import (C, fl_draw_end_complex_polygon, "fl_draw_end_complex_polygon"); - pragma Inline (fl_draw_end_complex_polygon); - - procedure fl_draw_end_line; - pragma Import (C, fl_draw_end_line, "fl_draw_end_line"); - pragma Inline (fl_draw_end_line); - - procedure fl_draw_end_loop; - pragma Import (C, fl_draw_end_loop, "fl_draw_end_loop"); - pragma Inline (fl_draw_end_loop); - - procedure fl_draw_end_points; - pragma Import (C, fl_draw_end_points, "fl_draw_end_points"); - pragma Inline (fl_draw_end_points); - - procedure fl_draw_end_polygon; - pragma Import (C, fl_draw_end_polygon, "fl_draw_end_polygon"); - pragma Inline (fl_draw_end_polygon); - - - - - ------------------------ - -- No Documentation -- - ------------------------ - - procedure Reset_Spot is - begin - fl_draw_reset_spot; - end Reset_Spot; - - - procedure Set_Spot - (X, Y, W, H : in Integer; - Font : in Font_Kind; - Size : in Font_Size) is - begin - fl_draw_set_spot - (Font_Kind'Pos (Font), - Interfaces.C.int (Size), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - System.Null_Address); - end Set_Spot; - - - procedure Set_Spot - (X, Y, W, H : in Integer; - Font : in Font_Kind; - Size : in Font_Size; - Pane : in FLTK.Widgets.Groups.Windows.Window'Class) is - begin - fl_draw_set_spot - (Font_Kind'Pos (Font), - Interfaces.C.int (Size), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Wrapper (Pane).Void_Ptr); - end Set_Spot; - - - procedure Set_Status - (X, Y, W, H : in Integer) is - begin - fl_draw_set_status - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Set_Status; - - - - - --------------- - -- Utility -- - --------------- - - function Can_Do_Alpha_Blending - return Boolean - is - Result : Interfaces.C.int := fl_draw_can_do_alpha_blending; - begin - if Result = 1 then - return True; - elsif Result = 0 then - return False; - else - raise Program_Error; - end if; - end Can_Do_Alpha_Blending; - - - function Shortcut_Label - (Keys : in Key_Combo) - return String is - begin - return Interfaces.C.Strings.Value - (fl_draw_shortcut_label (To_C (Keys))); - end Shortcut_Label; - - - - - -------------------------- - -- Charset Conversion -- - -------------------------- - - function Latin1_To_Local - (From : in String) - return String is - begin - return Interfaces.C.Strings.Value - (fl_draw_latin1_to_local (Interfaces.C.To_C (From), -1)); - end Latin1_To_Local; - - - function Local_To_Latin1 - (From : in String) - return String is - begin - return Interfaces.C.Strings.Value - (fl_draw_local_to_latin1 (Interfaces.C.To_C (From), -1)); - end Local_To_Latin1; - - - function Mac_Roman_To_Local - (From : in String) - return String is - begin - return Interfaces.C.Strings.Value - (fl_draw_mac_roman_to_local (Interfaces.C.To_C (From), -1)); - end Mac_Roman_To_Local; - - - function Local_To_Mac_Roman - (From : in String) - return String is - begin - return Interfaces.C.Strings.Value - (fl_draw_local_to_mac_roman (Interfaces.C.To_C (From), -1)); - end Local_To_Mac_Roman; - - - - - ---------------- - -- Clipping -- - ---------------- - - function Clip_Box - (X, Y, W, H : in Integer; - BX, BY, BW, BH : out Integer) - return Boolean - is - CX, CY, CW, CH : Interfaces.C.int; - Result : Interfaces.C.int := fl_draw_clip_box - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - CX, CY, CW, CH); - begin - BX := Integer (CX); - BY := Integer (CY); - BW := Integer (CW); - BH := Integer (CH); - return Result /= 0; - end Clip_Box; - - - function Clip_Intersects - (X, Y, W, H : in Integer) - return Boolean is - begin - return fl_draw_not_clipped - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)) /= 0; - end Clip_Intersects; - - - procedure Pop_Clip is - begin - fl_draw_pop_clip; - end Pop_Clip; - - - procedure Push_Clip - (X, Y, W, H : in Integer) is - begin - fl_draw_push_clip - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Push_Clip; - - - procedure Push_No_Clip is - begin - fl_draw_push_no_clip; - end Push_No_Clip; - - - procedure Restore_Clip is - begin - fl_draw_restore_clip; - end Restore_Clip; - - - - - --------------- - -- Overlay -- - --------------- - - procedure Overlay_Clear is - begin - fl_draw_overlay_clear; - end Overlay_Clear; - - - procedure Overlay_Rect - (X, Y, W, H : in Integer) is - begin - fl_draw_overlay_rect - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Overlay_Rect; - - - - - ---------------- - -- Settings -- - ---------------- - - function Get_Color - return Color is - begin - return Color (fl_draw_get_color); - end Get_Color; - - - procedure Set_Color - (To : in Color) is - begin - fl_draw_set_color (Interfaces.C.unsigned (To)); - end Set_Color; - - - procedure Set_Color - (R, G, B : in Color_Component) is - begin - fl_draw_set_color2 - (Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Set_Color; - - - procedure Set_Cursor - (To : in Mouse_Cursor_Kind) is - begin - fl_draw_set_cursor (Cursor_Values (To)); - end Set_Cursor; - - procedure Set_Cursor - (To : in Mouse_Cursor_Kind; - Fore : in Color; - Back : in Color := White_Color) is - begin - fl_draw_set_cursor2 - (Cursor_Values (To), - Interfaces.C.unsigned (Fore), - Interfaces.C.unsigned (Back)); - end Set_Cursor; - - - function Get_Font - return Font_Kind is - begin - return Font_Kind'Val (fl_draw_get_font); - end Get_Font; - - - function Get_Font_Size - return Font_Size is - begin - return Font_Size (fl_draw_size); - end Get_Font_Size; - - - procedure Set_Font - (Kind : in Font_Kind; - Size : in Font_Size) is - begin - fl_draw_set_font (Font_Kind'Pos (Kind), Interfaces.C.int (Size)); - end Set_Font; - - - function Font_Line_Spacing - return Integer is - begin - return Integer (fl_draw_height); - end Font_Line_Spacing; - - - function Font_Descent - return Integer is - begin - return Integer (fl_draw_descent); - end Font_Descent; - - - function Font_Height - (Kind : in Font_Kind; - Size : in Font_Size) - return Natural is - begin - return Natural (fl_draw_height2 (Font_Kind'Pos (Kind), Interfaces.C.int (Size))); - end Font_Height; - - - type Char_Array_Access is access Interfaces.C.char_array; - - procedure Free_Char_Array is new Ada.Unchecked_Deallocation - (Object => Interfaces.C.char_array, - Name => Char_Array_Access); - - Current_Dashes : Char_Array_Access; - - procedure Set_Line_Style - (Line : in Line_Kind := Solid_Line; - Cap : in Cap_Kind := Default_Cap; - Join : in Join_Kind := Default_Join; - Width : in Natural := 0; - Dashes : in Dash_Gap_Array := Empty_Dashes) is - begin - Free_Char_Array (Current_Dashes); - Current_Dashes := new Interfaces.C.char_array (1 .. (Dashes'Length + 1) * 2); - for Index in Integer range 1 .. Dashes'Length loop - Current_Dashes (2 * Interfaces.C.size_t (Index) - 1) := - Interfaces.C.char'Val (Integer (Dashes (Index).Solid)); - Current_Dashes (2 * Interfaces.C.size_t (Index)) := - Interfaces.C.char'Val (Integer (Dashes (Index).Blank)); - end loop; - Current_Dashes (Current_Dashes'Last - 1) := Interfaces.C.char'Val (0); - Current_Dashes (Current_Dashes'Last) := Interfaces.C.char'Val (0); - fl_draw_line_style - (Line_Kind'Pos (Line) + Cap_Kind'Pos (Cap) * 16#100# + Join_Kind'Pos (Join) * 16#1000#, - Interfaces.C.int (Width), - Current_Dashes.all); - end Set_Line_Style; - - - - - ------------------------- - -- Matrix Operations -- - ------------------------- - - procedure Mult_Matrix - (A, B, C, D, X, Y : in Long_Float) is - begin - fl_draw_mult_matrix - (Interfaces.C.double (A), - Interfaces.C.double (B), - Interfaces.C.double (C), - Interfaces.C.double (D), - Interfaces.C.double (X), - Interfaces.C.double (Y)); - end Mult_Matrix; - - - procedure Pop_Matrix is - begin - fl_draw_pop_matrix; - end Pop_Matrix; - - - procedure Push_Matrix is - begin - fl_draw_push_matrix; - end Push_Matrix; - - - procedure Rotate - (Angle : in Long_Float) is - begin - fl_draw_rotate (Interfaces.C.double (Angle)); - end Rotate; - - - procedure Scale - (Factor : in Long_Float) is - begin - fl_draw_scale (Interfaces.C.double (Factor)); - end Scale; - - - procedure Scale - (Factor_X, Factor_Y : in Long_Float) is - begin - fl_draw_scale2 - (Interfaces.C.double (Factor_X), - Interfaces.C.double (Factor_Y)); - end Scale; - - - function Transform_DX - (X, Y : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_draw_transform_dx - (Interfaces.C.double (X), - Interfaces.C.double (Y))); - end Transform_DX; - - - function Transform_DY - (X, Y : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_draw_transform_dy - (Interfaces.C.double (X), - Interfaces.C.double (Y))); - end Transform_DY; - - - function Transform_X - (X, Y : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_draw_transform_x - (Interfaces.C.double (X), - Interfaces.C.double (Y))); - end Transform_X; - - - function Transform_Y - (X, Y : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_draw_transform_y - (Interfaces.C.double (X), - Interfaces.C.double (Y))); - end Transform_Y; - - - procedure Transformed_Vertex - (XF, YF : in Long_Float) is - begin - fl_draw_transformed_vertex - (Interfaces.C.double (XF), - Interfaces.C.double (YF)); - end Transformed_Vertex; - - - procedure Translate - (X, Y : in Long_Float) is - begin - fl_draw_translate - (Interfaces.C.double (X), - Interfaces.C.double (Y)); - end Translate; - - - procedure Vertex - (X, Y : in Long_Float) is - begin - fl_draw_vertex - (Interfaces.C.double (X), - Interfaces.C.double (Y)); - end Vertex; - - - - - --------------------- - -- Image Drawing -- - --------------------- - - procedure Draw_Image - (X, Y, W, H : in Integer; - Data : in Color_Component_Array; - Depth : in Positive := 3; - Line_Data : in Natural := 0; - Flip_Horizontal : in Boolean := False; - Flip_Vertical : in Boolean := False) - is - Real_Depth : Integer := Depth; - Real_Line_Data : Integer := Line_Data; - begin - if Flip_Horizontal then - Real_Depth := Real_Depth * (-1); - end if; - if Flip_Vertical then - if Real_Line_Data = 0 then - Real_Line_Data := W * Depth * (-1); - else - Real_Line_Data := Real_Line_Data * (-1); - end if; - end if; - fl_draw_draw_image - (Data (Data'First)'Address, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Real_Depth), - Interfaces.C.int (Real_Line_Data)); - end Draw_Image; - - - Image_Func_Ptr : Image_Draw_Function; - - procedure Draw_Image_Hook - (User : in System.Address; - X, Y, W : in Interfaces.C.int; - Buf_Ptr : in System.Address) - is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Buf_Ptr; - pragma Import (Ada, Data_Buffer); - begin - Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer); - end Draw_Image_Hook; - - procedure Draw_Image - (X, Y, W, H : in Integer; - Callback : in Image_Draw_Function; - Depth : in Positive := 3) is - begin - Image_Func_Ptr := Callback; - fl_draw_draw_image2 - (Draw_Image_Hook'Address, - System.Null_Address, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Depth)); - end Draw_Image; - - - procedure Draw_Image_Mono - (X, Y, W, H : in Integer; - Data : in Color_Component_Array; - Depth : in Positive := 1; - Line_Data : in Natural := 0; - Flip_Horizontal : Boolean := False; - Flip_Vertical : Boolean := False) - is - Real_Depth : Integer := Depth; - Real_Line_Data : Integer := Line_Data; - begin - if Flip_Horizontal then - Real_Depth := Real_Depth * (-1); - end if; - if Flip_Vertical then - if Real_Line_Data = 0 then - Real_Line_Data := W * Depth * (-1); - else - Real_Line_Data := Real_Line_Data * (-1); - end if; - end if; - fl_draw_draw_image_mono - (Data (Data'First)'Address, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Real_Depth), - Interfaces.C.int (Real_Line_Data)); - end Draw_Image_Mono; - - - Mono_Image_Func_Ptr : Image_Draw_Function; - - procedure Draw_Image_Mono_Hook - (User : in System.Address; - X, Y, W : in Interfaces.C.int; - Buf_Ptr : in System.Address) - is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Buf_Ptr; - pragma Import (Ada, Data_Buffer); - begin - Mono_Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer); - end Draw_Image_Mono_Hook; - - procedure Draw_Image_Mono - (X, Y, W, H : in Integer; - Callback : in Image_Draw_Function; - Depth : in Positive := 1) is - begin - Mono_Image_Func_Ptr := Callback; - fl_draw_draw_image_mono2 - (Draw_Image_Mono_Hook'Address, - System.Null_Address, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Depth)); - end Draw_Image_Mono; - - - function Read_Image - (X, Y, W, H : in Integer; - Alpha : in Integer := 0) - return Color_Component_Array - is - My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4); - Result : Color_Component_Array (1 .. My_Len); - Buffer : System.Address; - begin - Buffer := fl_draw_read_image - (Result (Result'First)'Address, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Alpha)); - if Buffer /= Result (Result'First)'Address then - raise Program_Error; - end if; - return Result; - end Read_Image; - - - - - ----------------------- - -- Special Drawing -- - ----------------------- - - procedure Add_Symbol - (Text : in String; - Callback : in Symbol_Draw_Function; - Scalable : in Boolean) - is - Ret_Val : Interfaces.C.int := fl_draw_add_symbol - (Interfaces.C.To_C (Text), - Callback.all'Address, - Boolean'Pos (Scalable)); - begin - if Ret_Val = 0 then - raise Draw_Error; - elsif Ret_Val /= 1 then - raise Program_Error; - end if; - end Add_Symbol; - - procedure Draw_Text - (X, Y : in Integer; - Text : in String) is - begin - fl_draw_draw_text - (Interfaces.C.To_C (Text), - Text'Length, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw_Text; - - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Symbols : in Boolean := True) is - begin - fl_draw_draw_text2 - (Interfaces.C.To_C (Text), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.Unsigned_16 (Align), - System.Null_Address, - Boolean'Pos (Symbols)); - end Draw_Text; - - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Picture : in FLTK.Images.Image'Class; - Symbols : in Boolean := True) is - begin - fl_draw_draw_text2 - (Interfaces.C.To_C (Text), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.Unsigned_16 (Align), - Wrapper (Picture).Void_Ptr, - Boolean'Pos (Symbols)); - end Draw_Text; - - - Text_Func_Ptr : Text_Draw_Function; - - procedure Draw_Text_Hook - (Ptr : in System.Address; - N, X0, Y0 : in Interfaces.C.int) - is - Data : String (1 .. Integer (N)); - for Data'Address use Ptr; - pragma Import (Ada, Data); - begin - Text_Func_Ptr (Integer (X0), Integer (Y0), Data); - end Draw_Text_Hook; - - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Callback : in Text_Draw_Function; - Symbols : in Boolean := True) is - begin - Text_Func_Ptr := Callback; - fl_draw_draw_text3 - (Interfaces.C.To_C (Text), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.Unsigned_16 (Align), - Draw_Text_Hook'Address, - System.Null_Address, - Boolean'Pos (Symbols)); - end Draw_Text; - - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Callback : in Text_Draw_Function; - Picture : in FLTK.Images.Image'Class; - Symbols : in Boolean := True) is - begin - Text_Func_Ptr := Callback; - fl_draw_draw_text3 - (Interfaces.C.To_C (Text), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.Unsigned_16 (Align), - Draw_Text_Hook'Address, - Wrapper (Picture).Void_Ptr, - Boolean'Pos (Symbols)); - end Draw_Text; - - - procedure Draw_Text - (X, Y : in Integer; - Text : in String; - Angle : in Integer) is - begin - fl_draw_draw_text4 - (Interfaces.C.int (Angle), - Interfaces.C.To_C (Text), - Text'Length, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw_Text; - - - procedure Draw_Text_Right_Left - (X, Y : in Integer; - Text : in String) is - begin - fl_draw_rtl_draw - (Interfaces.C.To_C (Text), - Text'Length, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw_Text_Right_Left; - - - procedure Draw_Box - (X, Y, W, H : in Integer; - Kind : in Box_Kind; - Hue : in Color) is - begin - fl_draw_draw_box - (Box_Kind'Pos (Kind), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Hue)); - end Draw_Box; - - - procedure Draw_Symbol - (X, Y, W, H : in Integer; - Name : in String; - Hue : in Color) - is - Ret_Val : Interfaces.C.int := fl_draw_draw_symbol - (Interfaces.C.To_C (Name), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Hue)); - begin - if Ret_Val = 0 then - raise Draw_Error; - elsif Ret_Val /= 1 then - raise Program_Error; - end if; - end Draw_Symbol; - - - procedure Measure - (Text : in String; - W, H : out Natural; - Symbols : in Boolean := True; - Wrap : in Natural := 0) - is - Result_W : Interfaces.C.int := Interfaces.C.int (Wrap); - Result_H : Interfaces.C.int := 0; - begin - fl_draw_measure - (Interfaces.C.To_C (Text), - Result_W, Result_H, - Boolean'Pos (Symbols)); - W := Natural (Result_W); - H := Natural (Result_H); - end Measure; - - - procedure Scroll_Hook - (Ptr : in Area_Draw_Function; - X, Y, W, H : in Interfaces.C.int) is - begin - Ptr.all (Integer (X), Integer (Y), Integer (W), Integer (H)); - end Scroll_Hook; - - - procedure Scroll - (X, Y, W, H : in Integer; - DX, DY : in Integer; - Callback : in Area_Draw_Function) is - begin - fl_draw_scroll - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (DX), - Interfaces.C.int (DY), - Scroll_Hook'Address, - Callback.all'Address); - end Scroll; - - - procedure Text_Extents - (Text : in String; - DX, DY, W, H : out Integer) - is - Result_DX, Result_DY, Result_W, Result_H : Interfaces.C.int; - begin - fl_draw_text_extents - (Interfaces.C.To_C (Text), - Text'Length, - Result_DX, - Result_DY, - Result_W, - Result_H); - DX := Integer (Result_DX); - DY := Integer (Result_DY); - W := Integer (Result_W); - H := Integer (Result_H); - end Text_Extents; - - - function Width - (Text : in String) - return Long_Float is - begin - return Long_Float (fl_draw_width (Interfaces.C.To_C (Text), Text'Length)); - end Width; - - - function Width - (Glyph : in Character) - return Long_Float is - begin - return Long_Float (fl_draw_width2 (Character'Pos (Glyph))); - end Width; - - - function Width - (Glyph : in Wide_Character) - return Long_Float is - begin - return Long_Float (fl_draw_width2 (Wide_Character'Pos (Glyph))); - end Width; - - - function Width - (Glyph : in Wide_Wide_Character) - return Long_Float is - begin - return Long_Float (fl_draw_width2 (Wide_Wide_Character'Pos (Glyph))); - end Width; - - - - - ---------------------- - -- Manual Drawing -- - ---------------------- - - procedure Begin_Complex_Polygon is - begin - fl_draw_begin_complex_polygon; - end Begin_Complex_Polygon; - - procedure Begin_Line is - begin - fl_draw_begin_line; - end Begin_Line; - - procedure Begin_Loop is - begin - fl_draw_begin_loop; - end Begin_Loop; - - procedure Begin_Points is - begin - fl_draw_begin_points; - end Begin_Points; - - procedure Begin_Polygon is - begin - fl_draw_begin_polygon; - end Begin_Polygon; - - - procedure Arc - (X, Y, R, Start, Finish : in Long_Float) is - begin - fl_draw_arc - (Interfaces.C.double (X), - Interfaces.C.double (Y), - Interfaces.C.double (R), - Interfaces.C.double (Start), - Interfaces.C.double (Finish)); - end Arc; - - - procedure Arc - (X, Y, W, H : in Integer; - Start, Finish : in Long_Float) is - begin - fl_draw_arc2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.double (Start), - Interfaces.C.double (Finish)); - end Arc; - - - procedure Chord - (X, Y, W, H : in Integer; - Angle1, Angle2 : in Long_Float) is - begin - fl_draw_chord - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.double (Angle1), - Interfaces.C.double (Angle2)); - end Chord; - - - procedure Circle - (X, Y, R : in Long_Float) is - begin - fl_draw_circle - (Interfaces.C.double (X), - Interfaces.C.double (Y), - Interfaces.C.double (R)); - end Circle; - - - procedure Curve - (X0, Y0 : in Long_Float; - X1, Y1 : in Long_Float; - X2, Y2 : in Long_Float; - X3, Y3 : in Long_Float) is - begin - fl_draw_curve - (Interfaces.C.double (X0), Interfaces.C.double (Y0), - Interfaces.C.double (X1), Interfaces.C.double (Y1), - Interfaces.C.double (X2), Interfaces.C.double (Y2), - Interfaces.C.double (X3), Interfaces.C.double (Y3)); - end Curve; - - - procedure Frame - (X, Y, W, H : in Integer; - Top, Left, Bottom, Right : in Greyscale) is - begin - fl_draw_frame - (Interfaces.C.To_C - (Character (Top) & Character (Left) & Character (Bottom) & Character (Right)), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Frame; - - - procedure Gap is - begin - fl_draw_gap; - end Gap; - - - procedure Line - (X0, Y0 : in Integer; - X1, Y1 : in Integer) is - begin - fl_draw_line - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1)); - end Line; - - - procedure Line - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer) is - begin - fl_draw_line2 - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1), - Interfaces.C.int (X2), Interfaces.C.int (Y2)); - end Line; - - - procedure Outline - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer) is - begin - fl_draw_loop - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1), - Interfaces.C.int (X2), Interfaces.C.int (Y2)); - end Outline; - - - procedure Outline - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer; - X3, Y3 : in Integer) is - begin - fl_draw_loop2 - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1), - Interfaces.C.int (X2), Interfaces.C.int (Y2), - Interfaces.C.int (X3), Interfaces.C.int (Y3)); - end Outline; - - - procedure Pie - (X, Y, W, H : in Integer; - Angle1, Angle2 : in Long_Float) is - begin - fl_draw_pie - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.double (Angle1), - Interfaces.C.double (Angle2)); - end Pie; - - - procedure Point - (X, Y : in Integer) is - begin - fl_draw_point - (Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Point; - - - procedure Polygon - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer) is - begin - fl_draw_polygon - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1), - Interfaces.C.int (X2), Interfaces.C.int (Y2)); - end Polygon; - - - procedure Polygon - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer; - X3, Y3 : in Integer) is - begin - fl_draw_polygon2 - (Interfaces.C.int (X0), Interfaces.C.int (Y0), - Interfaces.C.int (X1), Interfaces.C.int (Y1), - Interfaces.C.int (X2), Interfaces.C.int (Y2), - Interfaces.C.int (X3), Interfaces.C.int (Y3)); - end Polygon; - - - procedure Rect - (X, Y, W, H : in Integer) is - begin - fl_draw_rect - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Rect; - - - procedure Rect - (X, Y, W, H : in Integer; - Hue : in Color) is - begin - fl_draw_rect2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Hue)); - end Rect; - - - procedure Rect_Fill - (X, Y, W, H : in Integer) is - begin - fl_draw_rect_fill - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Rect_Fill; - - - procedure Rect_Fill - (X, Y, W, H : in Integer; - Hue : in Color) is - begin - fl_draw_rect_fill2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Hue)); - end Rect_Fill; - - - procedure Rect_Fill - (X, Y, W, H : in Integer; - R, G, B : in Color_Component) is - begin - fl_draw_rect_fill3 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Rect_Fill; - - - procedure Ecks_Why_Line - (X0, Y0, X1 : in Integer) is - begin - fl_draw_xy_line - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (X1)); - end Ecks_Why_Line; - - - procedure Ecks_Why_Line - (X0, Y0, X1, Y2 : in Integer) is - begin - fl_draw_xy_line2 - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (X1), - Interfaces.C.int (Y2)); - end Ecks_Why_Line; - - - procedure Ecks_Why_Line - (X0, Y0, X1, Y2, X3 : in Integer) is - begin - fl_draw_xy_line3 - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (X1), - Interfaces.C.int (Y2), - Interfaces.C.int (X3)); - end Ecks_Why_Line; - - - procedure Why_Ecks_Line - (X0, Y0, Y1 : in Integer) is - begin - fl_draw_yx_line - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (Y1)); - end Why_Ecks_Line; - - - procedure Why_Ecks_Line - (X0, Y0, Y1, X2 : in Integer) is - begin - fl_draw_yx_line2 - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (Y1), - Interfaces.C.int (X2)); - end Why_Ecks_Line; - - - procedure Why_Ecks_Line - (X0, Y0, Y1, X2, Y3 : in Integer) is - begin - fl_draw_yx_line3 - (Interfaces.C.int (X0), - Interfaces.C.int (Y0), - Interfaces.C.int (Y1), - Interfaces.C.int (X2), - Interfaces.C.int (Y3)); - end Why_Ecks_Line; - - - procedure End_Complex_Polygon is - begin - fl_draw_end_complex_polygon; - end End_Complex_Polygon; - - procedure End_Line is - begin - fl_draw_end_line; - end End_Line; - - procedure End_Loop is - begin - fl_draw_end_loop; - end End_Loop; - - procedure End_Points is - begin - fl_draw_end_points; - end End_Points; - - procedure End_Polygon is - begin - fl_draw_end_polygon; - end End_Polygon; - - -end FLTK.Draw; - - diff --git a/src/fltk-draw.ads b/src/fltk-draw.ads deleted file mode 100644 index b4e14ee..0000000 --- a/src/fltk-draw.ads +++ /dev/null @@ -1,617 +0,0 @@ - - -with - - FLTK.Images, - FLTK.Widgets.Groups.Windows; - - -package FLTK.Draw is - - - -------------------------- - -- Types and Constants -- - -------------------------- - - type Line_Kind is - (Solid_Line, - Dash_Line, - Dot_Line, - Dashdot_Line, - Dashdotdot_Line); - - type Cap_Kind is - (Default_Cap, - Flat_Cap, - Round_Cap, - Square_Cap); - - type Join_Kind is - (Default_Join, - Miter_Join, - Round_Join, - Bevel_Join); - - type Dash_Length is new Integer range 1 .. 255; - - type Dash_Gap is record - Solid : Dash_Length; - Blank : Dash_Length; - end record; - - type Dash_Gap_Array is array (Positive range <>) of Dash_Gap; - - Empty_Dashes : constant Dash_Gap_Array (1 .. 0) := (others => (1, 1)); - - type Image_Draw_Function is access procedure - (X, Y : in Natural; - Data : out Color_Component_Array); - - type Symbol_Draw_Function is access procedure - (Hue : in Color); - - type Text_Draw_Function is access procedure - (X, Y : in Integer; - Text : in String); - - type Area_Draw_Function is access procedure - (X, Y, W, H : in Integer); - - Draw_Error : exception; - - - - - ------------------------ - -- No Documentation -- - ------------------------ - - procedure Reset_Spot; - - procedure Set_Spot - (X, Y, W, H : in Integer; - Font : in Font_Kind; - Size : in Font_Size); - - procedure Set_Spot - (X, Y, W, H : in Integer; - Font : in Font_Kind; - Size : in Font_Size; - Pane : in FLTK.Widgets.Groups.Windows.Window'Class); - - procedure Set_Status - (X, Y, W, H : in Integer); - - - - - --------------- - -- Utility -- - --------------- - - function Can_Do_Alpha_Blending - return Boolean; - - function Shortcut_Label - (Keys : in Key_Combo) - return String; - - - - - -------------------------- - -- Charset Conversion -- - -------------------------- - - function Latin1_To_Local - (From : in String) - return String; - - function Local_To_Latin1 - (From : in String) - return String; - - function Mac_Roman_To_Local - (From : in String) - return String; - - function Local_To_Mac_Roman - (From : in String) - return String; - - - - - ---------------- - -- Clipping -- - ---------------- - - function Clip_Box - (X, Y, W, H : in Integer; - BX, BY, BW, BH : out Integer) - return Boolean; - - function Clip_Intersects - (X, Y, W, H : in Integer) - return Boolean; - - procedure Pop_Clip; - - procedure Push_Clip - (X, Y, W, H : in Integer); - - procedure Push_No_Clip; - - procedure Restore_Clip; - - - - - --------------- - -- Overlay -- - --------------- - - procedure Overlay_Clear; - - procedure Overlay_Rect - (X, Y, W, H : in Integer); - - - - - ---------------- - -- Settings -- - ---------------- - - function Get_Color - return Color; - - procedure Set_Color - (To : in Color); - - procedure Set_Color - (R, G, B : in Color_Component); - - procedure Set_Cursor - (To : in Mouse_Cursor_Kind); - - procedure Set_Cursor - (To : in Mouse_Cursor_Kind; - Fore : in Color; - Back : in Color := White_Color); - - function Get_Font - return Font_Kind; - - function Get_Font_Size - return Font_Size; - - procedure Set_Font - (Kind : in Font_Kind; - Size : in Font_Size); - - function Font_Line_Spacing - return Integer; - - function Font_Descent - return Integer; - - function Font_Height - (Kind : in Font_Kind; - Size : in Font_Size) - return Natural; - - procedure Set_Line_Style - (Line : in Line_Kind := Solid_Line; - Cap : in Cap_Kind := Default_Cap; - Join : in Join_Kind := Default_Join; - Width : in Natural := 0; - Dashes : in Dash_Gap_Array := Empty_Dashes); - - - - - ------------------------- - -- Matrix Operations -- - ------------------------- - - procedure Mult_Matrix - (A, B, C, D, X, Y : in Long_Float); - - procedure Pop_Matrix; - - procedure Push_Matrix; - - procedure Rotate - (Angle : in Long_Float); - - procedure Scale - (Factor : in Long_Float); - - procedure Scale - (Factor_X, Factor_Y : in Long_Float); - - function Transform_DX - (X, Y : in Long_Float) - return Long_Float; - - function Transform_DY - (X, Y : in Long_Float) - return Long_Float; - - function Transform_X - (X, Y : in Long_Float) - return Long_Float; - - function Transform_Y - (X, Y : in Long_Float) - return Long_Float; - - procedure Transformed_Vertex - (XF, YF : in Long_Float); - - procedure Translate - (X, Y : in Long_Float); - - procedure Vertex - (X, Y : in Long_Float); - - - - - --------------------- - -- Image Drawing -- - --------------------- - - procedure Draw_Image - (X, Y, W, H : in Integer; - Data : in Color_Component_Array; - Depth : in Positive := 3; - Line_Data : in Natural := 0; - Flip_Horizontal : in Boolean := False; - Flip_Vertical : in Boolean := False); - - procedure Draw_Image - (X, Y, W, H : in Integer; - Callback : in Image_Draw_Function; - Depth : in Positive := 3); - - procedure Draw_Image_Mono - (X, Y, W, H : in Integer; - Data : in Color_Component_Array; - Depth : in Positive := 1; - Line_Data : in Natural := 0; - Flip_Horizontal : Boolean := False; - Flip_Vertical : Boolean := False); - - procedure Draw_Image_Mono - (X, Y, W, H : in Integer; - Callback : in Image_Draw_Function; - Depth : in Positive := 1); - - function Read_Image - (X, Y, W, H : in Integer; - Alpha : in Integer := 0) - return Color_Component_Array - with Post => - (if Alpha = 0 - then Read_Image'Result'Length = W * H * 3 - else Read_Image'Result'Length = W * H * 4); - - - - - ----------------------- - -- Special Drawing -- - ----------------------- - - procedure Add_Symbol - (Text : in String; - Callback : in Symbol_Draw_Function; - Scalable : in Boolean); - - procedure Draw_Text - (X, Y : in Integer; - Text : in String) - with Pre => Text'Length > 0; - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Symbols : in Boolean := True); - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Picture : in FLTK.Images.Image'Class; - Symbols : in Boolean := True); - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Callback : in Text_Draw_Function; - Symbols : in Boolean := True); - - procedure Draw_Text - (X, Y, W, H : in Integer; - Text : in String; - Align : in Alignment; - Callback : in Text_Draw_Function; - Picture : in FLTK.Images.Image'Class; - Symbols : in Boolean := True); - - procedure Draw_Text - (X, Y : in Integer; - Text : in String; - Angle : in Integer); - - procedure Draw_Text_Right_Left - (X, Y : in Integer; - Text : in String); - - procedure Draw_Box - (X, Y, W, H : in Integer; - Kind : in Box_Kind; - Hue : in Color); - - procedure Draw_Symbol - (X, Y, W, H : in Integer; - Name : in String; - Hue : in Color); - - procedure Measure - (Text : in String; - W, H : out Natural; - Symbols : in Boolean := True; - Wrap : in Natural := 0); - - procedure Scroll - (X, Y, W, H : in Integer; - DX, DY : in Integer; - Callback : in Area_Draw_Function); - - procedure Text_Extents - (Text : in String; - DX, DY, W, H : out Integer); - - function Width - (Text : in String) - return Long_Float; - - function Width - (Glyph : in Character) - return Long_Float; - - function Width - (Glyph : in Wide_Character) - return Long_Float; - - function Width - (Glyph : in Wide_Wide_Character) - return Long_Float; - - - - - ---------------------- - -- Manual Drawing -- - ---------------------- - - procedure Begin_Complex_Polygon; - procedure Begin_Line; - procedure Begin_Loop; - procedure Begin_Points; - procedure Begin_Polygon; - - procedure Arc - (X, Y, R, Start, Finish : in Long_Float); - - procedure Arc - (X, Y, W, H : in Integer; - Start, Finish : in Long_Float); - - -- As per 1.3.9 docs, currently a placeholder - procedure Chord - (X, Y, W, H : in Integer; - Angle1, Angle2 : in Long_Float); - - procedure Circle - (X, Y, R : in Long_Float); - - procedure Curve - (X0, Y0 : in Long_Float; - X1, Y1 : in Long_Float; - X2, Y2 : in Long_Float; - X3, Y3 : in Long_Float); - - procedure Frame - (X, Y, W, H : in Integer; - Top, Left, Bottom, Right : in Greyscale); - - procedure Gap; - - procedure Line - (X0, Y0 : in Integer; - X1, Y1 : in Integer); - - procedure Line - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer); - - procedure Outline - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer); - - procedure Outline - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer; - X3, Y3 : in Integer); - - procedure Pie - (X, Y, W, H : in Integer; - Angle1, Angle2 : in Long_Float); - - procedure Point - (X, Y : in Integer); - - procedure Polygon - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer); - - procedure Polygon - (X0, Y0 : in Integer; - X1, Y1 : in Integer; - X2, Y2 : in Integer; - X3, Y3 : in Integer); - - procedure Rect - (X, Y, W, H : in Integer); - - procedure Rect - (X, Y, W, H : in Integer; - Hue : in Color); - - procedure Rect_Fill - (X, Y, W, H : in Integer); - - procedure Rect_Fill - (X, Y, W, H : in Integer; - Hue : in Color); - - procedure Rect_Fill - (X, Y, W, H : in Integer; - R, G, B : in Color_Component); - - procedure Ecks_Why_Line - (X0, Y0, X1 : in Integer); - - procedure Ecks_Why_Line - (X0, Y0, X1, Y2 : in Integer); - - procedure Ecks_Why_Line - (X0, Y0, X1, Y2, X3 : in Integer); - - procedure Why_Ecks_Line - (X0, Y0, Y1 : in Integer); - - procedure Why_Ecks_Line - (X0, Y0, Y1, X2 : in Integer); - - procedure Why_Ecks_Line - (X0, Y0, Y1, X2, Y3 : in Integer); - - procedure End_Complex_Polygon; - procedure End_Line; - procedure End_Loop; - procedure End_Points; - procedure End_Polygon; - - -private - - - pragma Convention (C, Symbol_Draw_Function); - - - pragma Inline (Reset_Spot); - pragma Inline (Set_Spot); - pragma Inline (Set_Status); - - - pragma Inline (Can_Do_Alpha_Blending); - pragma Inline (Shortcut_Label); - - - pragma Inline (Latin1_To_Local); - pragma Inline (Local_To_Latin1); - pragma Inline (Mac_Roman_To_Local); - pragma Inline (Local_To_Mac_Roman); - - - pragma Inline (Clip_Intersects); - pragma Inline (Pop_Clip); - pragma Inline (Push_Clip); - pragma Inline (Push_No_Clip); - pragma Inline (Restore_Clip); - - - pragma Inline (Overlay_Clear); - pragma Inline (Overlay_Rect); - - - pragma Inline (Get_Color); - pragma Inline (Set_Color); - pragma Inline (Get_Font); - pragma Inline (Get_Font_Size); - pragma Inline (Set_Font); - pragma Inline (Font_Line_Spacing); - pragma Inline (Font_Descent); - pragma Inline (Font_Height); - - - pragma Inline (Mult_Matrix); - pragma Inline (Pop_Matrix); - pragma Inline (Push_Matrix); - pragma Inline (Rotate); - pragma Inline (Scale); - pragma Inline (Transform_DX); - pragma Inline (Transform_DY); - pragma Inline (Transform_X); - pragma Inline (Transform_Y); - pragma Inline (Transformed_Vertex); - pragma Inline (Translate); - pragma Inline (Vertex); - - - pragma Inline (Add_Symbol); - pragma Inline (Draw_Text); - pragma Inline (Draw_Text_Right_Left); - pragma Inline (Draw_Box); - pragma Inline (Draw_Symbol); - pragma Inline (Measure); - pragma Inline (Scroll); - pragma Inline (Text_Extents); - pragma Inline (Width); - - - pragma Inline (Begin_Complex_Polygon); - pragma Inline (Begin_Line); - pragma Inline (Begin_Loop); - pragma Inline (Begin_Points); - pragma Inline (Begin_Polygon); - - - pragma Inline (Arc); - pragma Inline (Chord); - pragma Inline (Circle); - pragma Inline (Curve); - pragma Inline (Frame); - pragma Inline (Gap); - pragma Inline (Line); - pragma Inline (Outline); - pragma Inline (Pie); - pragma Inline (Point); - pragma Inline (Polygon); - pragma Inline (Rect); - pragma Inline (Rect_Fill); - pragma Inline (Ecks_Why_Line); - pragma Inline (Why_Ecks_Line); - - - pragma Inline (End_Complex_Polygon); - pragma Inline (End_Line); - pragma Inline (End_Loop); - pragma Inline (End_Points); - pragma Inline (End_Polygon); - - -end FLTK.Draw; - - diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb deleted file mode 100644 index ae832c0..0000000 --- a/src/fltk-environment.adb +++ /dev/null @@ -1,561 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Environment is - - - function new_fl_preferences - (P, V, A : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_preferences, "new_fl_preferences"); - pragma Inline (new_fl_preferences); - - procedure free_fl_preferences - (E : in System.Address); - pragma Import (C, free_fl_preferences, "free_fl_preferences"); - pragma Inline (free_fl_preferences); - - - - - function fl_preferences_entries - (E : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_entries, "fl_preferences_entries"); - pragma Inline (fl_preferences_entries); - - function fl_preferences_entry - (E : in System.Address; - I : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_preferences_entry, "fl_preferences_entry"); - pragma Inline (fl_preferences_entry); - - function fl_preferences_entryexists - (E : in System.Address; - K : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_entryexists, "fl_preferences_entryexists"); - pragma Inline (fl_preferences_entryexists); - - function fl_preferences_size - (E : in System.Address; - K : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_size, "fl_preferences_size"); - pragma Inline (fl_preferences_size); - - - - - function fl_preferences_get_int - (E : in System.Address; - K : in Interfaces.C.char_array; - V : out Interfaces.C.int; - D : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_int, "fl_preferences_get_int"); - pragma Inline (fl_preferences_get_int); - - function fl_preferences_get_float - (E : in System.Address; - K : in Interfaces.C.char_array; - V : out Interfaces.C.C_float; - D : in Interfaces.C.C_float) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_float, "fl_preferences_get_float"); - pragma Inline (fl_preferences_get_float); - - function fl_preferences_get_double - (E : in System.Address; - K : in Interfaces.C.char_array; - V : out Interfaces.C.double; - D : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_double, "fl_preferences_get_double"); - pragma Inline (fl_preferences_get_double); - - function fl_preferences_get_str - (E : in System.Address; - K : in Interfaces.C.char_array; - V : out Interfaces.C.Strings.chars_ptr; - D : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_str, "fl_preferences_get_str"); - pragma Inline (fl_preferences_get_str); - - - - - function fl_preferences_set_int - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_int, "fl_preferences_set_int"); - pragma Inline (fl_preferences_set_int); - - function fl_preferences_set_float - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.C_float) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_float, "fl_preferences_set_float"); - pragma Inline (fl_preferences_set_float); - - function fl_preferences_set_float_prec - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.C_float; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_float_prec, "fl_preferences_set_float_prec"); - pragma Inline (fl_preferences_set_float_prec); - - function fl_preferences_set_double - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_double, "fl_preferences_set_double"); - pragma Inline (fl_preferences_set_double); - - function fl_preferences_set_double_prec - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.double; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_double_prec, "fl_preferences_set_double_prec"); - pragma Inline (fl_preferences_set_double_prec); - - function fl_preferences_set_str - (E : in System.Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_str, "fl_preferences_set_str"); - pragma Inline (fl_preferences_set_str); - - - - - function fl_preferences_deleteentry - (E : in System.Address; - K : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_deleteentry, "fl_preferences_deleteentry"); - pragma Inline (fl_preferences_deleteentry); - - function fl_preferences_deleteallentries - (E : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries"); - pragma Inline (fl_preferences_deleteallentries); - - function fl_preferences_clear - (E : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_clear, "fl_preferences_clear"); - pragma Inline (fl_preferences_clear); - - - - - procedure fl_preferences_flush - (E : in System.Address); - pragma Import (C, fl_preferences_flush, "fl_preferences_flush"); - pragma Inline (fl_preferences_flush); - - - - - procedure Finalize - (This : in out Preferences) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Preferences'Class - then - free_fl_preferences (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - end Finalize; - - - - - package body Forge is - - function From_Filesystem - (Path, Vendor, Application : in String) - return Preferences is - begin - return This : Preferences do - This.Void_Ptr := new_fl_preferences - (Interfaces.C.To_C (Path), - Interfaces.C.To_C (Vendor), - Interfaces.C.To_C (Application)); - end return; - end From_Filesystem; - - end Forge; - - - - - function Number_Of_Entries - (This : in Preferences) - return Natural is - begin - return Natural (fl_preferences_entries (This.Void_Ptr)); - end Number_Of_Entries; - - - function Get_Key - (This : in Preferences; - Index : in Natural) - return String - is - Key : Interfaces.C.Strings.chars_ptr := - fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index)); - begin - -- no need for dealloc? - if Key = Interfaces.C.Strings.Null_Ptr then - raise Constraint_Error; - else - return Interfaces.C.Strings.Value (Key); - end if; - end Get_Key; - - - function Entry_Exists - (This : in Preferences; - Key : in String) - return Boolean is - begin - return fl_preferences_entryexists (This.Void_Ptr, Interfaces.C.To_C (Key)) /= 0; - end Entry_Exists; - - - function Entry_Size - (This : in Preferences; - Key : in String) - return Natural is - begin - return Natural (fl_preferences_size (This.Void_Ptr, Interfaces.C.To_C (Key))); - end Entry_Size; - - - - - function Get - (This : in Preferences; - Key : in String) - return Integer - is - Value : Interfaces.C.int; - begin - if fl_preferences_get_int - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, 0) = 0 - then - raise Preference_Error; - end if; - return Integer (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String) - return Float - is - Value : Interfaces.C.C_float; - begin - if fl_preferences_get_float - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, 0.0) = 0 - then - raise Preference_Error; - end if; - return Float (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String) - return Long_Float - is - Value : Interfaces.C.double; - begin - if fl_preferences_get_double - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, 0.0) = 0 - then - raise Preference_Error; - end if; - return Long_Float (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String) - return String - is - Value : Interfaces.C.Strings.chars_ptr; - Check : Interfaces.C.int := fl_preferences_get_str - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, - Interfaces.C.To_C ("default")); - begin - if Check = 0 then - raise Preference_Error; - end if; - if Value = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Str : String := Interfaces.C.Strings.Value (Value); - begin - Interfaces.C.Strings.Free (Value); - return Str; - end; - end if; - end Get; - - - - - function Get - (This : in Preferences; - Key : in String; - Default : in Integer) - return Integer - is - Value, X : Interfaces.C.int; - begin - X := fl_preferences_get_int - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, - Interfaces.C.int (Default)); - return Integer (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String; - Default : in Float) - return Float - is - Value : Interfaces.C.C_float; - X : Interfaces.C.int; - begin - X := fl_preferences_get_float - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, - Interfaces.C.C_float (Default)); - return Float (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String; - Default : in Long_Float) - return Long_Float - is - Value : Interfaces.C.double; - X : Interfaces.C.int; - begin - X := fl_preferences_get_double - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, - Interfaces.C.double (Default)); - return Long_Float (Value); - end Get; - - - function Get - (This : in Preferences; - Key : in String; - Default : in String) - return String - is - Value : Interfaces.C.Strings.chars_ptr; - X : Interfaces.C.int := fl_preferences_get_str - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Value, - Interfaces.C.To_C (Default)); - begin - if Value = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Str : String := Interfaces.C.Strings.Value (Value); - begin - Interfaces.C.Strings.Free (Value); - return Str; - end; - end if; - end Get; - - - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Integer) is - begin - if fl_preferences_set_int - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.int (Value)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Float) is - begin - if fl_preferences_set_float - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.C_float (Value)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Float; - Precision : in Natural) is - begin - if fl_preferences_set_float_prec - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.C_float (Value), - Interfaces.C.int (Precision)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Long_Float) is - begin - if fl_preferences_set_double - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.double (Value)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Long_Float; - Precision : in Natural) is - begin - if fl_preferences_set_double_prec - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.double (Value), - Interfaces.C.int (Precision)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in String) is - begin - if fl_preferences_set_str - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Interfaces.C.To_C (Value)) = 0 - then - raise Preference_Error; - end if; - end Set; - - - - - procedure Delete_Entry - (This : in out Preferences; - Key : in String) is - begin - if fl_preferences_deleteentry (This.Void_Ptr, Interfaces.C.To_C (Key)) = 0 then - raise Preference_Error; - end if; - end Delete_Entry; - - - procedure Delete_All_Entries - (This : in out Preferences) is - begin - if fl_preferences_deleteallentries (This.Void_Ptr) = 0 then - raise Preference_Error; - end if; - end Delete_All_Entries; - - - procedure Clear - (This : in out Preferences) is - begin - if fl_preferences_clear (This.Void_Ptr) = 0 then - raise Preference_Error; - end if; - end Clear; - - - - - procedure Flush - (This : in Preferences) is - begin - fl_preferences_flush (This.Void_Ptr); - end Flush; - - -end FLTK.Environment; - diff --git a/src/fltk-environment.ads b/src/fltk-environment.ads deleted file mode 100644 index cfa63a8..0000000 --- a/src/fltk-environment.ads +++ /dev/null @@ -1,186 +0,0 @@ - - -package FLTK.Environment is - - - type Preferences is new Wrapper with private; - - type Preferences_Reference (Data : not null access Preferences'Class) is - limited null record with Implicit_Dereference => Data; - - type Scope is (Root, User); - - - - - Preference_Error : exception; - - - - - package Forge is - - function From_Filesystem - (Path, Vendor, Application : in String) - return Preferences; - - end Forge; - - - - - function Number_Of_Entries - (This : in Preferences) - return Natural; - - function Get_Key - (This : in Preferences; - Index : in Natural) - return String; - - function Entry_Exists - (This : in Preferences; - Key : in String) - return Boolean; - - function Entry_Size - (This : in Preferences; - Key : in String) - return Natural; - - - - - function Get - (This : in Preferences; - Key : in String) - return Integer; - - function Get - (This : in Preferences; - Key : in String) - return Float; - - function Get - (This : in Preferences; - Key : in String) - return Long_Float; - - function Get - (This : in Preferences; - Key : in String) - return String; - - - - - function Get - (This : in Preferences; - Key : in String; - Default : in Integer) - return Integer; - - function Get - (This : in Preferences; - Key : in String; - Default : in Float) - return Float; - - function Get - (This : in Preferences; - Key : in String; - Default : in Long_Float) - return Long_Float; - - function Get - (This : in Preferences; - Key : in String; - Default : in String) - return String; - - - - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Integer); - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Float); - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Float; - Precision : in Natural); - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Long_Float); - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in Long_Float; - Precision : in Natural); - - procedure Set - (This : in out Preferences; - Key : in String; - Value : in String); - - - - - procedure Delete_Entry - (This : in out Preferences; - Key : in String); - - procedure Delete_All_Entries - (This : in out Preferences); - - procedure Clear - (This : in out Preferences); - - - - - procedure Flush - (This : in Preferences); - - -private - - - type Preferences is new Wrapper with null record; - - overriding procedure Finalize - (This : in out Preferences); - - - - - pragma Inline (Number_Of_Entries); - pragma Inline (Get_Key); - pragma Inline (Entry_Exists); - pragma Inline (Entry_Size); - - - pragma Inline (Get); - pragma Inline (Set); - - - pragma Inline (Delete_Entry); - pragma Inline (Delete_All_Entries); - pragma Inline (Clear); - - - pragma Inline (Flush); - - -end FLTK.Environment; - diff --git a/src/fltk-event.adb b/src/fltk-event.adb deleted file mode 100644 index bbad8ba..0000000 --- a/src/fltk-event.adb +++ /dev/null @@ -1,643 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Event is - - - procedure fl_event_add_handler - (F : in System.Address); - pragma Import (C, fl_event_add_handler, "fl_event_add_handler"); - pragma Inline (fl_event_add_handler); - - procedure fl_event_set_event_dispatch - (F : in System.Address); - pragma Import (C, fl_event_set_event_dispatch, "fl_event_set_event_dispatch"); - pragma Inline (fl_event_set_event_dispatch); - - -- actually handle_ but can't have an underscore on the end of an identifier - function fl_event_handle - (E : in Interfaces.C.int; - W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_event_handle, "fl_event_handle"); - pragma Inline (fl_event_handle); - - - - - function fl_event_get_grab - return System.Address; - pragma Import (C, fl_event_get_grab, "fl_event_get_grab"); - pragma Inline (fl_event_get_grab); - - procedure fl_event_set_grab - (T : in System.Address); - pragma Import (C, fl_event_set_grab, "fl_event_set_grab"); - pragma Inline (fl_event_set_grab); - - function fl_event_get_pushed - return System.Address; - pragma Import (C, fl_event_get_pushed, "fl_event_get_pushed"); - pragma Inline (fl_event_get_pushed); - - procedure fl_event_set_pushed - (T : in System.Address); - pragma Import (C, fl_event_set_pushed, "fl_event_set_pushed"); - pragma Inline (fl_event_set_pushed); - - function fl_event_get_belowmouse - return System.Address; - pragma Import (C, fl_event_get_belowmouse, "fl_event_get_belowmouse"); - pragma Inline (fl_event_get_belowmouse); - - procedure fl_event_set_belowmouse - (T : in System.Address); - pragma Import (C, fl_event_set_belowmouse, "fl_event_set_belowmouse"); - pragma Inline (fl_event_set_belowmouse); - - function fl_event_get_focus - return System.Address; - pragma Import (C, fl_event_get_focus, "fl_event_get_focus"); - pragma Inline (fl_event_get_focus); - - procedure fl_event_set_focus - (To : in System.Address); - pragma Import (C, fl_event_set_focus, "fl_event_set_focus"); - pragma Inline (fl_event_set_focus); - - - - - function fl_event_compose - (D : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_event_compose, "fl_event_compose"); - pragma Inline (fl_event_compose); - - procedure fl_event_compose_reset; - pragma Import (C, fl_event_compose_reset, "fl_event_compose_reset"); - pragma Inline (fl_event_compose_reset); - - function fl_event_text - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_event_text, "fl_event_text"); - pragma Inline (fl_event_text); - - function fl_event_length - return Interfaces.C.int; - pragma Import (C, fl_event_length, "fl_event_length"); - pragma Inline (fl_event_length); - - - - - function fl_event_get - return Interfaces.C.int; - pragma Import (C, fl_event_get, "fl_event_get"); - pragma Inline (fl_event_get); - - function fl_event_state - return Interfaces.C.unsigned_long; - pragma Import (C, fl_event_state, "fl_event_state"); - pragma Inline (fl_event_state); - - function fl_event_check_state - (S : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_event_check_state, "fl_event_check_state"); - pragma Inline (fl_event_check_state); - - - - - function fl_event_x - return Interfaces.C.int; - pragma Import (C, fl_event_x, "fl_event_x"); - pragma Inline (fl_event_x); - - function fl_event_x_root - return Interfaces.C.int; - pragma Import (C, fl_event_x_root, "fl_event_x_root"); - pragma Inline (fl_event_x_root); - - function fl_event_y - return Interfaces.C.int; - pragma Import (C, fl_event_y, "fl_event_y"); - pragma Inline (fl_event_y); - - function fl_event_y_root - return Interfaces.C.int; - pragma Import (C, fl_event_y_root, "fl_event_y_root"); - pragma Inline (fl_event_y_root); - - function fl_event_dx - return Interfaces.C.int; - pragma Import (C, fl_event_dx, "fl_event_dx"); - pragma Inline (fl_event_dx); - - function fl_event_dy - return Interfaces.C.int; - pragma Import (C, fl_event_dy, "fl_event_dy"); - pragma Inline (fl_event_dy); - - procedure fl_event_get_mouse - (X, Y : out Interfaces.C.int); - pragma Import (C, fl_event_get_mouse, "fl_event_get_mouse"); - pragma Inline (fl_event_get_mouse); - - function fl_event_is_click - return Interfaces.C.int; - pragma Import (C, fl_event_is_click, "fl_event_is_click"); - pragma Inline (fl_event_is_click); - - function fl_event_is_clicks - return Interfaces.C.int; - pragma Import (C, fl_event_is_clicks, "fl_event_is_clicks"); - pragma Inline (fl_event_is_clicks); - - procedure fl_event_set_clicks - (C : in Interfaces.C.int); - pragma Import (C, fl_event_set_clicks, "fl_event_set_clicks"); - pragma Inline (fl_event_set_clicks); - - function fl_event_button - return Interfaces.C.int; - pragma Import (C, fl_event_button, "fl_event_button"); - pragma Inline (fl_event_button); - - function fl_event_button1 - return Interfaces.C.int; - pragma Import (C, fl_event_button1, "fl_event_button1"); - pragma Inline (fl_event_button1); - - function fl_event_button2 - return Interfaces.C.int; - pragma Import (C, fl_event_button2, "fl_event_button2"); - pragma Inline (fl_event_button2); - - function fl_event_button3 - return Interfaces.C.int; - pragma Import (C, fl_event_button3, "fl_event_button3"); - pragma Inline (fl_event_button3); - - function fl_event_inside - (X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_event_inside, "fl_event_inside"); - pragma Inline (fl_event_inside); - - - - - function fl_event_key - return Interfaces.C.unsigned_long; - pragma Import (C, fl_event_key, "fl_event_key"); - pragma Inline (fl_event_key); - - function fl_event_original_key - return Interfaces.C.unsigned_long; - pragma Import (C, fl_event_original_key, "fl_event_original_key"); - pragma Inline (fl_event_original_key); - - function fl_event_key_during - (K : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_event_key_during, "fl_event_key_during"); - pragma Inline (fl_event_key_during); - - function fl_event_get_key - (K : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_event_get_key, "fl_event_get_key"); - pragma Inline (fl_event_get_key); - - function fl_event_ctrl - return Interfaces.C.int; - pragma Import (C, fl_event_ctrl, "fl_event_ctrl"); - pragma Inline (fl_event_ctrl); - - function fl_event_alt - return Interfaces.C.int; - pragma Import (C, fl_event_alt, "fl_event_alt"); - pragma Inline (fl_event_alt); - - function fl_event_command - return Interfaces.C.int; - pragma Import (C, fl_event_command, "fl_event_command"); - pragma Inline (fl_event_command); - - function fl_event_shift - return Interfaces.C.int; - pragma Import (C, fl_event_shift, "fl_event_shift"); - pragma Inline (fl_event_shift); - - - - - function Event_Handler_Hook - (Num : in Interfaces.C.int) - return Interfaces.C.int - is - Ret_Val : Event_Outcome; - begin - for Func of reverse Handlers loop - Ret_Val := Func (Event_Kind'Val (Num)); - if Ret_Val /= Not_Handled then - return Event_Outcome'Pos (Ret_Val); - end if; - end loop; - return Event_Outcome'Pos (Not_Handled); - end Event_Handler_Hook; - - - -- function Dispatch_Hook - -- (Num : in Interfaces.C.int; - -- Ptr : in System.Address) - -- return Interfaces.C.int - -- is - -- Ret_Val : Event_Outcome; - -- Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - -- begin - -- if Ptr /= System.Null_Address then - -- Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Ptr)); - -- end if; - -- if Current_Dispatch = null then - -- Ret_Val := Default_Dispatch (Event_Kind'Val (Num), Actual_Window); - -- else - -- Ret_Val := Current_Dispatch (Event_Kind'Val (Num), Actual_Window); - -- end if; - -- return Event_Outcome'Pos (Ret_Val); - -- end Dispatch_Hook; - - - - - procedure Add_Handler - (Func : in Event_Handler) is - begin - Handlers.Append (Func); - end Add_Handler; - - - procedure Remove_Handler - (Func : in Event_Handler) is - begin - for I in reverse Handlers.First_Index .. Handlers.Last_Index loop - if Handlers (I) = Func then - Handlers.Delete (I); - return; - end if; - end loop; - end Remove_Handler; - - - -- function Get_Dispatch - -- return Event_Dispatch is - -- begin - -- if Current_Dispatch = null then - -- return Default_Dispatch'Access; - -- else - -- return Current_Dispatch; - -- end if; - -- end Get_Dispatch; - - - -- procedure Set_Dispatch - -- (Func : in Event_Dispatch) is - -- begin - -- Current_Dispatch := Func; - -- end Set_Dispatch; - - - -- function Default_Dispatch - -- (Event : in Event_Kind; - -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) - -- return Event_Outcome is - -- begin - -- if Win = null then - -- return Event_Outcome'Val (fl_event_handle - -- (Event_Kind'Pos (Event), System.Null_Address)); - -- else - -- return Event_Outcome'Val (fl_event_handle - -- (Event_Kind'Pos (Event), - -- Wrapper (Win.all).Void_Ptr)); - -- end if; - -- end Default_Dispatch; - - - - - function Get_Grab - return access FLTK.Widgets.Groups.Windows.Window'Class is - begin - return Window_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_grab)); - end Get_Grab; - - - procedure Set_Grab - (To : in FLTK.Widgets.Groups.Windows.Window'Class) is - begin - fl_event_set_grab (Wrapper (To).Void_Ptr); - end Set_Grab; - - - procedure Release_Grab is - begin - fl_event_set_grab (System.Null_Address); - end Release_Grab; - - - function Get_Pushed - return access FLTK.Widgets.Widget'Class is - begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_pushed)); - end Get_Pushed; - - - procedure Set_Pushed - (To : in FLTK.Widgets.Widget'Class) is - begin - fl_event_set_pushed (Wrapper (To).Void_Ptr); - end Set_Pushed; - - - function Get_Below_Mouse - return access FLTK.Widgets.Widget'Class is - begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_belowmouse)); - end Get_Below_Mouse; - - - procedure Set_Below_Mouse - (To : in FLTK.Widgets.Widget'Class) is - begin - fl_event_set_belowmouse (Wrapper (To).Void_Ptr); - end Set_Below_Mouse; - - - function Get_Focus - return access FLTK.Widgets.Widget'Class is - begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_focus)); - end Get_Focus; - - - procedure Set_Focus - (To : in FLTK.Widgets.Widget'Class) is - begin - fl_event_set_focus (Wrapper (To).Void_Ptr); - end Set_Focus; - - - - - function Compose - (Del : out Natural) - return Boolean is - begin - return fl_event_compose (Interfaces.C.int (Del)) /= 0; - end Compose; - - procedure Compose_Reset is - begin - fl_event_compose_reset; - end Compose_Reset; - - - function Text - return String - is - Str : Interfaces.C.Strings.chars_ptr := fl_event_text; - begin - if Str = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Str, Interfaces.C.size_t (fl_event_length)); - end if; - end Text; - - - function Text_Length - return Natural is - begin - return Natural (fl_event_length); - end Text_Length; - - - - - function Last - return Event_Kind is - begin - return Event_Kind'Val (fl_event_get); - end Last; - - - function Last_Modifier - return Modifier is - begin - return To_Ada (fl_event_state); - end Last_Modifier; - - - function Last_Modifier - (Had : in Modifier) - return Boolean is - begin - return fl_event_check_state (To_C (Had)) /= 0; - end Last_Modifier; - - - - - function Mouse_X - return Integer is - begin - return Integer (fl_event_x); - end Mouse_X; - - - function Mouse_X_Root - return Integer is - begin - return Integer (fl_event_x_root); - end Mouse_X_Root; - - - function Mouse_Y - return Integer is - begin - return Integer (fl_event_y); - end Mouse_Y; - - - function Mouse_Y_Root - return Integer is - begin - return Integer (fl_event_y_root); - end Mouse_Y_Root; - - - - function Mouse_DX - return Integer is - begin - return Integer (fl_event_dx); - end Mouse_DX; - - - function Mouse_DY - return Integer is - begin - return Integer (fl_event_dy); - end Mouse_DY; - - - procedure Get_Mouse - (X, Y : out Integer) is - begin - fl_event_get_mouse (Interfaces.C.int (X), Interfaces.C.int (Y)); - end Get_Mouse; - - - function Is_Click - return Boolean is - begin - return fl_event_is_click /= 0; - end Is_Click; - - - function Is_Multi_Click - return Boolean is - begin - return fl_event_is_clicks /= 0; - end Is_Multi_Click; - - - procedure Set_Clicks - (To : in Natural) is - begin - fl_event_set_clicks (Interfaces.C.int (To)); - end Set_Clicks; - - - function Last_Button - return Mouse_Button is - begin - return Mouse_Button'Val (fl_event_button); - end Last_Button; - - - function Mouse_Left - return Boolean is - begin - return fl_event_button1 /= 0; - end Mouse_Left; - - - function Mouse_Middle - return Boolean is - begin - return fl_event_button2 /= 0; - end Mouse_Middle; - - - function Mouse_Right - return Boolean is - begin - return fl_event_button3 /= 0; - end Mouse_Right; - - - function Is_Inside - (X, Y, W, H : in Integer) - return Boolean is - begin - return fl_event_inside - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)) /= 0; - end Is_Inside; - - - - - function Last_Key - return Keypress is - begin - return To_Ada (fl_event_key); - end Last_Key; - - - function Original_Last_Key - return Keypress is - begin - return To_Ada (fl_event_original_key); - end Original_Last_Key; - - - function Pressed_During - (Key : in Keypress) - return Boolean is - begin - return fl_event_key_during (To_C (Key)) /= 0; - end Pressed_During; - - - function Key_Now - (Key : in Keypress) - return Boolean is - begin - return fl_event_get_key (To_C (Key)) /= 0; - end Key_Now; - - - function Key_Ctrl - return Boolean is - begin - return fl_event_ctrl /= 0; - end Key_Ctrl; - - - function Key_Alt - return Boolean is - begin - return fl_event_alt /= 0; - end Key_Alt; - - - function Key_Command - return Boolean is - begin - return fl_event_command /= 0; - end Key_Command; - - - function Key_Shift - return Boolean is - begin - return fl_event_shift /= 0; - end Key_Shift; - - -begin - - - fl_event_add_handler (Event_Handler_Hook'Address); - -- fl_event_set_event_dispatch (Dispatch_Hook'Address); - - -end FLTK.Event; - diff --git a/src/fltk-event.ads b/src/fltk-event.ads deleted file mode 100644 index f103091..0000000 --- a/src/fltk-event.ads +++ /dev/null @@ -1,263 +0,0 @@ - - -with - - FLTK.Widgets.Groups.Windows; - -private with - - Ada.Containers.Vectors, - System.Address_To_Access_Conversions; - - -package FLTK.Event is - - - type Event_Handler is access function - (Event : in Event_Kind) - return Event_Outcome; - - -- type Event_Dispatch is access function - -- (Event : in Event_Kind; - -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) - -- return Event_Outcome; - - - - - procedure Add_Handler - (Func : in Event_Handler); - - procedure Remove_Handler - (Func : in Event_Handler); - - -- function Get_Dispatch - -- return Event_Dispatch; - - -- procedure Set_Dispatch - -- (Func : in Event_Dispatch); - - -- function Default_Dispatch - -- (Event : in Event_Kind; - -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) - -- return Event_Outcome; - - - - - function Get_Grab - return access FLTK.Widgets.Groups.Windows.Window'Class; - - procedure Set_Grab - (To : in FLTK.Widgets.Groups.Windows.Window'Class); - - procedure Release_Grab; - - function Get_Pushed - return access FLTK.Widgets.Widget'Class; - - procedure Set_Pushed - (To : in FLTK.Widgets.Widget'Class); - - function Get_Below_Mouse - return access FLTK.Widgets.Widget'Class; - - procedure Set_Below_Mouse - (To : in FLTK.Widgets.Widget'Class); - - function Get_Focus - return access FLTK.Widgets.Widget'Class; - - procedure Set_Focus - (To : in FLTK.Widgets.Widget'Class); - - - - - function Compose - (Del : out Natural) - return Boolean; - - procedure Compose_Reset; - - function Text - return String; - - function Text_Length - return Natural; - - - - - function Last - return Event_Kind; - - function Last_Modifier - return Modifier; - - function Last_Modifier - (Had : in Modifier) - return Boolean; - - - - - function Mouse_X - return Integer; - - function Mouse_X_Root - return Integer; - - function Mouse_Y - return Integer; - - function Mouse_Y_Root - return Integer; - - function Mouse_DX - return Integer; - - function Mouse_DY - return Integer; - - procedure Get_Mouse - (X, Y : out Integer); - - function Is_Click - return Boolean; - - function Is_Multi_Click - return Boolean; - - procedure Set_Clicks - (To : in Natural); - - function Last_Button - return Mouse_Button; - - function Mouse_Left - return Boolean; - - function Mouse_Middle - return Boolean; - - function Mouse_Right - return Boolean; - - function Is_Inside - (X, Y, W, H : in Integer) - return Boolean; - - - - - function Last_Key - return Keypress; - - function Original_Last_Key - return Keypress; - - function Pressed_During - (Key : in Keypress) - return Boolean; - - function Key_Now - (Key : in Keypress) - return Boolean; - - function Key_Ctrl - return Boolean; - - function Key_Alt - return Boolean; - - function Key_Command - return Boolean; - - function Key_Shift - return Boolean; - - -private - - - package Widget_Convert is new System.Address_To_Access_Conversions - (FLTK.Widgets.Widget'Class); - package Window_Convert is new System.Address_To_Access_Conversions - (FLTK.Widgets.Groups.Windows.Window'Class); - - - package Handler_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, Element_Type => Event_Handler); - - - Handlers : Handler_Vectors.Vector := Handler_Vectors.Empty_Vector; - -- Current_Dispatch : Event_Dispatch := null; - - - function fl_widget_get_user_data - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - pragma Inline (fl_widget_get_user_data); - - - - - pragma Inline (Add_Handler); - pragma Inline (Remove_Handler); - -- pragma Inline (Get_Dispatch); - -- pragma Inline (Set_Dispatch); - -- pragma Inline (Default_Dispatch); - - - pragma Inline (Get_Grab); - pragma Inline (Set_Grab); - pragma Inline (Release_Grab); - pragma Inline (Get_Pushed); - pragma Inline (Set_Pushed); - pragma Inline (Get_Below_Mouse); - pragma Inline (Set_Below_Mouse); - pragma Inline (Get_Focus); - pragma Inline (Set_Focus); - - - pragma Inline (Compose); - pragma Inline (Compose_Reset); - pragma Inline (Text); - pragma Inline (Text_Length); - - - pragma Inline (Last); - pragma Inline (Last_Modifier); - - - pragma Inline (Mouse_X); - pragma Inline (Mouse_X_Root); - pragma Inline (Mouse_Y); - pragma Inline (Mouse_Y_Root); - pragma Inline (Mouse_DX); - pragma Inline (Mouse_DY); - pragma Inline (Get_Mouse); - pragma Inline (Is_Click); - pragma Inline (Is_Multi_Click); - pragma Inline (Set_Clicks); - pragma Inline (Last_Button); - pragma Inline (Mouse_Left); - pragma Inline (Mouse_Middle); - pragma Inline (Mouse_Right); - pragma Inline (Is_Inside); - - - pragma Inline (Last_Key); - pragma Inline (Original_Last_Key); - pragma Inline (Pressed_During); - pragma Inline (Key_Now); - pragma Inline (Key_Ctrl); - pragma Inline (Key_Alt); - pragma Inline (Key_Command); - pragma Inline (Key_Shift); - - -end FLTK.Event; - diff --git a/src/fltk-images-bitmaps-xbm.adb b/src/fltk-images-bitmaps-xbm.adb deleted file mode 100644 index d8059ff..0000000 --- a/src/fltk-images-bitmaps-xbm.adb +++ /dev/null @@ -1,76 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Bitmaps.XBM is - - - function new_fl_xbm_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_xbm_image, "new_fl_xbm_image"); - pragma Inline (new_fl_xbm_image); - - procedure free_fl_xbm_image - (P : in System.Address); - pragma Import (C, free_fl_xbm_image, "free_fl_xbm_image"); - pragma Inline (free_fl_xbm_image); - - - - - overriding procedure Finalize - (This : in out XBM_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in XBM_Image'Class - then - free_fl_xbm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Bitmap (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return XBM_Image is - begin - return This : XBM_Image do - This.Void_Ptr := new_fl_xbm_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => - -- raise No_Image_Error; - null; - -- Since the image depth and line data are both zero here, - -- the fail method will think there's no image even though - -- nothing is wrong. This is a bug in FLTK. - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.Bitmaps.XBM; - diff --git a/src/fltk-images-bitmaps-xbm.ads b/src/fltk-images-bitmaps-xbm.ads deleted file mode 100644 index f39589f..0000000 --- a/src/fltk-images-bitmaps-xbm.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -package FLTK.Images.Bitmaps.XBM is - - - ------------- - -- Types -- - ------------- - - type XBM_Image is new Bitmap with private; - - type XBM_Image_Reference (Data : not null access XBM_Image'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return XBM_Image; - - end Forge; - - -private - - - type XBM_Image is new Bitmap with null record; - - overriding procedure Finalize - (This : in out XBM_Image); - - -end FLTK.Images.Bitmaps.XBM; - diff --git a/src/fltk-images-bitmaps.adb b/src/fltk-images-bitmaps.adb deleted file mode 100644 index 3ddfa93..0000000 --- a/src/fltk-images-bitmaps.adb +++ /dev/null @@ -1,185 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Bitmaps is - - - function new_fl_bitmap - (D : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_bitmap, "new_fl_bitmap"); - pragma Inline (new_fl_bitmap); - - procedure free_fl_bitmap - (I : in System.Address); - pragma Import (C, free_fl_bitmap, "free_fl_bitmap"); - pragma Inline (free_fl_bitmap); - - function fl_bitmap_copy - (I : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_bitmap_copy, "fl_bitmap_copy"); - pragma Inline (fl_bitmap_copy); - - function fl_bitmap_copy2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_bitmap_copy2, "fl_bitmap_copy2"); - pragma Inline (fl_bitmap_copy2); - - - - - procedure fl_bitmap_uncache - (I : in System.Address); - pragma Import (C, fl_bitmap_uncache, "fl_bitmap_uncache"); - pragma Inline (fl_bitmap_uncache); - - - - - procedure fl_bitmap_draw2 - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_bitmap_draw2, "fl_bitmap_draw2"); - pragma Inline (fl_bitmap_draw2); - - procedure fl_bitmap_draw - (I : in System.Address; - X, Y, W, H, CX, CY : in Interfaces.C.int); - pragma Import (C, fl_bitmap_draw, "fl_bitmap_draw"); - pragma Inline (fl_bitmap_draw); - - - - - overriding procedure Finalize - (This : in out Bitmap) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Bitmap'Class - then - free_fl_bitmap (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Data : in Color_Component_Array; - Width, Height : in Natural) - return Bitmap is - begin - return This : Bitmap do - This.Void_Ptr := new_fl_bitmap - (Data (Data'First)'Address, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - case fl_image_fail (This.Void_Ptr) is - when 1 => - -- raise No_Image_Error; - null; - -- Since the image depth and line data are both zero here, - -- the fail method will think there's no image even though - -- nothing is wrong. This is a bug in FLTK. - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - - function Copy - (This : in Bitmap; - Width, Height : in Natural) - return Bitmap'Class is - begin - return Copied : Bitmap do - Copied.Void_Ptr := fl_bitmap_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - end return; - end Copy; - - - function Copy - (This : in Bitmap) - return Bitmap'Class is - begin - return Copied : Bitmap do - Copied.Void_Ptr := fl_bitmap_copy2 (This.Void_Ptr); - end return; - end Copy; - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out Bitmap) is - begin - fl_bitmap_uncache (This.Void_Ptr); - end Uncache; - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Bitmap; - X, Y : in Integer) is - begin - fl_bitmap_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - - procedure Draw - (This : in Bitmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is - begin - fl_bitmap_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - -end FLTK.Images.Bitmaps; - diff --git a/src/fltk-images-bitmaps.ads b/src/fltk-images-bitmaps.ads deleted file mode 100644 index cf35396..0000000 --- a/src/fltk-images-bitmaps.ads +++ /dev/null @@ -1,85 +0,0 @@ - - -package FLTK.Images.Bitmaps is - - - ------------- - -- Types -- - ------------- - - type Bitmap is new Image with private; - - type Bitmap_Reference (Data : not null access Bitmap'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - -- Please note that I'm pretty sure (?) input data here should be some - -- declared item that lives at least as long as the resulting Bitmap - - function Create - (Data : in Color_Component_Array; - Width, Height : in Natural) - return Bitmap; - - end Forge; - - function Copy - (This : in Bitmap; - Width, Height : in Natural) - return Bitmap'Class; - - function Copy - (This : in Bitmap) - return Bitmap'Class; - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out Bitmap); - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Bitmap; - X, Y : in Integer); - - procedure Draw - (This : in Bitmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); - - -private - - - type Bitmap is new Image with null record; - - overriding procedure Finalize - (This : in out Bitmap); - - - pragma Inline (Copy); - pragma Inline (Uncache); - pragma Inline (Draw); - - -end FLTK.Images.Bitmaps; - diff --git a/src/fltk-images-pixmaps-gif.adb b/src/fltk-images-pixmaps-gif.adb deleted file mode 100644 index 546ed3e..0000000 --- a/src/fltk-images-pixmaps-gif.adb +++ /dev/null @@ -1,71 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Pixmaps.GIF is - - - function new_fl_gif_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_gif_image, "new_fl_gif_image"); - pragma Inline (new_fl_gif_image); - - procedure free_fl_gif_image - (P : in System.Address); - pragma Import (C, free_fl_gif_image, "free_fl_gif_image"); - pragma Inline (free_fl_gif_image); - - - - - overriding procedure Finalize - (This : in out GIF_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in GIF_Image'Class - then - free_fl_gif_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Pixmap (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return GIF_Image is - begin - return This : GIF_Image do - This.Void_Ptr := new_fl_gif_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.Pixmaps.GIF; - diff --git a/src/fltk-images-pixmaps-gif.ads b/src/fltk-images-pixmaps-gif.ads deleted file mode 100644 index 4936617..0000000 --- a/src/fltk-images-pixmaps-gif.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -package FLTK.Images.Pixmaps.GIF is - - - ------------- - -- Types -- - ------------- - - type GIF_Image is new Pixmap with private; - - type GIF_Image_Reference (Data : not null access GIF_Image'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return GIF_Image; - - end Forge; - - -private - - - type GIF_Image is new Pixmap with null record; - - overriding procedure Finalize - (This : in out GIF_Image); - - -end FLTK.Images.Pixmaps.GIF; - diff --git a/src/fltk-images-pixmaps-xpm.adb b/src/fltk-images-pixmaps-xpm.adb deleted file mode 100644 index 136aee9..0000000 --- a/src/fltk-images-pixmaps-xpm.adb +++ /dev/null @@ -1,71 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Pixmaps.XPM is - - - function new_fl_xpm_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_xpm_image, "new_fl_xpm_image"); - pragma Inline (new_fl_xpm_image); - - procedure free_fl_xpm_image - (P : in System.Address); - pragma Import (C, free_fl_xpm_image, "free_fl_xpm_image"); - pragma Inline (free_fl_xpm_image); - - - - - overriding procedure Finalize - (This : in out XPM_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in XPM_Image'Class - then - free_fl_xpm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Pixmap (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return XPM_Image is - begin - return This : XPM_Image do - This.Void_Ptr := new_fl_xpm_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.Pixmaps.XPM; - diff --git a/src/fltk-images-pixmaps-xpm.ads b/src/fltk-images-pixmaps-xpm.ads deleted file mode 100644 index 004e2a4..0000000 --- a/src/fltk-images-pixmaps-xpm.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -package FLTK.Images.Pixmaps.XPM is - - - ------------- - -- Types -- - ------------- - - type XPM_Image is new Pixmap with private; - - type XPM_Image_Reference (Data : not null access XPM_Image'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return XPM_Image; - - end Forge; - - -private - - - type XPM_Image is new Pixmap with null record; - - overriding procedure Finalize - (This : in out XPM_Image); - - -end FLTK.Images.Pixmaps.XPM; - diff --git a/src/fltk-images-pixmaps.adb b/src/fltk-images-pixmaps.adb deleted file mode 100644 index c8db506..0000000 --- a/src/fltk-images-pixmaps.adb +++ /dev/null @@ -1,190 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Pixmaps is - - - procedure free_fl_pixmap - (I : in System.Address); - pragma Import (C, free_fl_pixmap, "free_fl_pixmap"); - pragma Inline (free_fl_pixmap); - - function fl_pixmap_copy - (I : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy"); - pragma Inline (fl_pixmap_copy); - - function fl_pixmap_copy2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2"); - pragma Inline (fl_pixmap_copy2); - - - - - procedure fl_pixmap_color_average - (I : in System.Address; - C : in Interfaces.C.int; - B : in Interfaces.C.C_float); - pragma Import (C, fl_pixmap_color_average, "fl_pixmap_color_average"); - pragma Inline (fl_pixmap_color_average); - - procedure fl_pixmap_desaturate - (I : in System.Address); - pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate"); - pragma Inline (fl_pixmap_desaturate); - - - - - procedure fl_pixmap_uncache - (I : in System.Address); - pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache"); - pragma Inline (fl_pixmap_uncache); - - - - - procedure fl_pixmap_draw2 - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_pixmap_draw2, "fl_pixmap_draw2"); - pragma Inline (fl_pixmap_draw2); - - procedure fl_pixmap_draw - (I : in System.Address; - X, Y, W, H, CX, CY : in Interfaces.C.int); - pragma Import (C, fl_pixmap_draw, "fl_pixmap_draw"); - pragma Inline (fl_pixmap_draw); - - - - - overriding procedure Finalize - (This : in out Pixmap) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Pixmap'Class - then - free_fl_pixmap (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - function Copy - (This : in Pixmap; - Width, Height : in Natural) - return Pixmap'Class is - begin - return Copied : Pixmap do - Copied.Void_Ptr := fl_pixmap_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - end return; - end Copy; - - - function Copy - (This : in Pixmap) - return Pixmap'Class is - begin - return Copied : Pixmap do - Copied.Void_Ptr := fl_pixmap_copy2 (This.Void_Ptr); - end return; - end Copy; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Pixmap; - Col : in Color; - Amount : in Blend) is - begin - fl_pixmap_color_average - (This.Void_Ptr, - Interfaces.C.int (Col), - Interfaces.C.C_float (Amount)); - end Color_Average; - - - procedure Desaturate - (This : in out Pixmap) is - begin - fl_pixmap_desaturate (This.Void_Ptr); - end Desaturate; - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out Pixmap) is - begin - fl_pixmap_uncache (This.Void_Ptr); - end Uncache; - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Pixmap; - X, Y : in Integer) is - begin - fl_pixmap_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - - procedure Draw - (This : in Pixmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is - begin - fl_pixmap_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - -end FLTK.Images.Pixmaps; - diff --git a/src/fltk-images-pixmaps.ads b/src/fltk-images-pixmaps.ads deleted file mode 100644 index a935e72..0000000 --- a/src/fltk-images-pixmaps.ads +++ /dev/null @@ -1,94 +0,0 @@ - - -package FLTK.Images.Pixmaps is - - - ------------- - -- Types -- - ------------- - - type Pixmap is new Image with private; - - type Pixmap_Reference (Data : not null access Pixmap'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - function Copy - (This : in Pixmap; - Width, Height : in Natural) - return Pixmap'Class; - - function Copy - (This : in Pixmap) - return Pixmap'Class; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Pixmap; - Col : in Color; - Amount : in Blend); - - procedure Desaturate - (This : in out Pixmap); - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out Pixmap); - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Pixmap; - X, Y : in Integer); - - procedure Draw - (This : in Pixmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); - - -private - - - type Pixmap is new Image with null record; - - overriding procedure Finalize - (This : in out Pixmap); - - - pragma Inline (Color_Average); - pragma Inline (Desaturate); - - - pragma Inline (Uncache); - - - pragma Inline (Copy); - pragma Inline (Draw); - - -end FLTK.Images.Pixmaps; - diff --git a/src/fltk-images-rgb-bmp.adb b/src/fltk-images-rgb-bmp.adb deleted file mode 100644 index 6a982d0..0000000 --- a/src/fltk-images-rgb-bmp.adb +++ /dev/null @@ -1,71 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.RGB.BMP is - - - function new_fl_bmp_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_bmp_image, "new_fl_bmp_image"); - pragma Inline (new_fl_bmp_image); - - procedure free_fl_bmp_image - (P : in System.Address); - pragma Import (C, free_fl_bmp_image, "free_fl_bmp_image"); - pragma Inline (free_fl_bmp_image); - - - - - overriding procedure Finalize - (This : in out BMP_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in BMP_Image'Class - then - free_fl_bmp_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (RGB_Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return BMP_Image is - begin - return This : BMP_Image do - This.Void_Ptr := new_fl_bmp_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.RGB.BMP; - diff --git a/src/fltk-images-rgb-bmp.ads b/src/fltk-images-rgb-bmp.ads deleted file mode 100644 index dbbeea1..0000000 --- a/src/fltk-images-rgb-bmp.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -package FLTK.Images.RGB.BMP is - - - ------------- - -- Types -- - ------------- - - type BMP_Image is new RGB_Image with private; - - type BMP_Image_Reference (Data : not null access BMP_Image'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return BMP_Image; - - end Forge; - - -private - - - type BMP_Image is new RGB_Image with null record; - - overriding procedure Finalize - (This : in out BMP_Image); - - -end FLTK.Images.RGB.BMP; - diff --git a/src/fltk-images-rgb-jpeg.adb b/src/fltk-images-rgb-jpeg.adb deleted file mode 100644 index 9d7afe1..0000000 --- a/src/fltk-images-rgb-jpeg.adb +++ /dev/null @@ -1,96 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.RGB.JPEG is - - - function new_fl_jpeg_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_jpeg_image, "new_fl_jpeg_image"); - pragma Inline (new_fl_jpeg_image); - - function new_fl_jpeg_image2 - (N : in Interfaces.C.char_array; - D : in System.Address) - return System.Address; - pragma Import (C, new_fl_jpeg_image2, "new_fl_jpeg_image2"); - pragma Inline (new_fl_jpeg_image2); - - procedure free_fl_jpeg_image - (P : in System.Address); - pragma Import (C, free_fl_jpeg_image, "free_fl_jpeg_image"); - pragma Inline (free_fl_jpeg_image); - - - - - overriding procedure Finalize - (This : in out JPEG_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in JPEG_Image'Class - then - free_fl_jpeg_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (RGB_Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return JPEG_Image is - begin - return This : JPEG_Image do - This.Void_Ptr := new_fl_jpeg_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - function Create - (Name : in String := ""; - Data : in Color_Component_Array) - return JPEG_Image is - begin - return This : JPEG_Image do - This.Void_Ptr := new_fl_jpeg_image2 - (Interfaces.C.To_C (Name), - Data (Data'First)'Address); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.RGB.JPEG; - diff --git a/src/fltk-images-rgb-jpeg.ads b/src/fltk-images-rgb-jpeg.ads deleted file mode 100644 index 742ae4e..0000000 --- a/src/fltk-images-rgb-jpeg.ads +++ /dev/null @@ -1,46 +0,0 @@ - - -package FLTK.Images.RGB.JPEG is - - - ------------- - -- Types -- - ------------- - - type JPEG_Image is new RGB_Image with private; - - type JPEG_Image_Reference (Data : not null access JPEG_Image'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return JPEG_Image; - - function Create - (Name : in String := ""; - Data : in Color_Component_Array) - return JPEG_Image; - - end Forge; - - -private - - - type JPEG_Image is new RGB_Image with null record; - - overriding procedure Finalize - (This : in out JPEG_Image); - - -end FLTK.Images.RGB.JPEG; - diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb deleted file mode 100644 index 6023f82..0000000 --- a/src/fltk-images-rgb-png.adb +++ /dev/null @@ -1,98 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.RGB.PNG is - - - function new_fl_png_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_png_image, "new_fl_png_image"); - pragma Inline (new_fl_png_image); - - function new_fl_png_image2 - (N : in Interfaces.C.char_array; - D : in System.Address; - S : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_png_image2, "new_fl_png_image2"); - pragma Inline (new_fl_png_image2); - - procedure free_fl_png_image - (P : in System.Address); - pragma Import (C, free_fl_png_image, "free_fl_png_image"); - pragma Inline (free_fl_png_image); - - - - - overriding procedure Finalize - (This : in out PNG_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in PNG_Image'Class - then - free_fl_png_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (RGB_Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return PNG_Image is - begin - return This : PNG_Image do - This.Void_Ptr := new_fl_png_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - function Create - (Name : in String := ""; - Data : in Color_Component_Array) - return PNG_Image is - begin - return This : PNG_Image do - This.Void_Ptr := new_fl_png_image2 - (Interfaces.C.To_C (Name), - Data (Data'First)'Address, - Data'Length); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.RGB.PNG; - diff --git a/src/fltk-images-rgb-png.ads b/src/fltk-images-rgb-png.ads deleted file mode 100644 index a4c270a..0000000 --- a/src/fltk-images-rgb-png.ads +++ /dev/null @@ -1,46 +0,0 @@ - - -package FLTK.Images.RGB.PNG is - - - ------------- - -- Types -- - ------------- - - type PNG_Image is new RGB_Image with private; - - type PNG_Image_Reference (Data : not null access PNG_Image'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return PNG_Image; - - function Create - (Name : in String := ""; - Data : in Color_Component_Array) - return PNG_Image; - - end Forge; - - -private - - - type PNG_Image is new RGB_Image with null record; - - overriding procedure Finalize - (This : in out PNG_Image); - - -end FLTK.Images.RGB.PNG; - diff --git a/src/fltk-images-rgb-pnm.adb b/src/fltk-images-rgb-pnm.adb deleted file mode 100644 index 6b0e515..0000000 --- a/src/fltk-images-rgb-pnm.adb +++ /dev/null @@ -1,71 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.RGB.PNM is - - - function new_fl_pnm_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_pnm_image, "new_fl_pnm_image"); - pragma Inline (new_fl_pnm_image); - - procedure free_fl_pnm_image - (P : in System.Address); - pragma Import (C, free_fl_pnm_image, "free_fl_pnm_image"); - pragma Inline (free_fl_pnm_image); - - - - - overriding procedure Finalize - (This : in out PNM_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in PNM_Image'Class - then - free_fl_pnm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (RGB_Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String) - return PNM_Image is - begin - return This : PNM_Image do - This.Void_Ptr := new_fl_pnm_image - (Interfaces.C.To_C (Filename)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - -end FLTK.Images.RGB.PNM; - diff --git a/src/fltk-images-rgb-pnm.ads b/src/fltk-images-rgb-pnm.ads deleted file mode 100644 index f895d73..0000000 --- a/src/fltk-images-rgb-pnm.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -package FLTK.Images.RGB.PNM is - - - ------------- - -- Types -- - ------------- - - type PNM_Image is new RGB_Image with private; - - type PNM_Image_Reference (Data : not null access PNM_Image'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String) - return PNM_Image; - - end Forge; - - -private - - - type PNM_Image is new RGB_Image with null record; - - overriding procedure Finalize - (This : in out PNM_Image); - - -end FLTK.Images.RGB.PNM; - diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb deleted file mode 100644 index 4382e93..0000000 --- a/src/fltk-images-rgb.adb +++ /dev/null @@ -1,274 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.RGB is - - - function new_fl_rgb_image - (Data : in System.Address; - W, H, D, L : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_rgb_image, "new_fl_rgb_image"); - pragma Inline (new_fl_rgb_image); - - function new_fl_rgb_image2 - (P : in System.Address; - C : in Interfaces.C.unsigned) - return System.Address; - pragma Import (C, new_fl_rgb_image2, "new_fl_rgb_image2"); - pragma Inline (new_fl_rgb_image2); - - procedure free_fl_rgb_image - (I : in System.Address); - pragma Import (C, free_fl_rgb_image, "free_fl_rgb_image"); - pragma Inline (free_fl_rgb_image); - - function fl_rgb_image_get_max_size - return Interfaces.C.size_t; - pragma Import (C, fl_rgb_image_get_max_size, "fl_rgb_image_get_max_size"); - pragma Inline (fl_rgb_image_get_max_size); - - procedure fl_rgb_image_set_max_size - (V : in Interfaces.C.size_t); - pragma Import (C, fl_rgb_image_set_max_size, "fl_rgb_image_set_max_size"); - pragma Inline (fl_rgb_image_set_max_size); - - function fl_rgb_image_copy - (I : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_rgb_image_copy, "fl_rgb_image_copy"); - pragma Inline (fl_rgb_image_copy); - - function fl_rgb_image_copy2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_rgb_image_copy2, "fl_rgb_image_copy2"); - pragma Inline (fl_rgb_image_copy2); - - - - - procedure fl_rgb_image_color_average - (I : in System.Address; - C : in Interfaces.C.int; - B : in Interfaces.C.C_float); - pragma Import (C, fl_rgb_image_color_average, "fl_rgb_image_color_average"); - pragma Inline (fl_rgb_image_color_average); - - procedure fl_rgb_image_desaturate - (I : in System.Address); - pragma Import (C, fl_rgb_image_desaturate, "fl_rgb_image_desaturate"); - pragma Inline (fl_rgb_image_desaturate); - - - - - procedure fl_rgb_image_uncache - (I : in System.Address); - pragma Import (C, fl_rgb_image_uncache, "fl_rgb_image_uncache"); - pragma Inline (fl_rgb_image_uncache); - - - - - procedure fl_rgb_image_draw2 - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_rgb_image_draw2, "fl_rgb_image_draw2"); - pragma Inline (fl_rgb_image_draw2); - - procedure fl_rgb_image_draw - (I : in System.Address; - X, Y, W, H, CX, CY : in Interfaces.C.int); - pragma Import (C, fl_rgb_image_draw, "fl_rgb_image_draw"); - pragma Inline (fl_rgb_image_draw); - - - - - overriding procedure Finalize - (This : in out RGB_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in RGB_Image'Class - then - free_fl_rgb_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Data : in Color_Component_Array; - Width, Height : in Natural; - Depth : in Natural := 3; - Line_Data : in Natural := 0) - return RGB_Image is - begin - return This : RGB_Image do - This.Void_Ptr := new_fl_rgb_image - (Data (Data'First)'Address, - Interfaces.C.int (Width), - Interfaces.C.int (Height), - Interfaces.C.int (Depth), - Interfaces.C.int (Line_Data)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - function Create - (Data : in FLTK.Images.Pixmaps.Pixmap'Class; - Background : in Color := Background_Color) - return RGB_Image is - begin - return This : RGB_Image do - This.Void_Ptr := new_fl_rgb_image2 - (Wrapper (Data).Void_Ptr, - Interfaces.C.unsigned (Background)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - - function Get_Max_Size - return Natural is - begin - return Natural (fl_rgb_image_get_max_size); - end Get_Max_Size; - - - procedure Set_Max_Size - (Value : in Natural) is - begin - fl_rgb_image_set_max_size (Interfaces.C.size_t (Value)); - end Set_Max_Size; - - - function Copy - (This : in RGB_Image; - Width, Height : in Natural) - return RGB_Image'Class is - begin - return Copied : RGB_Image do - Copied.Void_Ptr := fl_rgb_image_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - end return; - end Copy; - - - function Copy - (This : in RGB_Image) - return RGB_Image'Class is - begin - return Copied : RGB_Image do - Copied.Void_Ptr := fl_rgb_image_copy2 (This.Void_Ptr); - end return; - end Copy; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out RGB_Image; - Col : in Color; - Amount : in Blend) is - begin - fl_rgb_image_color_average - (This.Void_Ptr, - Interfaces.C.int (Col), - Interfaces.C.C_float (Amount)); - end Color_Average; - - - procedure Desaturate - (This : in out RGB_Image) is - begin - fl_rgb_image_desaturate (This.Void_Ptr); - end Desaturate; - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out RGB_Image) is - begin - fl_rgb_image_uncache (This.Void_Ptr); - end Uncache; - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in RGB_Image; - X, Y : in Integer) is - begin - fl_rgb_image_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - - procedure Draw - (This : in RGB_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is - begin - fl_rgb_image_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - -end FLTK.Images.RGB; - diff --git a/src/fltk-images-rgb.ads b/src/fltk-images-rgb.ads deleted file mode 100644 index 67518c3..0000000 --- a/src/fltk-images-rgb.ads +++ /dev/null @@ -1,125 +0,0 @@ - - -with - - FLTK.Images.Pixmaps; - - -package FLTK.Images.RGB is - - - ------------- - -- Types -- - ------------- - - type RGB_Image is new Image with private; - - type RGB_Image_Reference (Data : not null access RGB_Image'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Data : in Color_Component_Array; - Width, Height : in Natural; - Depth : in Natural := 3; - Line_Data : in Natural := 0) - return RGB_Image; - - function Create - (Data : in FLTK.Images.Pixmaps.Pixmap'Class; - Background : in Color := Background_Color) - return RGB_Image; - - end Forge; - - function Get_Max_Size - return Natural; - - procedure Set_Max_Size - (Value : in Natural); - - function Copy - (This : in RGB_Image; - Width, Height : in Natural) - return RGB_Image'Class; - - function Copy - (This : in RGB_Image) - return RGB_Image'Class; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out RGB_Image; - Col : in Color; - Amount : in Blend); - - procedure Desaturate - (This : in out RGB_Image); - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Uncache - (This : in out RGB_Image); - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in RGB_Image; - X, Y : in Integer); - - procedure Draw - (This : in RGB_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); - - -private - - - type RGB_Image is new Image with null record; - - overriding procedure Finalize - (This : in out RGB_Image); - - - pragma Inline (Get_Max_Size); - pragma Inline (Set_Max_Size); - pragma Inline (Copy); - - - pragma Inline (Color_Average); - pragma Inline (Desaturate); - - - pragma Inline (Uncache); - - - pragma Inline (Draw); - - -end FLTK.Images.RGB; - diff --git a/src/fltk-images-shared.adb b/src/fltk-images-shared.adb deleted file mode 100644 index 24bc014..0000000 --- a/src/fltk-images-shared.adb +++ /dev/null @@ -1,362 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Images.Shared is - - - function fl_shared_image_get - (F : in Interfaces.C.char_array; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_shared_image_get, "fl_shared_image_get"); - pragma Inline (fl_shared_image_get); - - function fl_shared_image_get2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_shared_image_get2, "fl_shared_image_get2"); - pragma Inline (fl_shared_image_get2); - - function fl_shared_image_find - (N : in Interfaces.C.char_array; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_shared_image_find, "fl_shared_image_find"); - pragma Inline (fl_shared_image_find); - - procedure fl_shared_image_release - (I : in System.Address); - pragma Import (C, fl_shared_image_release, "fl_shared_image_release"); - pragma Inline (fl_shared_image_release); - - function fl_shared_image_copy - (I : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_shared_image_copy, "fl_shared_image_copy"); - pragma Inline (fl_shared_image_copy); - - function fl_shared_image_copy2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_shared_image_copy2, "fl_shared_image_copy2"); - pragma Inline (fl_shared_image_copy2); - - - - - procedure fl_shared_image_color_average - (I : in System.Address; - C : in Interfaces.C.int; - B : in Interfaces.C.C_float); - pragma Import (C, fl_shared_image_color_average, "fl_shared_image_color_average"); - pragma Inline (fl_shared_image_color_average); - - procedure fl_shared_image_desaturate - (I : in System.Address); - pragma Import (C, fl_shared_image_desaturate, "fl_shared_image_desaturate"); - pragma Inline (fl_shared_image_desaturate); - - - - - function fl_shared_image_num_images - return Interfaces.C.int; - pragma Import (C, fl_shared_image_num_images, "fl_shared_image_num_images"); - pragma Inline (fl_shared_image_num_images); - - function fl_shared_image_name - (I : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_shared_image_name, "fl_shared_image_name"); - pragma Inline (fl_shared_image_name); - - function fl_shared_image_original - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_shared_image_original, "fl_shared_image_original"); - pragma Inline (fl_shared_image_original); - - function fl_shared_image_refcount - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_shared_image_refcount, "fl_shared_image_refcount"); - pragma Inline (fl_shared_image_refcount); - - procedure fl_shared_image_reload - (I : in System.Address); - pragma Import (C, fl_shared_image_reload, "fl_shared_image_reload"); - pragma Inline (fl_shared_image_reload); - - procedure fl_shared_image_uncache - (I : in System.Address); - pragma Import (C, fl_shared_image_uncache, "fl_shared_image_uncache"); - pragma Inline (fl_shared_image_uncache); - - - - - procedure fl_shared_image_scaling_algorithm - (A : in Interfaces.C.int); - pragma Import (C, fl_shared_image_scaling_algorithm, "fl_shared_image_scaling_algorithm"); - pragma Inline (fl_shared_image_scaling_algorithm); - - procedure fl_shared_image_scale - (I : in System.Address; - W, H, P, E : in Interfaces.C.int); - pragma Import (C, fl_shared_image_scale, "fl_shared_image_scale"); - pragma Inline (fl_shared_image_scale); - - procedure fl_shared_image_draw - (I : in System.Address; - X, Y, W, H, CX, CY : in Interfaces.C.int); - pragma Import (C, fl_shared_image_draw, "fl_shared_image_draw"); - pragma Inline (fl_shared_image_draw); - - procedure fl_shared_image_draw2 - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_shared_image_draw2, "fl_shared_image_draw2"); - pragma Inline (fl_shared_image_draw2); - - - - - overriding procedure Finalize - (This : in out Shared_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Shared_Image'Class - then - fl_shared_image_release (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Filename : in String; - W, H : in Integer) - return Shared_Image is - begin - return This : Shared_Image do - This.Void_Ptr := fl_shared_image_get - (Interfaces.C.To_C (Filename), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end return; - end Create; - - - function Create - (From : in FLTK.Images.RGB.RGB_Image'Class) - return Shared_Image is - begin - return This : Shared_Image do - This.Void_Ptr := fl_shared_image_get2 (Wrapper (From).Void_Ptr); - end return; - end Create; - - - function Find - (Name : in String; - W, H : in Integer := 0) - return Shared_Image is - begin - return This : Shared_Image do - This.Void_Ptr := fl_shared_image_find - (Interfaces.C.To_C (Name), - Interfaces.C.int (W), - Interfaces.C.int (H)); - if This.Void_Ptr = System.Null_Address then - raise No_Image_Error; - end if; - end return; - end Find; - - end Forge; - - - function Copy - (This : in Shared_Image; - Width, Height : in Natural) - return Shared_Image'Class is - begin - return Copied : Shared_Image do - Copied.Void_Ptr := fl_shared_image_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - end return; - end Copy; - - - function Copy - (This : in Shared_Image) - return Shared_Image'Class is - begin - return Copied : Shared_Image do - Copied.Void_Ptr := fl_shared_image_copy2 (This.Void_Ptr); - end return; - end Copy; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Shared_Image; - Col : in Color; - Amount : in Blend) is - begin - fl_shared_image_color_average - (This.Void_Ptr, - Interfaces.C.int (Col), - Interfaces.C.C_float (Amount)); - end Color_Average; - - - procedure Desaturate - (This : in out Shared_Image) is - begin - fl_shared_image_desaturate (This.Void_Ptr); - end Desaturate; - - - - - ---------------- - -- Activity -- - ---------------- - - function Number_Of_Images - return Natural is - begin - return Natural (fl_shared_image_num_images); - end Number_Of_Images; - - - function Name - (This : in Shared_Image) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Ptr); - end if; - end Name; - - - function Original - (This : in Shared_Image) - return Boolean is - begin - return fl_shared_image_original (This.Void_Ptr) /= 0; - end Original; - - - function Reference_Count - (This : in Shared_Image) - return Natural is - begin - return Natural (fl_shared_image_refcount (This.Void_Ptr)); - end Reference_Count; - - - procedure Reload - (This : in out Shared_Image) is - begin - fl_shared_image_reload (This.Void_Ptr); - end Reload; - - - procedure Uncache - (This : in out Shared_Image) is - begin - fl_shared_image_uncache (This.Void_Ptr); - end Uncache; - - - - - --------------- - -- Drawing -- - --------------- - - procedure Set_Scaling_Algorithm - (To : in Scaling_Kind) is - begin - fl_shared_image_scaling_algorithm (Scaling_Kind'Pos (To)); - end Set_Scaling_Algorithm; - - - procedure Scale - (This : in out Shared_Image; - W, H : in Integer; - Proportional : in Boolean := True; - Can_Expand : in Boolean := False) is - begin - fl_shared_image_scale - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H), - Boolean'Pos (Proportional), - Boolean'Pos (Can_Expand)); - end Scale; - - - procedure Draw - (This : in Shared_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is - begin - fl_shared_image_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - - procedure Draw - (This : in Shared_Image; - X, Y : in Integer) is - begin - fl_shared_image_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - -end FLTK.Images.Shared; - diff --git a/src/fltk-images-shared.ads b/src/fltk-images-shared.ads deleted file mode 100644 index ff12457..0000000 --- a/src/fltk-images-shared.ads +++ /dev/null @@ -1,153 +0,0 @@ - - -with - - FLTK.Images.RGB; - - -package FLTK.Images.Shared is - - - ------------- - -- Types -- - ------------- - - type Shared_Image is new Image with private; - - type Shared_Image_Reference (Data : not null access Shared_Image'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Filename : in String; - W, H : in Integer) - return Shared_Image; - - function Create - (From : in FLTK.Images.RGB.RGB_Image'Class) - return Shared_Image; - - function Find - (Name : in String; - W, H : in Integer := 0) - return Shared_Image; - - end Forge; - - function Copy - (This : in Shared_Image; - Width, Height : in Natural) - return Shared_Image'Class; - - function Copy - (This : in Shared_Image) - return Shared_Image'Class; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Shared_Image; - Col : in Color; - Amount : in Blend); - - procedure Desaturate - (This : in out Shared_Image); - - - - - ---------------- - -- Activity -- - ---------------- - - function Number_Of_Images - return Natural; - - function Name - (This : in Shared_Image) - return String; - - function Original - (This : in Shared_Image) - return Boolean; - - function Reference_Count - (This : in Shared_Image) - return Natural; - - procedure Reload - (This : in out Shared_Image); - - procedure Uncache - (This : in out Shared_Image); - - - - - --------------- - -- Drawing -- - --------------- - - procedure Set_Scaling_Algorithm - (To : in Scaling_Kind); - - procedure Scale - (This : in out Shared_Image; - W, H : in Integer; - Proportional : in Boolean := True; - Can_Expand : in Boolean := False); - - procedure Draw - (This : in Shared_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); - - procedure Draw - (This : in Shared_Image; - X, Y : in Integer); - - -private - - - type Shared_Image is new Image with null record; - - overriding procedure Finalize - (This : in out Shared_Image); - - - pragma Inline (Copy); - - - pragma Inline (Color_Average); - pragma Inline (Desaturate); - - - pragma Inline (Number_Of_Images); - pragma Inline (Name); - pragma Inline (Original); - pragma Inline (Reference_Count); - pragma Inline (Reload); - pragma Inline (Uncache); - - - pragma Inline (Set_Scaling_Algorithm); - pragma Inline (Scale); - pragma Inline (Draw); - - -end FLTK.Images.Shared; - diff --git a/src/fltk-images-tiled.adb b/src/fltk-images-tiled.adb deleted file mode 100644 index fd4b9ed..0000000 --- a/src/fltk-images-tiled.adb +++ /dev/null @@ -1,233 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Images.Tiled is - - - function new_fl_tiled_image - (T : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_tiled_image, "new_fl_tiled_image"); - pragma Inline (new_fl_tiled_image); - - procedure free_fl_tiled_image - (T : in System.Address); - pragma Import (C, free_fl_tiled_image, "free_fl_tiled_image"); - pragma Inline (free_fl_tiled_image); - - function fl_tiled_image_copy - (T : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_tiled_image_copy, "fl_tiled_image_copy"); - pragma Inline (fl_tiled_image_copy); - - function fl_tiled_image_copy2 - (T : in System.Address) - return System.Address; - pragma Import (C, fl_tiled_image_copy2, "fl_tiled_image_copy2"); - pragma Inline (fl_tiled_image_copy2); - - - - - function fl_tiled_image_get_image - (T : in System.Address) - return System.Address; - pragma Import (C, fl_tiled_image_get_image, "fl_tiled_image_get_image"); - pragma Inline (fl_tiled_image_get_image); - - - - - procedure fl_tiled_image_color_average - (T : in System.Address; - C : in Interfaces.C.int; - B : in Interfaces.C.C_float); - pragma Import (C, fl_tiled_image_color_average, "fl_tiled_image_color_average"); - pragma Inline (fl_tiled_image_color_average); - - procedure fl_tiled_image_desaturate - (T : in System.Address); - pragma Import (C, fl_tiled_image_desaturate, "fl_tiled_image_desaturate"); - pragma Inline (fl_tiled_image_desaturate); - - - - - procedure fl_tiled_image_draw - (T : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_tiled_image_draw, "fl_tiled_image_draw"); - pragma Inline (fl_tiled_image_draw); - - procedure fl_tiled_image_draw2 - (T : in System.Address; - X, Y, W, H : in Interfaces.C.int; - CX, CY : in Interfaces.C.int); - pragma Import (C, fl_tiled_image_draw2, "fl_tiled_image_draw2"); - pragma Inline (fl_tiled_image_draw2); - - - - - overriding procedure Finalize - (This : in out Tiled_Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Tiled_Image'Class - then - free_fl_tiled_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Image (This)); - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (From : in out Image'Class; - W, H : in Integer := 0) - return Tiled_Image is - begin - return This : Tiled_Image do - This.Void_Ptr := new_fl_tiled_image - (From.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr); - This.Dummy.Needs_Dealloc := False; - end return; - end Create; - - end Forge; - - - function Copy - (This : in Tiled_Image; - Width, Height : in Natural) - return Tiled_Image'Class is - begin - return Copied : Tiled_Image do - Copied.Void_Ptr := fl_tiled_image_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr); - Copied.Dummy.Needs_Dealloc := False; - end return; - end Copy; - - - function Copy - (This : in Tiled_Image) - return Tiled_Image'Class is - begin - return Copied : Tiled_Image do - Copied.Void_Ptr := fl_tiled_image_copy2 (This.Void_Ptr); - Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr); - Copied.Dummy.Needs_Dealloc := False; - end return; - end Copy; - - - - - --------------------- - -- Miscellaneous -- - --------------------- - - procedure Inactive - (This : in out Tiled_Image) is - begin - This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr); - This.Dummy.Needs_Dealloc := False; - Image (This).Inactive; - end Inactive; - - - function Tile - (This : in out Tiled_Image) - return Image_Reference is - begin - return (Data => This.Dummy'Unchecked_Access); - end Tile; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Tiled_Image; - Hue : in Color; - Amount : in Blend) is - begin - This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr); - This.Dummy.Needs_Dealloc := False; - fl_tiled_image_color_average - (This.Void_Ptr, - Interfaces.C.int (Hue), - Interfaces.C.C_float (Amount)); - end Color_Average; - - - procedure Desaturate - (This : in out Tiled_Image) is - begin - This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr); - This.Dummy.Needs_Dealloc := False; - fl_tiled_image_desaturate (This.Void_Ptr); - end Desaturate; - - - - - procedure Draw - (This : in Tiled_Image; - X, Y : in Integer) is - begin - fl_tiled_image_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - - procedure Draw - (This : in Tiled_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer) is - begin - fl_tiled_image_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - -end FLTK.Images.Tiled; - diff --git a/src/fltk-images-tiled.ads b/src/fltk-images-tiled.ads deleted file mode 100644 index cf3ee13..0000000 --- a/src/fltk-images-tiled.ads +++ /dev/null @@ -1,112 +0,0 @@ - - -package FLTK.Images.Tiled is - - - ------------- - -- Types -- - ------------- - - type Tiled_Image is new Image with private; - - type Tiled_Image_Reference (Data : not null access Tiled_Image'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (From : in out Image'Class; - W, H : in Integer := 0) - return Tiled_Image; - - end Forge; - - function Copy - (This : in Tiled_Image; - Width, Height : in Natural) - return Tiled_Image'Class; - - function Copy - (This : in Tiled_Image) - return Tiled_Image'Class; - - - - - --------------------- - -- Miscellaneous -- - --------------------- - - procedure Inactive - (This : in out Tiled_Image); - - function Tile - (This : in out Tiled_Image) - return Image_Reference; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Tiled_Image; - Hue : in Color; - Amount : in Blend); - - procedure Desaturate - (This : in out Tiled_Image); - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Tiled_Image; - X, Y : in Integer); - - procedure Draw - (This : in Tiled_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer); - - -private - - - type Tiled_Image is new Image with record - Dummy : aliased Image; - end record; - - overriding procedure Finalize - (This : in out Tiled_Image); - - - pragma Inline (Copy); - - - pragma Inline (Inactive); - pragma Inline (Tile); - - - pragma Inline (Color_Average); - pragma Inline (Desaturate); - - - pragma Inline (Draw); - - -end FLTK.Images.Tiled; - diff --git a/src/fltk-images.adb b/src/fltk-images.adb deleted file mode 100644 index f86071e..0000000 --- a/src/fltk-images.adb +++ /dev/null @@ -1,491 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Images is - - - function new_fl_image - (W, H, D : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_image, "new_fl_image"); - pragma Inline (new_fl_image); - - procedure free_fl_image - (I : in System.Address); - pragma Import (C, free_fl_image, "free_fl_image"); - pragma Inline (free_fl_image); - - - - - function fl_image_get_rgb_scaling - return Interfaces.C.int; - pragma Import (C, fl_image_get_rgb_scaling, "fl_image_get_rgb_scaling"); - pragma Inline (fl_image_get_rgb_scaling); - - procedure fl_image_set_rgb_scaling - (T : in Interfaces.C.int); - pragma Import (C, fl_image_set_rgb_scaling, "fl_image_set_rgb_scaling"); - pragma Inline (fl_image_set_rgb_scaling); - - function fl_image_copy - (I : in System.Address; - W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_image_copy, "fl_image_copy"); - pragma Inline (fl_image_copy); - - function fl_image_copy2 - (I : in System.Address) - return System.Address; - pragma Import (C, fl_image_copy2, "fl_image_copy2"); - pragma Inline (fl_image_copy2); - - - - - procedure fl_image_color_average - (I : in System.Address; - C : in Interfaces.C.int; - B : in Interfaces.C.C_float); - pragma Import (C, fl_image_color_average, "fl_image_color_average"); - pragma Inline (fl_image_color_average); - - procedure fl_image_desaturate - (I : in System.Address); - pragma Import (C, fl_image_desaturate, "fl_image_desaturate"); - pragma Inline (fl_image_desaturate); - - - - - procedure fl_image_inactive - (I : in System.Address); - pragma Import (C, fl_image_inactive, "fl_image_inactive"); - pragma Inline (fl_image_inactive); - - procedure fl_image_uncache - (I : in System.Address); - pragma Import (C, fl_image_uncache, "fl_image_uncache"); - pragma Inline (fl_image_uncache); - - - - - function fl_image_w - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_w, "fl_image_w"); - pragma Inline (fl_image_w); - - function fl_image_h - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_h, "fl_image_h"); - pragma Inline (fl_image_h); - - function fl_image_d - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_d, "fl_image_d"); - pragma Inline (fl_image_d); - - function fl_image_ld - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_ld, "fl_image_ld"); - pragma Inline (fl_image_ld); - - function fl_image_count - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_count, "fl_image_count"); - pragma Inline (fl_image_count); - - - - - function fl_image_data - (I : in System.Address) - return System.Address; - pragma Import (C, fl_image_data, "fl_image_data"); - pragma Inline (fl_image_data); - - function fl_image_get_pixel - (C : in Interfaces.C.Strings.chars_ptr; - O : in Interfaces.C.int) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_image_get_pixel, "fl_image_get_pixel"); - pragma Inline (fl_image_get_pixel); - - procedure fl_image_set_pixel - (C : in Interfaces.C.Strings.chars_ptr; - O : in Interfaces.C.int; - V : in Interfaces.C.unsigned_char); - pragma Import (C, fl_image_set_pixel, "fl_image_set_pixel"); - pragma Inline (fl_image_set_pixel); - - - - - procedure fl_image_draw - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_image_draw, "fl_image_draw"); - pragma Inline (fl_image_draw); - - procedure fl_image_draw2 - (I : in System.Address; - X, Y, W, H, CX, CY : in Interfaces.C.int); - pragma Import (C, fl_image_draw2, "fl_image_draw2"); - pragma Inline (fl_image_draw2); - - procedure fl_image_draw_empty - (I : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_image_draw_empty, "fl_image_draw_empty"); - pragma Inline (fl_image_draw_empty); - - - - - overriding procedure Finalize - (This : in out Image) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Image'Class - then - if This.Needs_Dealloc then - free_fl_image (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - end Finalize; - - - - - -------------------- - -- Construction -- - -------------------- - - package body Forge is - - function Create - (Width, Height, Depth : in Natural) - return Image is - begin - return This : Image do - This.Void_Ptr := new_fl_image - (Interfaces.C.int (Width), - Interfaces.C.int (Height), - Interfaces.C.int (Depth)); - case fl_image_fail (This.Void_Ptr) is - when 1 => raise No_Image_Error; - when 2 => raise File_Access_Error; - when 3 => raise Format_Error; - when others => null; - end case; - end return; - end Create; - - end Forge; - - - function Get_Copy_Algorithm - return Scaling_Kind is - begin - return Scaling_Kind'Val (fl_image_get_rgb_scaling); - end Get_Copy_Algorithm; - - - procedure Set_Copy_Algorithm - (To : in Scaling_Kind) is - begin - fl_image_set_rgb_scaling (Scaling_Kind'Pos (To)); - end Set_Copy_Algorithm; - - - function Copy - (This : in Image; - Width, Height : in Natural) - return Image'Class is - begin - return Copied : Image do - Copied.Void_Ptr := fl_image_copy - (This.Void_Ptr, - Interfaces.C.int (Width), - Interfaces.C.int (Height)); - end return; - end Copy; - - - function Copy - (This : in Image) - return Image'Class is - begin - return Copied : Image do - Copied.Void_Ptr := fl_image_copy2 (This.Void_Ptr); - end return; - end Copy; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Image; - Col : in Color; - Amount : in Blend) is - begin - fl_image_color_average - (This.Void_Ptr, - Interfaces.C.int (Col), - Interfaces.C.C_float (Amount)); - end Color_Average; - - - procedure Desaturate - (This : in out Image) is - begin - fl_image_desaturate (This.Void_Ptr); - end Desaturate; - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Inactive - (This : in out Image) is - begin - fl_image_inactive (This.Void_Ptr); - end Inactive; - - - function Is_Empty - (This : in Image) - return Boolean is - begin - return fl_image_fail (This.Void_Ptr) /= 0; - end Is_Empty; - - - procedure Uncache - (This : in out Image) is - begin - fl_image_uncache (This.Void_Ptr); - end Uncache; - - - - - ------------------ - -- Dimensions -- - ------------------ - - function Get_W - (This : in Image) - return Natural is - begin - return Natural (fl_image_w (This.Void_Ptr)); - end Get_W; - - - function Get_H - (This : in Image) - return Natural is - begin - return Natural (fl_image_h (This.Void_Ptr)); - end Get_H; - - - function Get_D - (This : in Image) - return Natural is - begin - return Natural (fl_image_d (This.Void_Ptr)); - end Get_D; - - - function Get_Line_Data - (This : in Image) - return Natural is - begin - return Natural (fl_image_ld (This.Void_Ptr)); - end Get_Line_Data; - - - function Get_Data_Count - (This : in Image) - return Natural is - begin - return Natural (fl_image_count (This.Void_Ptr)); - end Get_Data_Count; - - - function Get_Data_Size - (This : in Image) - return Natural - is - My_Depth : Natural := This.Get_D; - My_Line_Data : Natural := This.Get_Line_Data; - begin - if My_Line_Data > 0 then - return My_Line_Data * This.Get_H; - elsif My_Depth = 0 then - return Integer (Float'Ceiling (Float (This.Get_W) / 8.0)) * This.Get_H; - else - return This.Get_W * My_Depth * This.Get_H; - end if; - end Get_Data_Size; - - - - - ------------------ - -- Pixel Data -- - ------------------ - - function Get_Datum - (This : in Image; - Data : in Positive; - Position : in Positive) - return Color_Component - is - Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); - pragma Import (Ada, Pointers); - begin - return Color_Component - (fl_image_get_pixel (Pointers (Data), Interfaces.C.int (Position) - 1)); - end Get_Datum; - - - procedure Set_Datum - (This : in out Image; - Data : in Positive; - Position : in Positive; - Value : in Color_Component) - is - Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); - pragma Import (Ada, Pointers); - begin - fl_image_set_pixel - (Pointers (Data), - Interfaces.C.int (Position) - 1, - Interfaces.C.unsigned_char (Value)); - end Set_Datum; - - - function Get_Data - (This : in Image; - Data : in Positive; - Position : in Positive; - Count : in Natural) - return Color_Component_Array - is - Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); - pragma Import (Ada, Pointers); - Result : Color_Component_Array := (1 .. Count => 0); - begin - for Index in Result'Range loop - Result (Index) := Color_Component (fl_image_get_pixel - (Pointers (Data), - Interfaces.C.int (Index - 1 + Position - 1))); - end loop; - return Result; - end Get_Data; - - - function All_Data - (This : in Image; - Data : in Positive) - return Color_Component_Array is - begin - return This.Get_Data (Data, 1, This.Get_Data_Size); - end All_Data; - - - procedure Update_Data - (This : in out Image; - Data : in Positive; - Position : in Positive; - Values : in Color_Component_Array) - is - Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); - pragma Import (Ada, Pointers); - begin - for Counter in Integer range 0 .. Values'Length - 1 loop - fl_image_set_pixel - (Pointers (Data), - Interfaces.C.int (Position - 1 + Counter), - Interfaces.C.unsigned_char (Values (Values'First + Counter))); - end loop; - end Update_Data; - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Image; - X, Y : in Integer) is - begin - fl_image_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw; - - - procedure Draw - (This : in Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0) is - begin - fl_image_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (CX), - Interfaces.C.int (CY)); - end Draw; - - - procedure Draw_Empty - (This : in Image; - X, Y : in Integer) is - begin - fl_image_draw_empty - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Draw_Empty; - - -end FLTK.Images; - diff --git a/src/fltk-images.ads b/src/fltk-images.ads deleted file mode 100644 index 0ee31d5..0000000 --- a/src/fltk-images.ads +++ /dev/null @@ -1,233 +0,0 @@ - - -package FLTK.Images is - - - ------------- - -- Types -- - ------------- - - type Image is new Wrapper with private; - - type Image_Reference (Data : not null access Image'Class) is limited null record - with Implicit_Dereference => Data; - - type Scaling_Kind is (Nearest, Bilinear); - - type Blend is new Float range 0.0 .. 1.0; - - No_Image_Error, File_Access_Error, Format_Error : exception; - - - - - -------------------- - -- Construction -- - -------------------- - - package Forge is - - function Create - (Width, Height, Depth : in Natural) - return Image; - - end Forge; - - function Get_Copy_Algorithm - return Scaling_Kind; - - procedure Set_Copy_Algorithm - (To : in Scaling_Kind); - - function Copy - (This : in Image; - Width, Height : in Natural) - return Image'Class; - - function Copy - (This : in Image) - return Image'Class; - - - - - -------------- - -- Colors -- - -------------- - - procedure Color_Average - (This : in out Image; - Col : in Color; - Amount : in Blend); - - procedure Desaturate - (This : in out Image); - - - - - ---------------- - -- Activity -- - ---------------- - - procedure Inactive - (This : in out Image); - - function Is_Empty - (This : in Image) - return Boolean; - - procedure Uncache - (This : in out Image); - - - - - ------------------ - -- Dimensions -- - ------------------ - - function Get_W - (This : in Image) - return Natural; - - function Get_H - (This : in Image) - return Natural; - - function Get_D - (This : in Image) - return Natural; - - function Get_Line_Data - (This : in Image) - return Natural; - - function Get_Data_Count - (This : in Image) - return Natural; - - function Get_Data_Size - (This : in Image) - return Natural; - - - - - ------------------ - -- Pixel Data -- - ------------------ - - function Get_Datum - (This : in Image; - Data : in Positive; - Position : in Positive) - return Color_Component - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This); - - procedure Set_Datum - (This : in out Image; - Data : in Positive; - Position : in Positive; - Value : in Color_Component) - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This); - - function Get_Data - (This : in Image; - Data : in Positive; - Position : in Positive; - Count : in Natural) - return Color_Component_Array - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This) and - Count <= Get_Data_Size (This) - Position + 1; - - function All_Data - (This : in Image; - Data : in Positive) - return Color_Component_Array - with Pre => - Data <= Get_Data_Count (This); - - procedure Update_Data - (This : in out Image; - Data : in Positive; - Position : in Positive; - Values : in Color_Component_Array) - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This) and - Values'Length <= Get_Data_Size (This) - Position + 1; - - - - - --------------- - -- Drawing -- - --------------- - - procedure Draw - (This : in Image; - X, Y : in Integer); - - procedure Draw - (This : in Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); - - procedure Draw_Empty - (This : in Image; - X, Y : in Integer); - - -private - - - type Image is new Wrapper with null record; - - overriding procedure Finalize - (This : in out Image); - - - - - pragma Inline (Get_Copy_Algorithm); - pragma Inline (Set_Copy_Algorithm); - pragma Inline (Copy); - - - pragma Inline (Color_Average); - pragma Inline (Desaturate); - - - pragma Inline (Inactive); - pragma Inline (Is_Empty); - pragma Inline (Uncache); - - - pragma Inline (Get_W); - pragma Inline (Get_H); - pragma Inline (Get_D); - pragma Inline (Get_Line_Data); - pragma Inline (Get_Data_Count); - - - pragma Inline (Draw); - pragma Inline (Draw_Empty); - - - - - function fl_image_fail - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_fail, "fl_image_fail"); - - -end FLTK.Images; - diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb deleted file mode 100644 index 69a8014..0000000 --- a/src/fltk-menu_items.adb +++ /dev/null @@ -1,507 +0,0 @@ - - -with - - System, - Interfaces.C.Strings, - Ada.Unchecked_Conversion; - -use type - - System.Address, - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Menu_Items is - - - function new_fl_menu_item - (T : in Interfaces.C.char_array; - C : in System.Address; - S, F : in Interfaces.C.unsigned_long) - return System.Address; - pragma Import (C, new_fl_menu_item, "new_fl_menu_item"); - pragma Inline (new_fl_menu_item); - - procedure free_fl_menu_item - (MI : in System.Address); - pragma Import (C, free_fl_menu_item, "free_fl_menu_item"); - pragma Inline (free_fl_menu_item); - - - - - function fl_menu_item_get_user_data - (MI : in System.Address) - return System.Address; - pragma Import (C, fl_menu_item_get_user_data, "fl_menu_item_get_user_data"); - pragma Inline (fl_menu_item_get_user_data); - - procedure fl_menu_item_set_user_data - (MI, C : in System.Address); - pragma Import (C, fl_menu_item_set_user_data, "fl_menu_item_set_user_data"); - pragma Inline (fl_menu_item_set_user_data); - - procedure fl_menu_item_do_callback - (MI, W : in System.Address); - pragma Import (C, fl_menu_item_do_callback, "fl_menu_item_do_callback"); - pragma Inline (fl_menu_item_do_callback); - - - - - function fl_menu_item_checkbox - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_checkbox, "fl_menu_item_checkbox"); - pragma Inline (fl_menu_item_checkbox); - - function fl_menu_item_radio - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_radio, "fl_menu_item_radio"); - pragma Inline (fl_menu_item_radio); - - function fl_menu_item_value - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_value, "fl_menu_item_value"); - pragma Inline (fl_menu_item_value); - - procedure fl_menu_item_set - (MI : in System.Address); - pragma Import (C, fl_menu_item_set, "fl_menu_item_set"); - pragma Inline (fl_menu_item_set); - - procedure fl_menu_item_clear - (MI : in System.Address); - pragma Import (C, fl_menu_item_clear, "fl_menu_item_clear"); - pragma Inline (fl_menu_item_clear); - - procedure fl_menu_item_setonly - (MI : in System.Address); - pragma Import (C, fl_menu_item_setonly, "fl_menu_item_setonly"); - pragma Inline (fl_menu_item_setonly); - - - - - function fl_menu_item_get_label - (MI : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_menu_item_get_label, "fl_menu_item_get_label"); - pragma Inline (fl_menu_item_get_label); - - procedure fl_menu_item_set_label - (MI : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_menu_item_set_label, "fl_menu_item_set_label"); - pragma Inline (fl_menu_item_set_label); - - function fl_menu_item_get_labelcolor - (MI : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_menu_item_get_labelcolor, "fl_menu_item_get_labelcolor"); - pragma Inline (fl_menu_item_get_labelcolor); - - procedure fl_menu_item_set_labelcolor - (MI : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_menu_item_set_labelcolor, "fl_menu_item_set_labelcolor"); - pragma Inline (fl_menu_item_set_labelcolor); - - function fl_menu_item_get_labelfont - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_get_labelfont, "fl_menu_item_get_labelfont"); - pragma Inline (fl_menu_item_get_labelfont); - - procedure fl_menu_item_set_labelfont - (MI : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_menu_item_set_labelfont, "fl_menu_item_set_labelfont"); - pragma Inline (fl_menu_item_set_labelfont); - - function fl_menu_item_get_labelsize - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_get_labelsize, "fl_menu_item_get_labelsize"); - pragma Inline (fl_menu_item_get_labelsize); - - procedure fl_menu_item_set_labelsize - (MI : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_menu_item_set_labelsize, "fl_menu_item_set_labelsize"); - pragma Inline (fl_menu_item_set_labelsize); - - function fl_menu_item_get_labeltype - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_get_labeltype, "fl_menu_item_get_labeltype"); - pragma Inline (fl_menu_item_get_labeltype); - - procedure fl_menu_item_set_labeltype - (MI : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_menu_item_set_labeltype, "fl_menu_item_set_labeltype"); - pragma Inline (fl_menu_item_set_labeltype); - - - - - function fl_menu_item_get_shortcut - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_get_shortcut, "fl_menu_item_get_shortcut"); - pragma Inline (fl_menu_item_get_shortcut); - - procedure fl_menu_item_set_shortcut - (MI : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_menu_item_set_shortcut, "fl_menu_item_set_shortcut"); - pragma Inline (fl_menu_item_set_shortcut); - - function fl_menu_item_get_flags - (MI : in System.Address) - return Interfaces.C.unsigned_long; - pragma Import (C, fl_menu_item_get_flags, "fl_menu_item_get_flags"); - pragma Inline (fl_menu_item_get_flags); - - procedure fl_menu_item_set_flags - (MI : in System.Address; - F : in Interfaces.C.unsigned_long); - pragma Import (C, fl_menu_item_set_flags, "fl_menu_item_set_flags"); - pragma Inline (fl_menu_item_set_flags); - - - - - procedure fl_menu_item_activate - (MI : in System.Address); - pragma Import (C, fl_menu_item_activate, "fl_menu_item_activate"); - pragma Inline (fl_menu_item_activate); - - procedure fl_menu_item_deactivate - (MI : in System.Address); - pragma Import (C, fl_menu_item_deactivate, "fl_menu_item_deactivate"); - pragma Inline (fl_menu_item_deactivate); - - procedure fl_menu_item_show - (MI : in System.Address); - pragma Import (C, fl_menu_item_show, "fl_menu_item_show"); - pragma Inline (fl_menu_item_show); - - procedure fl_menu_item_hide - (MI : in System.Address); - pragma Import (C, fl_menu_item_hide, "fl_menu_item_hide"); - pragma Inline (fl_menu_item_hide); - - function fl_menu_item_active - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_active, "fl_menu_item_active"); - pragma Inline (fl_menu_item_active); - - function fl_menu_item_visible - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_visible, "fl_menu_item_visible"); - pragma Inline (fl_menu_item_visible); - - function fl_menu_item_activevisible - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_item_activevisible, "fl_menu_item_activevisible"); - pragma Inline (fl_menu_item_activevisible); - - - - - procedure Finalize - (This : in out Menu_Item) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Menu_Item'Class - then - if This.Needs_Dealloc then - free_fl_menu_item (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - end Finalize; - - - - - package Callback_Convert is - function To_Pointer is new Ada.Unchecked_Conversion - (System.Address, FLTK.Widgets.Widget_Callback); - function To_Address is new Ada.Unchecked_Conversion - (FLTK.Widgets.Widget_Callback, System.Address); - end Callback_Convert; - - - - - package body Forge is - - function Create - (Text : in String; - Action : in FLTK.Widgets.Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal) - return Menu_Item is - begin - return Item : Menu_Item do - Item.Void_Ptr := new_fl_menu_item - (Interfaces.C.To_C (Text), - Callback_Convert.To_Address (Action), - To_C (Shortcut), - Interfaces.C.unsigned_long (Flags)); - end return; - end Create; - - pragma Inline (Create); - - end Forge; - - - - - function Get_Callback - (Item : in Menu_Item) - return FLTK.Widgets.Widget_Callback is - begin - return Callback_Convert.To_Pointer - (fl_menu_item_get_user_data (Item.Void_Ptr)); - end Get_Callback; - - - procedure Set_Callback - (Item : in out Menu_Item; - Func : in FLTK.Widgets.Widget_Callback) is - begin - fl_menu_item_set_user_data - (Item.Void_Ptr, - Callback_Convert.To_Address (Func)); - end Set_Callback; - - - procedure Do_Callback - (Item : in out Menu_Item; - Widget : in out FLTK.Widgets.Widget'Class) is - begin - fl_menu_item_do_callback (Item.Void_Ptr, Wrapper (Widget).Void_Ptr); - end Do_Callback; - - - - - function Has_Checkbox - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_checkbox (Item.Void_Ptr) /= 0; - end Has_Checkbox; - - function Is_Radio - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_radio (Item.Void_Ptr) /= 0; - end Is_Radio; - - function Get_State - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_value (Item.Void_Ptr) /= 0; - end Get_State; - - procedure Set_State - (Item : in out Menu_Item; - To : in Boolean) is - begin - if To then - fl_menu_item_set (Item.Void_Ptr); - else - fl_menu_item_clear (Item.Void_Ptr); - end if; - end Set_State; - - procedure Set_Only - (Item : in out Menu_Item) is - begin - fl_menu_item_setonly (Item.Void_Ptr); - end Set_Only; - - - - - function Get_Label - (Item : in Menu_Item) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (Item.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Label; - - procedure Set_Label - (Item : in out Menu_Item; - Text : in String) is - begin - fl_menu_item_set_label (Item.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Label; - - function Get_Label_Color - (Item : in Menu_Item) - return Color is - begin - return Color (fl_menu_item_get_labelcolor (Item.Void_Ptr)); - end Get_Label_Color; - - procedure Set_Label_Color - (Item : in out Menu_Item; - To : in Color) is - begin - fl_menu_item_set_labelcolor (Item.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Label_Color; - - function Get_Label_Font - (Item : in Menu_Item) - return Font_Kind is - begin - return Font_Kind'Val (fl_menu_item_get_labelfont (Item.Void_Ptr)); - end Get_Label_Font; - - procedure Set_Label_Font - (Item : in out Menu_Item; - To : in Font_Kind) is - begin - fl_menu_item_set_labelfont (Item.Void_Ptr, Font_Kind'Pos (To)); - end Set_Label_Font; - - function Get_Label_Size - (Item : in Menu_Item) - return Font_Size is - begin - return Font_Size (fl_menu_item_get_labelsize (Item.Void_Ptr)); - end Get_Label_Size; - - procedure Set_Label_Size - (Item : in out Menu_Item; - To : in Font_Size) is - begin - fl_menu_item_set_labelsize (Item.Void_Ptr, Interfaces.C.int (To)); - end Set_Label_Size; - - function Get_Label_Type - (Item : in Menu_Item) - return Label_Kind is - begin - return Label_Kind'Val (fl_menu_item_get_labeltype (Item.Void_Ptr)); - end Get_Label_Type; - - procedure Set_Label_Type - (Item : in out Menu_Item; - To : in Label_Kind) is - begin - fl_menu_item_set_labeltype (Item.Void_Ptr, Label_Kind'Pos (To)); - end Set_Label_Type; - - - - - function Get_Shortcut - (Item : in Menu_Item) - return Key_Combo is - begin - return To_Ada (Interfaces.C.unsigned_long (fl_menu_item_get_shortcut (Item.Void_Ptr))); - end Get_Shortcut; - - procedure Set_Shortcut - (Item : in out Menu_Item; - To : in Key_Combo) is - begin - fl_menu_item_set_shortcut (Item.Void_Ptr, Interfaces.C.int (To_C (To))); - end Set_Shortcut; - - - function Get_Flags - (Item : in Menu_Item) - return Menu_Flag is - begin - return Menu_Flag (fl_menu_item_get_flags (Item.Void_Ptr)); - end Get_Flags; - - - procedure Set_Flags - (Item : in out Menu_Item; - To : in Menu_Flag) is - begin - fl_menu_item_set_flags (Item.Void_Ptr, Interfaces.C.unsigned_long (To)); - end Set_Flags; - - - - - procedure Activate - (Item : in out Menu_Item) is - begin - fl_menu_item_activate (Item.Void_Ptr); - end Activate; - - - procedure Deactivate - (Item : in out Menu_Item) is - begin - fl_menu_item_deactivate (Item.Void_Ptr); - end Deactivate; - - - procedure Show - (Item : in out Menu_Item) is - begin - fl_menu_item_show (Item.Void_Ptr); - end Show; - - - procedure Hide - (Item : in out Menu_Item) is - begin - fl_menu_item_hide (Item.Void_Ptr); - end Hide; - - - function Is_Active - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_active (Item.Void_Ptr) /= 0; - end Is_Active; - - - function Is_Visible - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_visible (Item.Void_Ptr) /= 0; - end Is_Visible; - - - function Is_Active_And_Visible - (Item : in Menu_Item) - return Boolean is - begin - return fl_menu_item_activevisible (Item.Void_Ptr) /= 0; - end Is_Active_And_Visible; - - -end FLTK.Menu_Items; - diff --git a/src/fltk-menu_items.ads b/src/fltk-menu_items.ads deleted file mode 100644 index 5964a48..0000000 --- a/src/fltk-menu_items.ads +++ /dev/null @@ -1,210 +0,0 @@ - -with - - FLTK.Widgets; - - -package FLTK.Menu_Items is - - - type Menu_Item is new Wrapper with private; - - type Menu_Item_Reference (Data : not null access Menu_Item'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - -- Usually you don't bother with this and just add items - -- to Menus directly using the Add subprograms in that package. - - function Create - (Text : in String; - Action : in FLTK.Widgets.Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal) - return Menu_Item; - - end Forge; - - - - - function Get_Callback - (Item : in Menu_Item) - return FLTK.Widgets.Widget_Callback; - - procedure Set_Callback - (Item : in out Menu_Item; - Func : in FLTK.Widgets.Widget_Callback); - - procedure Do_Callback - (Item : in out Menu_Item; - Widget : in out FLTK.Widgets.Widget'Class); - - - - - function Has_Checkbox - (Item : in Menu_Item) - return Boolean; - - function Is_Radio - (Item : in Menu_Item) - return Boolean; - - function Get_State - (Item : in Menu_Item) - return Boolean; - - procedure Set_State - (Item : in out Menu_Item; - To : in Boolean); - - procedure Set_Only - (Item : in out Menu_Item); - - - - - function Get_Label - (Item : in Menu_Item) - return String; - - procedure Set_Label - (Item : in out Menu_Item; - Text : in String); - - function Get_Label_Color - (Item : in Menu_Item) - return Color; - - procedure Set_Label_Color - (Item : in out Menu_Item; - To : in Color); - - function Get_Label_Font - (Item : in Menu_Item) - return Font_Kind; - - procedure Set_Label_Font - (Item : in out Menu_Item; - To : in Font_Kind); - - function Get_Label_Size - (Item : in Menu_Item) - return Font_Size; - - procedure Set_Label_Size - (Item : in out Menu_Item; - To : in Font_Size); - - function Get_Label_Type - (Item : in Menu_Item) - return Label_Kind; - - procedure Set_Label_Type - (Item : in out Menu_Item; - To : in Label_Kind); - - - - - function Get_Shortcut - (Item : in Menu_Item) - return Key_Combo; - - procedure Set_Shortcut - (Item : in out Menu_Item; - To : in Key_Combo); - - function Get_Flags - (Item : in Menu_Item) - return Menu_Flag; - - procedure Set_Flags - (Item : in out Menu_Item; - To : in Menu_Flag); - - - - - procedure Activate - (Item : in out Menu_Item); - - procedure Deactivate - (Item : in out Menu_Item); - - procedure Show - (Item : in out Menu_Item); - - procedure Hide - (Item : in out Menu_Item); - - function Is_Active - (Item : in Menu_Item) - return Boolean; - - function Is_Visible - (Item : in Menu_Item) - return Boolean; - - function Is_Active_And_Visible - (Item : in Menu_Item) - return Boolean; - - -private - - - type Menu_Item is new Wrapper with null record; - - overriding procedure Finalize - (This : in out Menu_Item); - - - - - pragma Inline (Get_Callback); - pragma Inline (Set_Callback); - pragma Inline (Do_Callback); - - - pragma Inline (Has_Checkbox); - pragma Inline (Is_Radio); - pragma Inline (Get_State); - pragma Inline (Set_State); - pragma Inline (Set_Only); - - - pragma Inline (Get_Label); - pragma Inline (Set_Label); - pragma Inline (Get_Label_Color); - pragma Inline (Set_Label_Color); - pragma Inline (Get_Label_Font); - pragma Inline (Set_Label_Font); - pragma Inline (Get_Label_Size); - pragma Inline (Set_Label_Size); - pragma Inline (Get_Label_Type); - pragma Inline (Set_Label_Type); - - - pragma Inline (Get_Shortcut); - pragma Inline (Set_Shortcut); - pragma Inline (Get_Flags); - pragma Inline (Set_Flags); - - - pragma Inline (Activate); - pragma Inline (Deactivate); - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Is_Active); - pragma Inline (Is_Visible); - pragma Inline (Is_Active_And_Visible); - - -end FLTK.Menu_Items; - diff --git a/src/fltk-screen.adb b/src/fltk-screen.adb deleted file mode 100644 index e556d14..0000000 --- a/src/fltk-screen.adb +++ /dev/null @@ -1,278 +0,0 @@ - - -with - - Interfaces.C; - -use type - - Interfaces.C.int; - - -package body FLTK.Screen is - - - function fl_screen_x - return Interfaces.C.int; - pragma Import (C, fl_screen_x, "fl_screen_x"); - pragma Inline (fl_screen_x); - - function fl_screen_y - return Interfaces.C.int; - pragma Import (C, fl_screen_y, "fl_screen_y"); - pragma Inline (fl_screen_y); - - function fl_screen_w - return Interfaces.C.int; - pragma Import (C, fl_screen_w, "fl_screen_w"); - pragma Inline (fl_screen_w); - - function fl_screen_h - return Interfaces.C.int; - pragma Import (C, fl_screen_h, "fl_screen_h"); - pragma Inline (fl_screen_h); - - - - - function fl_screen_count - return Interfaces.C.int; - pragma Import (C, fl_screen_count, "fl_screen_count"); - pragma Inline (fl_screen_count); - - procedure fl_screen_dpi - (H, V : out Interfaces.C.C_float; - N : in Interfaces.C.int); - pragma Import (C, fl_screen_dpi, "fl_screen_dpi"); - pragma Inline (fl_screen_dpi); - - - - - function fl_screen_num - (X, Y : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_screen_num, "fl_screen_num"); - pragma Inline (fl_screen_num); - - function fl_screen_num2 - (X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_screen_num2, "fl_screen_num2"); - pragma Inline (fl_screen_num2); - - - - - procedure fl_screen_work_area - (X, Y, W, H : out Interfaces.C.int; - PX, PY : in Interfaces.C.int); - pragma Import (C, fl_screen_work_area, "fl_screen_work_area"); - pragma Inline (fl_screen_work_area); - - procedure fl_screen_work_area2 - (X, Y, W, H : out Interfaces.C.int; - N : in Interfaces.C.int); - pragma Import (C, fl_screen_work_area2, "fl_screen_work_area2"); - pragma Inline (fl_screen_work_area2); - - procedure fl_screen_work_area3 - (X, Y, W, H : out Interfaces.C.int); - pragma Import (C, fl_screen_work_area3, "fl_screen_work_area3"); - pragma Inline (fl_screen_work_area3); - - - - - procedure fl_screen_xywh - (X, Y, W, H : out Interfaces.C.int; - PX, PY : in Interfaces.C.int); - pragma Import (C, fl_screen_xywh, "fl_screen_xywh"); - pragma Inline (fl_screen_xywh); - - procedure fl_screen_xywh2 - (X, Y, W, H : out Interfaces.C.int; - N : in Interfaces.C.int); - pragma Import (C, fl_screen_xywh2, "fl_screen_xywh2"); - pragma Inline (fl_screen_xywh2); - - procedure fl_screen_xywh3 - (X, Y, W, H : out Interfaces.C.int); - pragma Import (C, fl_screen_xywh3, "fl_screen_xywh3"); - pragma Inline (fl_screen_xywh3); - - procedure fl_screen_xywh4 - (X, Y, W, H : out Interfaces.C.int; - PX, PY, PW, PH : in Interfaces.C.int); - pragma Import (C, fl_screen_xywh4, "fl_screen_xywh4"); - pragma Inline (fl_screen_xywh4); - - - - - function Get_X return Integer is - begin - return Integer (fl_screen_x); - end Get_X; - - - function Get_Y return Integer is - begin - return Integer (fl_screen_y); - end Get_Y; - - - function Get_W return Integer is - begin - return Integer (fl_screen_w); - end Get_W; - - - function Get_H return Integer is - begin - return Integer (fl_screen_h); - end Get_H; - - - - - function Count return Integer is - begin - return Integer (fl_screen_count); - end Count; - - - -- Screen numbers in the range 1 .. Get_Count - procedure DPI - (Horizontal, Vertical : out Float; - Screen_Number : in Integer := 1) is - begin - fl_screen_dpi - (Interfaces.C.C_float (Horizontal), - Interfaces.C.C_float (Vertical), - Interfaces.C.int (Screen_Number) - 1); - end DPI; - - - - - function Containing - (X, Y : in Integer) - return Integer is - begin - return Integer (fl_screen_num - (Interfaces.C.int (X), - Interfaces.C.int (Y))); - end Containing; - - - function Containing - (X, Y, W, H : in Integer) - return Integer is - begin - return Integer (fl_screen_num2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H))); - end Containing; - - - - - procedure Work_Area - (X, Y, W, H : out Integer; - Pos_X, Pos_Y : in Integer) is - begin - fl_screen_work_area - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Pos_X), - Interfaces.C.int (Pos_Y)); - end Work_Area; - - - procedure Work_Area - (X, Y, W, H : out Integer; - Screen_Num : in Integer) is - begin - fl_screen_work_area2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Screen_Num)); - end Work_Area; - - - procedure Work_Area - (X, Y, W, H : out Integer) is - begin - fl_screen_work_area3 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Work_Area; - - - - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - Pos_X, Pos_Y : in Integer) is - begin - fl_screen_xywh - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Pos_X), - Interfaces.C.int (Pos_Y)); - end Bounding_Rect; - - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - Screen_Num : in Integer) is - begin - fl_screen_xywh2 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Screen_Num)); - end Bounding_Rect; - - - procedure Bounding_Rect - (X, Y, W, H : out Integer) is - begin - fl_screen_xywh3 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Bounding_Rect; - - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - PX, PY, PW, PH : in Integer) is - begin - fl_screen_xywh4 - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (PX), - Interfaces.C.int (PY), - Interfaces.C.int (PW), - Interfaces.C.int (PH)); - end Bounding_Rect; - - -end FLTK.Screen; - diff --git a/src/fltk-screen.ads b/src/fltk-screen.ads deleted file mode 100644 index 8cf535e..0000000 --- a/src/fltk-screen.ads +++ /dev/null @@ -1,92 +0,0 @@ - - -package FLTK.Screen is - - - function Get_X - return Integer; - - function Get_Y - return Integer; - - function Get_W - return Integer; - - function Get_H - return Integer; - - - - - function Count - return Integer; - - -- Screen numbers in the range 1 .. Count - procedure DPI - (Horizontal, Vertical : out Float; - Screen_Number : in Integer := 1); - - - - - function Containing - (X, Y : in Integer) - return Integer; - - function Containing - (X, Y, W, H : in Integer) - return Integer; - - - - - procedure Work_Area - (X, Y, W, H : out Integer; - Pos_X, Pos_Y : in Integer); - - procedure Work_Area - (X, Y, W, H : out Integer; - Screen_Num : in Integer); - - procedure Work_Area - (X, Y, W, H : out Integer); - - - - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - Pos_X, Pos_Y : in Integer); - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - Screen_Num : in Integer); - - procedure Bounding_Rect - (X, Y, W, H : out Integer); - - procedure Bounding_Rect - (X, Y, W, H : out Integer; - PX, PY, PW, PH : in Integer); - - -private - - - pragma Inline (Get_X); - pragma Inline (Get_Y); - pragma Inline (Get_W); - pragma Inline (Get_H); - - - pragma Inline (Count); - pragma Inline (DPI); - - - pragma Inline (Containing); - pragma Inline (Work_Area); - pragma Inline (Bounding_Rect); - - -end FLTK.Screen; - diff --git a/src/fltk-static.adb b/src/fltk-static.adb deleted file mode 100644 index 3ec3938..0000000 --- a/src/fltk-static.adb +++ /dev/null @@ -1,1021 +0,0 @@ - - -with - - Interfaces.C.Strings, - System.Address_To_Access_Conversions, - Ada.Unchecked_Conversion; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Static is - - - procedure fl_static_add_awake_handler - (H, F : in System.Address); - pragma Import (C, fl_static_add_awake_handler, "fl_static_add_awake_handler"); - pragma Inline (fl_static_add_awake_handler); - - procedure fl_static_get_awake_handler - (H, F : out System.Address); - pragma Import (C, fl_static_get_awake_handler, "fl_static_get_awake_handler"); - pragma Inline (fl_static_get_awake_handler); - - - - - procedure fl_static_add_check - (H, F : in System.Address); - pragma Import (C, fl_static_add_check, "fl_static_add_check"); - pragma Inline (fl_static_add_check); - - function fl_static_has_check - (H, F : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_static_has_check, "fl_static_has_check"); - pragma Inline (fl_static_has_check); - - procedure fl_static_remove_check - (H, F : in System.Address); - pragma Import (C, fl_static_remove_check, "fl_static_remove_check"); - pragma Inline (fl_static_remove_check); - - - - - procedure fl_static_add_timeout - (S : in Interfaces.C.double; - H, F : in System.Address); - pragma Import (C, fl_static_add_timeout, "fl_static_add_timeout"); - pragma Inline (fl_static_add_timeout); - - function fl_static_has_timeout - (H, F : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_static_has_timeout, "fl_static_has_timeout"); - pragma Inline (fl_static_has_timeout); - - procedure fl_static_remove_timeout - (H, F : in System.Address); - pragma Import (C, fl_static_remove_timeout, "fl_static_remove_timeout"); - pragma Inline (fl_static_remove_timeout); - - procedure fl_static_repeat_timeout - (S : in Interfaces.C.double; - H, F : in System.Address); - pragma Import (C, fl_static_repeat_timeout, "fl_static_repeat_timeout"); - pragma Inline (fl_static_repeat_timeout); - - - - - procedure fl_static_add_clipboard_notify - (H, F : in System.Address); - pragma Import (C, fl_static_add_clipboard_notify, "fl_static_add_clipboard_notify"); - pragma Inline (fl_static_add_clipboard_notify); - - - - - procedure fl_static_add_fd - (D : in Interfaces.C.int; - H, F : in System.Address); - pragma Import (C, fl_static_add_fd, "fl_static_add_fd"); - pragma Inline (fl_static_add_fd); - - procedure fl_static_add_fd2 - (D, M : in Interfaces.C.int; - H, F : in System.Address); - pragma Import (C, fl_static_add_fd2, "fl_static_add_fd2"); - pragma Inline (fl_static_add_fd2); - - procedure fl_static_remove_fd - (D : in Interfaces.C.int); - pragma Import (C, fl_static_remove_fd, "fl_static_remove_fd"); - pragma Inline (fl_static_remove_fd); - - procedure fl_static_remove_fd2 - (D, M : in Interfaces.C.int); - pragma Import (C, fl_static_remove_fd2, "fl_static_remove_fd2"); - pragma Inline (fl_static_remove_fd2); - - - - - procedure fl_static_add_idle - (H, F : in System.Address); - pragma Import (C, fl_static_add_idle, "fl_static_add_idle"); - pragma Inline (fl_static_add_idle); - - function fl_static_has_idle - (H, F : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_static_has_idle, "fl_static_has_idle"); - pragma Inline (fl_static_has_idle); - - procedure fl_static_remove_idle - (H, F : in System.Address); - pragma Import (C, fl_static_remove_idle, "fl_static_remove_idle"); - pragma Inline (fl_static_remove_idle); - - - - - procedure fl_static_get_color - (C : in Interfaces.C.unsigned; - R, G, B : out Interfaces.C.unsigned_char); - pragma Import (C, fl_static_get_color, "fl_static_get_color"); - pragma Inline (fl_static_get_color); - - procedure fl_static_set_color - (C : in Interfaces.C.unsigned; - R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_static_set_color, "fl_static_set_color"); - pragma Inline (fl_static_set_color); - - procedure fl_static_free_color - (C : in Interfaces.C.unsigned; - B : in Interfaces.C.int); - pragma Import (C, fl_static_free_color, "fl_static_free_color"); - pragma Inline (fl_static_free_color); - - procedure fl_static_foreground - (R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_static_foreground, "fl_static_foreground"); - pragma Inline (fl_static_foreground); - - procedure fl_static_background - (R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_static_background, "fl_static_background"); - pragma Inline (fl_static_background); - - procedure fl_static_background2 - (R, G, B : in Interfaces.C.unsigned_char); - pragma Import (C, fl_static_background2, "fl_static_background2"); - pragma Inline (fl_static_background2); - - - - - function fl_static_get_font - (K : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_static_get_font, "fl_static_get_font"); - pragma Inline (fl_static_get_font); - - function fl_static_get_font_name - (K : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_static_get_font_name, "fl_static_get_font_name"); - pragma Inline (fl_static_get_font_name); - - procedure fl_static_set_font - (T, F : in Interfaces.C.int); - pragma Import (C, fl_static_set_font, "fl_static_set_font"); - pragma Inline (fl_static_set_font); - - function fl_static_get_font_sizes - (F : in Interfaces.C.int; - A : out System.Address) - return Interfaces.C.int; - pragma Import (C, fl_static_get_font_sizes, "fl_static_get_font_sizes"); - pragma Inline (fl_static_get_font_sizes); - - function fl_static_font_size_array_get - (A : in System.Address; - I : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_font_size_array_get, "fl_static_font_size_array_get"); - pragma Inline (fl_static_font_size_array_get); - - function fl_static_set_fonts - return Interfaces.C.int; - pragma Import (C, fl_static_set_fonts, "fl_static_set_fonts"); - pragma Inline (fl_static_set_fonts); - - - - - function fl_static_box_dh - (B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_box_dh, "fl_static_box_dh"); - pragma Inline (fl_static_box_dh); - - function fl_static_box_dw - (B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_box_dw, "fl_static_box_dw"); - pragma Inline (fl_static_box_dw); - - function fl_static_box_dx - (B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_box_dx, "fl_static_box_dx"); - pragma Inline (fl_static_box_dx); - - function fl_static_box_dy - (B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_box_dy, "fl_static_box_dy"); - pragma Inline (fl_static_box_dy); - - procedure fl_static_set_boxtype - (T, F : in Interfaces.C.int); - pragma Import (C, fl_static_set_boxtype, "fl_static_set_boxtype"); - pragma Inline (fl_static_set_boxtype); - - function fl_static_draw_box_active - return Interfaces.C.int; - pragma Import (C, fl_static_draw_box_active, "fl_static_draw_box_active"); - pragma Inline (fl_static_draw_box_active); - - - - - procedure fl_static_copy - (T : in Interfaces.C.char_array; - L, K : in Interfaces.C.int); - pragma Import (C, fl_static_copy, "fl_static_copy"); - pragma Inline (fl_static_copy); - - procedure fl_static_paste - (R : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_static_paste, "fl_static_paste"); - pragma Inline (fl_static_paste); - - procedure fl_static_selection - (O : in System.Address; - T : in Interfaces.C.char_array; - L : in Interfaces.C.int); - pragma Import (C, fl_static_selection, "fl_static_selection"); - pragma Inline (fl_static_selection); - - - - - function fl_static_get_dnd_text_ops - return Interfaces.C.int; - pragma Import (C, fl_static_get_dnd_text_ops, "fl_static_get_dnd_text_ops"); - pragma Inline (fl_static_get_dnd_text_ops); - - procedure fl_static_set_dnd_text_ops - (T : in Interfaces.C.int); - pragma Import (C, fl_static_set_dnd_text_ops, "fl_static_set_dnd_text_ops"); - pragma Inline (fl_static_set_dnd_text_ops); - - - - - function fl_static_get_visible_focus - return Interfaces.C.int; - pragma Import (C, fl_static_get_visible_focus, "fl_static_get_visible_focus"); - pragma Inline (fl_static_get_visible_focus); - - procedure fl_static_set_visible_focus - (T : in Interfaces.C.int); - pragma Import (C, fl_static_set_visible_focus, "fl_static_set_visible_focus"); - pragma Inline (fl_static_set_visible_focus); - - - - - procedure fl_static_default_atclose - (W : in System.Address); - pragma Import (C, fl_static_default_atclose, "fl_static_default_atclose"); - pragma Inline (fl_static_default_atclose); - - function fl_static_get_first_window - return System.Address; - pragma Import (C, fl_static_get_first_window, "fl_static_get_first_window"); - pragma Inline (fl_static_get_first_window); - - procedure fl_static_set_first_window - (T : in System.Address); - pragma Import (C, fl_static_set_first_window, "fl_static_set_first_window"); - pragma Inline (fl_static_set_first_window); - - function fl_static_next_window - (W : in System.Address) - return System.Address; - pragma Import (C, fl_static_next_window, "fl_static_next_window"); - pragma Inline (fl_static_next_window); - - function fl_static_modal - return System.Address; - pragma Import (C, fl_static_modal, "fl_static_modal"); - pragma Inline (fl_static_modal); - - - - - function fl_static_readqueue - return System.Address; - pragma Import (C, fl_static_readqueue, "fl_static_readqueue"); - pragma Inline (fl_static_readqueue); - - - - - function fl_static_get_scheme - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_static_get_scheme, "fl_static_get_scheme"); - pragma Inline (fl_static_get_scheme); - - procedure fl_static_set_scheme - (S : in Interfaces.C.char_array); - pragma Import (C, fl_static_set_scheme, "fl_static_set_scheme"); - pragma Inline (fl_static_set_scheme); - - function fl_static_is_scheme - (S : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_static_is_scheme, "fl_static_is_scheme"); - pragma Inline (fl_static_is_scheme); - - - - - function fl_static_get_option - (O : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_static_get_option, "fl_static_get_option"); - pragma Inline (fl_static_get_option); - - procedure fl_static_set_option - (O, T : in Interfaces.C.int); - pragma Import (C, fl_static_set_option, "fl_static_set_option"); - pragma Inline (fl_static_set_option); - - - - - function fl_static_get_scrollbar_size - return Interfaces.C.int; - pragma Import (C, fl_static_get_scrollbar_size, "fl_static_get_scrollbar_size"); - pragma Inline (fl_static_get_scrollbar_size); - - procedure fl_static_set_scrollbar_size - (S : in Interfaces.C.int); - pragma Import (C, fl_static_set_scrollbar_size, "fl_static_set_scrollbar_size"); - pragma Inline (fl_static_set_scrollbar_size); - - - - - package Widget_Convert is new System.Address_To_Access_Conversions - (FLTK.Widgets.Widget'Class); - package Window_Convert is new System.Address_To_Access_Conversions - (FLTK.Widgets.Groups.Windows.Window'Class); - - function fl_widget_get_user_data - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - - - - - package Awake_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Awake_Handler); - function To_Address is new Ada.Unchecked_Conversion (Awake_Handler, System.Address); - end Awake_Convert; - - procedure Awake_Hook - (U : in System.Address); - pragma Convention (C, Awake_Hook); - - procedure Awake_Hook - (U : in System.Address) is - begin - Awake_Convert.To_Pointer (U).all; - end Awake_Hook; - - - procedure Add_Awake_Handler - (Func : in Awake_Handler) is - begin - fl_static_add_awake_handler - (Awake_Hook'Address, - Awake_Convert.To_Address (Func)); - end Add_Awake_Handler; - - - function Get_Awake_Handler - return Awake_Handler - is - Hook, Func : System.Address; - begin - fl_static_get_awake_handler (Hook, Func); - return Awake_Convert.To_Pointer (Func); - end Get_Awake_Handler; - - - - - package Timeout_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Timeout_Handler); - function To_Address is new Ada.Unchecked_Conversion (Timeout_Handler, System.Address); - end Timeout_Convert; - - procedure Timeout_Hook - (U : in System.Address); - pragma Convention (C, Timeout_Hook); - - procedure Timeout_Hook - (U : in System.Address) is - begin - Timeout_Convert.To_Pointer (U).all; - end Timeout_Hook; - - - procedure Add_Check - (Func : in Timeout_Handler) is - begin - fl_static_add_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); - end Add_Check; - - - function Has_Check - (Func : in Timeout_Handler) - return Boolean is - begin - return fl_static_has_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)) /= 0; - end Has_Check; - - - procedure Remove_Check - (Func : in Timeout_Handler) is - begin - fl_static_remove_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); - end Remove_Check; - - - - - procedure Add_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler) is - begin - fl_static_add_timeout - (Interfaces.C.double (Seconds), - Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); - end Add_Timeout; - - - function Has_Timeout - (Func : in Timeout_Handler) - return Boolean is - begin - return fl_static_has_timeout - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)) /= 0; - end Has_Timeout; - - - procedure Remove_Timeout - (Func : in Timeout_Handler) is - begin - fl_static_remove_timeout - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); - end Remove_Timeout; - - - procedure Repeat_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler) is - begin - fl_static_repeat_timeout - (Interfaces.C.double (Seconds), - Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); - end Repeat_Timeout; - - - - - package Clipboard_Convert is - function To_Pointer is new Ada.Unchecked_Conversion - (System.Address, Clipboard_Notify_Handler); - function To_Address is new Ada.Unchecked_Conversion - (Clipboard_Notify_Handler, System.Address); - end Clipboard_Convert; - - Current_Clipboard_Notify : Clipboard_Notify_Handler; - - procedure Clipboard_Notify_Hook - (S : in Interfaces.C.int; - U : in System.Address); - pragma Convention (C, Clipboard_Notify_Hook); - - procedure Clipboard_Notify_Hook - (S : in Interfaces.C.int; - U : in System.Address) is - begin - if Current_Clipboard_Notify /= null then - Current_Clipboard_Notify.all (Buffer_Kind'Val (S)); - end if; - end Clipboard_Notify_Hook; - - - procedure Add_Clipboard_Notify - (Func : in Clipboard_Notify_Handler) is - begin - Current_Clipboard_Notify := Func; - end Add_Clipboard_Notify; - - - procedure Remove_Clipboard_Notify - (Func : in Clipboard_Notify_Handler) is - begin - Current_Clipboard_Notify := null; - end Remove_Clipboard_Notify; - - - - - package FD_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, File_Handler); - function To_Address is new Ada.Unchecked_Conversion (File_Handler, System.Address); - end FD_Convert; - - procedure FD_Hook - (FD : in Interfaces.C.int; - U : in System.Address); - pragma Convention (C, FD_Hook); - - procedure FD_Hook - (FD : in Interfaces.C.int; - U : in System.Address) is - begin - FD_Convert.To_Pointer (U).all (File_Descriptor (FD)); - end FD_Hook; - - - procedure Add_File_Descriptor - (FD : in File_Descriptor; - Func : in File_Handler) is - begin - fl_static_add_fd - (Interfaces.C.int (FD), - FD_Hook'Address, - FD_Convert.To_Address (Func)); - end Add_File_Descriptor; - - - procedure Add_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode; - Func : in File_Handler) is - begin - fl_static_add_fd2 - (Interfaces.C.int (FD), - File_Mode_Codes (Mode), - FD_Hook'Address, - FD_Convert.To_Address (Func)); - end Add_File_Descriptor; - - - procedure Remove_File_Descriptor - (FD : in File_Descriptor) is - begin - fl_static_remove_fd (Interfaces.C.int (FD)); - end Remove_File_Descriptor; - - - procedure Remove_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode) is - begin - fl_static_remove_fd2 (Interfaces.C.int (FD), File_Mode_Codes (Mode)); - end Remove_File_Descriptor; - - - - - package Idle_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Idle_Handler); - function To_Address is new Ada.Unchecked_Conversion (Idle_Handler, System.Address); - end Idle_Convert; - - procedure Idle_Hook - (U : in System.Address); - pragma Convention (C, Idle_Hook); - - procedure Idle_Hook - (U : in System.Address) is - begin - Idle_Convert.To_Pointer (U).all; - end Idle_Hook; - - - procedure Add_Idle - (Func : in Idle_Handler) is - begin - fl_static_add_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)); - end Add_Idle; - - - function Has_Idle - (Func : in Idle_Handler) - return Boolean is - begin - return fl_static_has_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)) /= 0; - end Has_Idle; - - - procedure Remove_Idle - (Func : in Idle_Handler) is - begin - fl_static_remove_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)); - end Remove_Idle; - - - - - procedure Get_Color - (From : in Color; - R, G, B : out Color_Component) is - begin - fl_static_get_color - (Interfaces.C.unsigned (From), - Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Get_Color; - - - procedure Set_Color - (To : in Color; - R, G, B : in Color_Component) is - begin - fl_static_set_color - (Interfaces.C.unsigned (To), - Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Set_Color; - - - procedure Free_Color - (Value : in Color; - Overlay : in Boolean := False) is - begin - fl_static_free_color - (Interfaces.C.unsigned (Value), - Boolean'Pos (Overlay)); - end Free_Color; - - - procedure Set_Foreground - (R, G, B : in Color_Component) is - begin - fl_static_foreground - (Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Set_Foreground; - - - procedure Set_Background - (R, G, B : in Color_Component) is - begin - fl_static_background - (Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Set_Background; - - - procedure Set_Alt_Background - (R, G, B : in Color_Component) is - begin - fl_static_background2 - (Interfaces.C.unsigned_char (R), - Interfaces.C.unsigned_char (G), - Interfaces.C.unsigned_char (B)); - end Set_Alt_Background; - - - - - function Font_Image - (Kind : in Font_Kind) - return String is - begin - -- should never get a null string in return since it's from an enum - return Interfaces.C.Strings.Value (fl_static_get_font (Font_Kind'Pos (Kind))); - end Font_Image; - - - function Font_Family_Image - (Kind : in Font_Kind) - return String is - begin - -- should never get a null string in return since it's from an enum - return Interfaces.C.Strings.Value (fl_static_get_font_name (Font_Kind'Pos (Kind))); - end Font_Family_Image; - - - procedure Set_Font_Kind - (To, From : in Font_Kind) is - begin - fl_static_set_font (Font_Kind'Pos (To), Font_Kind'Pos (From)); - end Set_Font_Kind; - - - function Font_Sizes - (Kind : in Font_Kind) - return Font_Size_Array - is - Ptr : System.Address; - Arr : Font_Size_Array - (1 .. Integer (fl_static_get_font_sizes (Font_Kind'Pos (Kind), Ptr))); - begin - -- This array copying avoids any worry that the static buffer will be overwritten. - for I in 1 .. Arr'Length loop - Arr (I) := Font_Size (fl_static_font_size_array_get (Ptr, Interfaces.C.int (I))); - end loop; - return Arr; - end Font_Sizes; - - - procedure Setup_Fonts - (How_Many_Set_Up : out Natural) is - begin - How_Many_Set_Up := Natural (fl_static_set_fonts); - end Setup_Fonts; - - - - - function Get_Box_Height_Offset - (Kind : in Box_Kind) - return Integer is - begin - return Integer (fl_static_box_dh (Box_Kind'Pos (Kind))); - end Get_Box_Height_Offset; - - - function Get_Box_Width_Offset - (Kind : in Box_Kind) - return Integer is - begin - return Integer (fl_static_box_dw (Box_Kind'Pos (Kind))); - end Get_Box_Width_Offset; - - - function Get_Box_X_Offset - (Kind : in Box_Kind) - return Integer is - begin - return Integer (fl_static_box_dx (Box_Kind'Pos (Kind))); - end Get_Box_X_Offset; - - - function Get_Box_Y_Offset - (Kind : in Box_Kind) - return Integer is - begin - return Integer (fl_static_box_dy (Box_Kind'Pos (Kind))); - end Get_Box_Y_Offset; - - - procedure Set_Box_Kind - (To, From : in Box_Kind) is - begin - fl_static_set_boxtype (Box_Kind'Pos (To), Box_Kind'Pos (From)); - end Set_Box_Kind; - - - function Draw_Box_Active - return Boolean is - begin - return fl_static_draw_box_active /= 0; - end Draw_Box_Active; - - - -- function Get_Box_Draw_Function - -- (Kind : in Box_Kind) - -- return Box_Draw_Function is - -- begin - -- return null; - -- end Get_Box_Draw_Function; - - - -- procedure Set_Box_Draw_Function - -- (Kind : in Box_Kind; - -- Func : in Box_Draw_Function; - -- Offset_X, Offset_Y : in Integer := 0; - -- Offset_W, Offset_H : in Integer := 0) is - -- begin - -- null; - -- end Set_Box_Draw_Function; - - - - - procedure Copy - (Text : in String; - Dest : in Buffer_Kind) is - begin - fl_static_copy - (Interfaces.C.To_C (Text), - Text'Length, - Buffer_Kind'Pos (Dest)); - end Copy; - - - procedure Paste - (Receiver : in FLTK.Widgets.Widget'Class; - Source : in Buffer_Kind) is - begin - fl_static_paste - (Wrapper (Receiver).Void_Ptr, - Buffer_Kind'Pos (Source)); - end Paste; - - - procedure Selection - (Owner : in FLTK.Widgets.Widget'Class; - Text : in String) is - begin - fl_static_selection - (Wrapper (Owner).Void_Ptr, - Interfaces.C.To_C (Text), - Text'Length); - end Selection; - - - - - function Get_Drag_Drop_Text_Support - return Boolean is - begin - return fl_static_get_dnd_text_ops /= 0; - end Get_Drag_Drop_Text_Support; - - - procedure Set_Drag_Drop_Text_Support - (To : in Boolean) is - begin - fl_static_set_dnd_text_ops (Boolean'Pos (To)); - end Set_Drag_Drop_Text_Support; - - - - - function Has_Visible_Focus - return Boolean is - begin - return fl_static_get_visible_focus /= 0; - end Has_Visible_Focus; - - - procedure Set_Visible_Focus - (To : in Boolean) is - begin - fl_static_set_visible_focus (Boolean'Pos (To)); - end Set_Visible_Focus; - - - - - procedure Default_Window_Close - (Item : in out FLTK.Widgets.Widget'Class) is - begin - fl_static_default_atclose (Wrapper (Item).Void_Ptr); - end Default_Window_Close; - - - function Get_First_Window - return access FLTK.Widgets.Groups.Windows.Window'Class is - begin - return Window_Convert.To_Pointer - (fl_widget_get_user_data (fl_static_get_first_window)); - end Get_First_Window; - - - procedure Set_First_Window - (To : in FLTK.Widgets.Groups.Windows.Window'Class) is - begin - fl_static_set_first_window (Wrapper (To).Void_Ptr); - end Set_First_Window; - - - function Get_Next_Window - (From : in FLTK.Widgets.Groups.Windows.Window'Class) - return access FLTK.Widgets.Groups.Windows.Window'Class is - begin - return Window_Convert.To_Pointer - (fl_widget_get_user_data (fl_static_next_window (Wrapper (From).Void_Ptr))); - end Get_Next_Window; - - - function Get_Top_Modal - return access FLTK.Widgets.Groups.Windows.Window'Class is - begin - return Window_Convert.To_Pointer (fl_widget_get_user_data (fl_static_modal)); - end Get_Top_Modal; - - - - - function Read_Queue - return access FLTK.Widgets.Widget'Class is - begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_static_readqueue)); - end Read_Queue; - - - - - function Get_Scheme - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_static_get_scheme; - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Scheme; - - - procedure Set_Scheme - (To : in String) is - begin - fl_static_set_scheme (Interfaces.C.To_C (To)); - end Set_Scheme; - - - function Is_Scheme - (Scheme : in String) - return Boolean is - begin - return fl_static_is_scheme (Interfaces.C.To_C (Scheme)) /= 0; - end Is_Scheme; - - - - - function Get_Option - (Opt : in Option) - return Boolean is - begin - return fl_static_get_option (Option'Pos (Opt)) /= 0; - end Get_Option; - - - procedure Set_Option - (Opt : in Option; - To : in Boolean) is - begin - fl_static_set_option (Option'Pos (Opt), Boolean'Pos (To)); - end Set_Option; - - - - - function Get_Default_Scrollbar_Size - return Natural is - begin - return Natural (fl_static_get_scrollbar_size); - end Get_Default_Scrollbar_Size; - - - procedure Set_Default_Scrollbar_Size - (To : in Natural) is - begin - fl_static_set_scrollbar_size (Interfaces.C.int (To)); - end Set_Default_Scrollbar_Size; - - -begin - - - fl_static_add_clipboard_notify (Clipboard_Notify_Hook'Address, System.Null_Address); - - -end FLTK.Static; - diff --git a/src/fltk-static.ads b/src/fltk-static.ads deleted file mode 100644 index 238ef08..0000000 --- a/src/fltk-static.ads +++ /dev/null @@ -1,449 +0,0 @@ - - -with - - FLTK.Widgets.Groups.Windows; - -private with - - Interfaces.C; - - -package FLTK.Static is - - - type Awake_Handler is access procedure; - - type Timeout_Handler is access procedure; - - type Idle_Handler is access procedure; - - - - - type Buffer_Kind is (Selection, Clipboard); - - type Clipboard_Notify_Handler is access procedure - (Kind : in Buffer_Kind); - - - - - type File_Descriptor is new Integer; - - type File_Mode is (Read, Write, Except); - - type File_Handler is access procedure - (FD : in File_Descriptor); - - - - - type Box_Draw_Function is access procedure - (X, Y, W, H : in Integer; - My_Color : in Color); - - - - - type Option is - (Arrow_Focus, - Visible_Focus, - DND_Text, - Show_Tooltips, - FNFC_Uses_GTK, - Last); - - - - - procedure Add_Awake_Handler - (Func : in Awake_Handler); - - function Get_Awake_Handler - return Awake_Handler; - - - - - procedure Add_Check - (Func : in Timeout_Handler); - - function Has_Check - (Func : in Timeout_Handler) - return Boolean; - - procedure Remove_Check - (Func : in Timeout_Handler); - - - - - procedure Add_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); - - function Has_Timeout - (Func : in Timeout_Handler) - return Boolean; - - procedure Remove_Timeout - (Func : in Timeout_Handler); - - procedure Repeat_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); - - - - - procedure Add_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); - - procedure Remove_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); - - - - - procedure Add_File_Descriptor - (FD : in File_Descriptor; - Func : in File_Handler); - - procedure Add_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode; - Func : in File_Handler); - - procedure Remove_File_Descriptor - (FD : in File_Descriptor); - - procedure Remove_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode); - - - - - procedure Add_Idle - (Func : in Idle_Handler); - - function Has_Idle - (Func : in Idle_Handler) - return Boolean; - - procedure Remove_Idle - (Func : in Idle_Handler); - - - - - procedure Get_Color - (From : in Color; - R, G, B : out Color_Component); - - procedure Set_Color - (To : in Color; - R, G, B : in Color_Component); - - procedure Free_Color - (Value : in Color; - Overlay : in Boolean := False); - - procedure Own_Colormap; - - procedure Set_Foreground - (R, G, B : in Color_Component); - - procedure Set_Background - (R, G, B : in Color_Component); - - procedure Set_Alt_Background - (R, G, B : in Color_Component); - - procedure System_Colors; - - - - - function Font_Image - (Kind : in Font_Kind) - return String; - - function Font_Family_Image - (Kind : in Font_Kind) - return String; - - procedure Set_Font_Kind - (To, From : in Font_Kind); - - function Font_Sizes - (Kind : in Font_Kind) - return Font_Size_Array; - - procedure Setup_Fonts - (How_Many_Set_Up : out Natural); - - - - - function Get_Box_Height_Offset - (Kind : in Box_Kind) - return Integer; - - function Get_Box_Width_Offset - (Kind : in Box_Kind) - return Integer; - - function Get_Box_X_Offset - (Kind : in Box_Kind) - return Integer; - - function Get_Box_Y_Offset - (Kind : in Box_Kind) - return Integer; - - procedure Set_Box_Kind - (To, From : in Box_Kind); - - function Draw_Box_Active - return Boolean; - - -- function Get_Box_Draw_Function - -- (Kind : in Box_Kind) - -- return Box_Draw_Function; - - -- procedure Set_Box_Draw_Function - -- (Kind : in Box_Kind; - -- Func : in Box_Draw_Function; - -- Offset_X, Offset_Y : in Integer := 0; - -- Offset_W, Offset_H : in Integer := 0); - - - - - procedure Copy - (Text : in String; - Dest : in Buffer_Kind); - - procedure Paste - (Receiver : in FLTK.Widgets.Widget'Class; - Source : in Buffer_Kind); - - procedure Selection - (Owner : in FLTK.Widgets.Widget'Class; - Text : in String); - - - - - procedure Drag_Drop_Start; - - function Get_Drag_Drop_Text_Support - return Boolean; - - procedure Set_Drag_Drop_Text_Support - (To : in Boolean); - - - - - procedure Enable_System_Input; - - procedure Disable_System_Input; - - function Has_Visible_Focus - return Boolean; - - procedure Set_Visible_Focus - (To : in Boolean); - - - - - procedure Default_Window_Close - (Item : in out FLTK.Widgets.Widget'Class); - - function Get_First_Window - return access FLTK.Widgets.Groups.Windows.Window'Class; - - procedure Set_First_Window - (To : in FLTK.Widgets.Groups.Windows.Window'Class); - - function Get_Next_Window - (From : in FLTK.Widgets.Groups.Windows.Window'Class) - return access FLTK.Widgets.Groups.Windows.Window'Class; - - function Get_Top_Modal - return access FLTK.Widgets.Groups.Windows.Window'Class; - - - - - function Read_Queue - return access FLTK.Widgets.Widget'Class; - - procedure Do_Widget_Deletion; - - - - - function Get_Scheme - return String; - - procedure Set_Scheme - (To : in String); - - function Is_Scheme - (Scheme : in String) - return Boolean; - - procedure Reload_Scheme; - - - - - function Get_Option - (Opt : in Option) - return Boolean; - - procedure Set_Option - (Opt : in Option; - To : in Boolean); - - - - - function Get_Default_Scrollbar_Size - return Natural; - - procedure Set_Default_Scrollbar_Size - (To : in Natural); - - -private - - - File_Mode_Codes : array (File_Mode) of Interfaces.C.int := - (Read => 1, Write => 4, Except => 8); - - - - - pragma Import (C, Own_Colormap, "fl_static_own_colormap"); - pragma Import (C, System_Colors, "fl_static_get_system_colors"); - - - pragma Import (C, Drag_Drop_Start, "fl_static_dnd"); - - - pragma Import (C, Enable_System_Input, "fl_static_enable_im"); - pragma Import (C, Disable_System_Input, "fl_static_disable_im"); - - - pragma Import (C, Do_Widget_Deletion, "fl_static_do_widget_deletion"); - - - pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); - - - - - pragma Inline (Add_Awake_Handler); - pragma Inline (Get_Awake_Handler); - - - pragma Inline (Add_Check); - pragma Inline (Has_Check); - pragma Inline (Remove_Check); - - - pragma Inline (Add_Timeout); - pragma Inline (Has_Timeout); - pragma Inline (Remove_Timeout); - pragma Inline (Repeat_Timeout); - - - pragma Inline (Add_Clipboard_Notify); - pragma Inline (Remove_Clipboard_Notify); - - - pragma Inline (Add_File_Descriptor); - pragma Inline (Remove_File_Descriptor); - - - pragma Inline (Add_Idle); - pragma Inline (Has_Idle); - pragma Inline (Remove_Idle); - - - pragma Inline (Get_Color); - pragma Inline (Set_Color); - pragma Inline (Free_Color); - pragma Inline (Own_Colormap); - pragma Inline (Set_Foreground); - pragma Inline (Set_Background); - pragma Inline (Set_Alt_Background); - pragma Inline (System_Colors); - - - pragma Inline (Font_Image); - pragma Inline (Font_Family_Image); - pragma Inline (Set_Font_Kind); - pragma Inline (Font_Sizes); - pragma Inline (Setup_Fonts); - - - pragma Inline (Get_Box_Height_Offset); - pragma Inline (Get_Box_Width_Offset); - pragma Inline (Get_Box_X_Offset); - pragma Inline (Get_Box_Y_Offset); - pragma Inline (Set_Box_Kind); - pragma Inline (Draw_Box_Active); - -- pragma Inline (Get_Box_Draw_Function); - -- pragma Inline (Set_Box_Draw_Function); - - - pragma Inline (Copy); - pragma Inline (Paste); - pragma Inline (Selection); - - - pragma Inline (Drag_Drop_Start); - pragma Inline (Get_Drag_Drop_Text_Support); - pragma Inline (Set_Drag_Drop_Text_Support); - - - pragma Inline (Enable_System_Input); - pragma Inline (Disable_System_Input); - pragma Inline (Has_Visible_Focus); - pragma Inline (Set_Visible_Focus); - - - pragma Inline (Default_Window_Close); - pragma Inline (Get_First_Window); - pragma Inline (Set_First_Window); - pragma Inline (Get_Next_Window); - pragma Inline (Get_Top_Modal); - - - pragma Inline (Read_Queue); - pragma Inline (Do_Widget_Deletion); - - - pragma Inline (Get_Scheme); - pragma Inline (Set_Scheme); - pragma Inline (Is_Scheme); - pragma Inline (Reload_Scheme); - - - pragma Inline (Get_Option); - pragma Inline (Set_Option); - - - pragma Inline (Get_Default_Scrollbar_Size); - pragma Inline (Set_Default_Scrollbar_Size); - - -end FLTK.Static; - diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb deleted file mode 100644 index d41e4fe..0000000 --- a/src/fltk-text_buffers.adb +++ /dev/null @@ -1,1349 +0,0 @@ - - -with - - Interfaces.C.Strings, - Ada.Strings.Unbounded, - Ada.Containers, - System; - -use - - Ada.Strings.Unbounded; - -use type - - System.Address, - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - Ada.Containers.Count_Type; - - -package body FLTK.Text_Buffers is - - - function new_fl_text_buffer - (RS, PGS : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); - pragma Inline (new_fl_text_buffer); - - procedure free_fl_text_buffer - (TB : in System.Address); - pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); - pragma Inline (free_fl_text_buffer); - - - - - procedure fl_text_buffer_add_modify_callback - (TB, CB, UD : in System.Address); - pragma Import (C, fl_text_buffer_add_modify_callback, - "fl_text_buffer_add_modify_callback"); - pragma Inline (fl_text_buffer_add_modify_callback); - - procedure fl_text_buffer_add_predelete_callback - (TB, CB, UD : in System.Address); - pragma Import (C, fl_text_buffer_add_predelete_callback, - "fl_text_buffer_add_predelete_callback"); - pragma Inline (fl_text_buffer_add_predelete_callback); - - procedure fl_text_buffer_call_modify_callbacks - (TB : in System.Address); - pragma Import (C, fl_text_buffer_call_modify_callbacks, - "fl_text_buffer_call_modify_callbacks"); - pragma Inline (fl_text_buffer_call_modify_callbacks); - - procedure fl_text_buffer_call_predelete_callbacks - (TB : in System.Address); - pragma Import (C, fl_text_buffer_call_predelete_callbacks, - "fl_text_buffer_call_predelete_callbacks"); - pragma Inline (fl_text_buffer_call_predelete_callbacks); - - - - - function fl_text_buffer_loadfile - (TB : in System.Address; - N : in Interfaces.C.char_array; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); - pragma Inline (fl_text_buffer_loadfile); - - function fl_text_buffer_appendfile - (TB : in System.Address; - N : in Interfaces.C.char_array; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_appendfile, "fl_text_buffer_appendfile"); - pragma Inline (fl_text_buffer_appendfile); - - function fl_text_buffer_insertfile - (TB : in System.Address; - N : in Interfaces.C.char_array; - P, B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_insertfile, "fl_text_buffer_insertfile"); - pragma Inline (fl_text_buffer_insertfile); - - function fl_text_buffer_outputfile - (TB : in System.Address; - N : in Interfaces.C.char_array; - F, T : in Interfaces.C.int; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_outputfile, "fl_text_buffer_outputfile"); - pragma Inline (fl_text_buffer_outputfile); - - function fl_text_buffer_savefile - (TB : in System.Address; - N : in Interfaces.C.char_array; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); - pragma Inline (fl_text_buffer_savefile); - - - - - procedure fl_text_buffer_insert - (TB : in System.Address; - P : in Interfaces.C.int; - I : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); - pragma Inline (fl_text_buffer_insert); - - procedure fl_text_buffer_append - (TB : in System.Address; - I : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_append, "fl_text_buffer_append"); - pragma Inline (fl_text_buffer_append); - - procedure fl_text_buffer_replace - (TB : in System.Address; - S, F : in Interfaces.C.int; - T : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_replace, "fl_text_buffer_replace"); - pragma Inline (fl_text_buffer_replace); - - procedure fl_text_buffer_remove - (TB : in System.Address; - S, F : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); - pragma Inline (fl_text_buffer_remove); - - function fl_text_buffer_get_text - (TB : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_get_text, "fl_text_buffer_get_text"); - pragma Inline (fl_text_buffer_get_text); - - procedure fl_text_buffer_set_text - (TB : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_set_text, "fl_text_buffer_set_text"); - pragma Inline (fl_text_buffer_set_text); - - function fl_text_buffer_byte_at - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.char; - pragma Import (C, fl_text_buffer_byte_at, "fl_text_buffer_byte_at"); - pragma Inline (fl_text_buffer_byte_at); - - function fl_text_buffer_char_at - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); - pragma Inline (fl_text_buffer_char_at); - - function fl_text_buffer_text_range - (TB : in System.Address; - S, F : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); - pragma Inline (fl_text_buffer_text_range); - - function fl_text_buffer_next_char - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_next_char, "fl_text_buffer_next_char"); - pragma Inline (fl_text_buffer_next_char); - - function fl_text_buffer_prev_char - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_prev_char, "fl_text_buffer_prev_char"); - pragma Inline (fl_text_buffer_prev_char); - - - - - function fl_text_buffer_count_displayed_characters - (TB : in System.Address; - S, F : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_count_displayed_characters, - "fl_text_buffer_count_displayed_characters"); - pragma Inline (fl_text_buffer_count_displayed_characters); - - function fl_text_buffer_count_lines - (TB : in System.Address; - S, F : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_count_lines, "fl_text_buffer_count_lines"); - pragma Inline (fl_text_buffer_count_lines); - - function fl_text_buffer_length - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); - pragma Inline (fl_text_buffer_length); - - function fl_text_buffer_get_tab_distance - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_get_tab_distance, "fl_text_buffer_get_tab_distance"); - pragma Inline (fl_text_buffer_get_tab_distance); - - procedure fl_text_buffer_set_tab_distance - (TB : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_set_tab_distance, "fl_text_buffer_set_tab_distance"); - pragma Inline (fl_text_buffer_set_tab_distance); - - - - - function fl_text_buffer_selection_position - (TB : in System.Address; - S, E : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); - pragma Inline (fl_text_buffer_selection_position); - - function fl_text_buffer_secondary_selection_position - (TB : in System.Address; - S, E : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_secondary_selection_position, - "fl_text_buffer_secondary_selection_position"); - pragma Inline (fl_text_buffer_secondary_selection_position); - - procedure fl_text_buffer_select - (TB : in System.Address; - S, E : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); - pragma Inline (fl_text_buffer_select); - - procedure fl_text_buffer_secondary_select - (TB : in System.Address; - S, E : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_secondary_select, "fl_text_buffer_secondary_select"); - pragma Inline (fl_text_buffer_secondary_select); - - function fl_text_buffer_selected - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); - pragma Inline (fl_text_buffer_selected); - - function fl_text_buffer_secondary_selected - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_secondary_selected, "fl_text_buffer_secondary_selected"); - pragma Inline (fl_text_buffer_secondary_selected); - - function fl_text_buffer_selection_text - (TB : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_selection_text, "fl_text_buffer_selection_text"); - pragma Inline (fl_text_buffer_selection_text); - - function fl_text_buffer_secondary_selection_text - (TB : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_secondary_selection_text, - "fl_text_buffer_secondary_selection_text"); - pragma Inline (fl_text_buffer_secondary_selection_text); - - procedure fl_text_buffer_replace_selection - (TB : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_replace_selection, "fl_text_buffer_replace_selection"); - pragma Inline (fl_text_buffer_replace_selection); - - procedure fl_text_buffer_replace_secondary_selection - (TB : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_replace_secondary_selection, - "fl_text_buffer_replace_secondary_selection"); - pragma Inline (fl_text_buffer_replace_secondary_selection); - - procedure fl_text_buffer_remove_selection - (TB : in System.Address); - pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); - pragma Inline (fl_text_buffer_remove_selection); - - procedure fl_text_buffer_remove_secondary_selection - (TB : in System.Address); - pragma Import (C, fl_text_buffer_remove_secondary_selection, - "fl_text_buffer_remove_secondary_selection"); - pragma Inline (fl_text_buffer_remove_secondary_selection); - - procedure fl_text_buffer_unselect - (TB : in System.Address); - pragma Import (C, fl_text_buffer_unselect, "fl_text_buffer_unselect"); - pragma Inline (fl_text_buffer_unselect); - - procedure fl_text_buffer_secondary_unselect - (TB : in System.Address); - pragma Import (C, fl_text_buffer_secondary_unselect, "fl_text_buffer_secondary_unselect"); - pragma Inline (fl_text_buffer_secondary_unselect); - - - - - procedure fl_text_buffer_highlight - (TB : in System.Address; - F, T : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_highlight, "fl_text_buffer_highlight"); - pragma Inline (fl_text_buffer_highlight); - - function fl_text_buffer_highlight_text - (TB : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_highlight_text, "fl_text_buffer_highlight_text"); - pragma Inline (fl_text_buffer_highlight_text); - - procedure fl_text_buffer_unhighlight - (TB : in System.Address); - pragma Import (C, fl_text_buffer_unhighlight, "fl_text_buffer_unhighlight"); - pragma Inline (fl_text_buffer_unhighlight); - - - - - function fl_text_buffer_findchar_forward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.unsigned; - FP : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_findchar_forward, "fl_text_buffer_findchar_forward"); - pragma Inline (fl_text_buffer_findchar_forward); - - function fl_text_buffer_findchar_backward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.unsigned; - FP : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_findchar_backward, "fl_text_buffer_findchar_backward"); - pragma Inline (fl_text_buffer_findchar_backward); - - function fl_text_buffer_search_forward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.char_array; - FP : out Interfaces.C.int; - CA : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); - pragma Inline (fl_text_buffer_search_forward); - - function fl_text_buffer_search_backward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.char_array; - FP : out Interfaces.C.int; - CA : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); - pragma Inline (fl_text_buffer_search_backward); - - - - - function fl_text_buffer_word_start - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_word_start, "fl_text_buffer_word_start"); - pragma Inline (fl_text_buffer_word_start); - - function fl_text_buffer_word_end - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_word_end, "fl_text_buffer_word_end"); - pragma Inline (fl_text_buffer_word_end); - - function fl_text_buffer_line_start - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_line_start, "fl_text_buffer_line_start"); - pragma Inline (fl_text_buffer_line_start); - - function fl_text_buffer_line_end - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_line_end, "fl_text_buffer_line_end"); - pragma Inline (fl_text_buffer_line_end); - - function fl_text_buffer_line_text - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_line_text, "fl_text_buffer_line_text"); - pragma Inline (fl_text_buffer_line_text); - - function fl_text_buffer_skip_lines - (TB : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); - pragma Inline (fl_text_buffer_skip_lines); - - function fl_text_buffer_rewind_lines - (TB : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); - pragma Inline (fl_text_buffer_rewind_lines); - - function fl_text_buffer_skip_displayed_characters - (TB : in System.Address; - S, N : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_skip_displayed_characters, - "fl_text_buffer_skip_displayed_characters"); - pragma Inline (fl_text_buffer_skip_displayed_characters); - - - - - procedure fl_text_buffer_canundo - (TB : in System.Address; - F : in Interfaces.C.char); - pragma Import (C, fl_text_buffer_canundo, "fl_text_buffer_canundo"); - pragma Inline (fl_text_buffer_canundo); - - procedure fl_text_buffer_copy - (TB, TB2 : in System.Address; - S, F, I : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_copy, "fl_text_buffer_copy"); - pragma Inline (fl_text_buffer_copy); - - function fl_text_buffer_utf8_align - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_utf8_align, "fl_text_buffer_utf8_align"); - pragma Inline (fl_text_buffer_utf8_align); - - - - - procedure Modify_Callback_Hook - (Pos : in Interfaces.C.int; - Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address) - is - Action : Modification; - Place : Position := Position (Pos); - Length : Natural; - Deleted_Text : Unbounded_String := To_Unbounded_String (""); - - Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); - begin - if Ada_Text_Buffer.CB_Active then - if Inserted > 0 then - Length := Natural (Inserted); - Action := Insert; - elsif Deleted > 0 then - Length := Natural (Deleted); - Action := Delete; - if Text /= Interfaces.C.Strings.Null_Ptr then - Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); - end if; - elsif Restyled > 0 then - Length := Natural (Restyled); - Action := Restyle; - else - Length := 0; - Action := None; - end if; - - for CB of Ada_Text_Buffer.Modify_CBs loop - CB.all (Action, Place, Length, To_String (Deleted_Text)); - end loop; - end if; - end Modify_Callback_Hook; - - - procedure Predelete_Callback_Hook - (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address) - is - Place : Position := Position (Pos); - Length : Natural := Natural (Deleted); - - Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); - begin - if Ada_Text_Buffer.CB_Active then - for CB of Ada_Text_Buffer.Predelete_CBs loop - CB.all (Place, Length); - end loop; - end if; - end Predelete_Callback_Hook; - - - - - procedure Finalize - (This : in out Text_Buffer) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Text_Buffer'Class - then - free_fl_text_buffer (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - end Finalize; - - - - - package body Forge is - - function Create - (Requested_Size : in Natural := 0; - Preferred_Gap_Size : in Natural := 1024) - return Text_Buffer is - begin - return This : Text_Buffer do - This.Void_Ptr := new_fl_text_buffer - (Interfaces.C.int (Requested_Size), - Interfaces.C.int (Preferred_Gap_Size)); - - This.Modify_CBs := Modify_Vectors.Empty_Vector; - This.Predelete_CBs := Predelete_Vectors.Empty_Vector; - This.CB_Active := True; - - fl_text_buffer_add_modify_callback - (This.Void_Ptr, - Modify_Callback_Hook'Address, - This'Address); - fl_text_buffer_add_predelete_callback - (This.Void_Ptr, - Predelete_Callback_Hook'Address, - This'Address); - end return; - end Create; - - end Forge; - - - - - procedure Add_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback) is - begin - This.Modify_CBs.Append (Func); - end Add_Modify_Callback; - - - procedure Add_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback) is - begin - This.Predelete_CBs.Append (Func); - end Add_Predelete_Callback; - - - procedure Remove_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback) is - begin - for I in reverse This.Modify_CBs.First_Index .. This.Modify_CBs.Last_Index loop - if This.Modify_CBs.Element (I) = Func then - This.Modify_CBs.Delete (I); - return; - end if; - end loop; - end Remove_Modify_Callback; - - - procedure Remove_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback) is - begin - for I in reverse This.Predelete_CBs.First_Index .. This.Predelete_CBs.Last_Index loop - if This.Predelete_CBs.Element (I) = Func then - This.Predelete_CBs.Delete (I); - return; - end if; - end loop; - end Remove_Predelete_Callback; - - - procedure Call_Modify_Callbacks - (This : in out Text_Buffer) is - begin - fl_text_buffer_call_modify_callbacks (This.Void_Ptr); - end Call_Modify_Callbacks; - - - procedure Call_Predelete_Callbacks - (This : in out Text_Buffer) is - begin - fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); - end Call_Predelete_Callbacks; - - - procedure Enable_Callbacks - (This : in out Text_Buffer) is - begin - This.CB_Active := True; - end Enable_Callbacks; - - - procedure Disable_Callbacks - (This : in out Text_Buffer) is - begin - This.CB_Active := False; - end Disable_Callbacks; - - - - - procedure Load_File - (This : in out Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024) - is - Err_No : Interfaces.C.int := fl_text_buffer_loadfile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Buffer)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Load_File; - - - procedure Append_File - (This : in out Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024) - is - Err_No : Interfaces.C.int := fl_text_buffer_appendfile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Buffer)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Append_File; - - - procedure Insert_File - (This : in out Text_Buffer; - Name : in String; - Place : in Position; - Buffer : in Natural := 128 * 1024) - is - Err_No : Interfaces.C.int := fl_text_buffer_insertfile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Place), - Interfaces.C.int (Buffer)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Insert_File; - - - procedure Output_File - (This : in Text_Buffer; - Name : in String; - Start, Finish : in Position; - Buffer : in Natural := 128 * 1024) - is - Err_No : Interfaces.C.int := fl_text_buffer_outputfile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Start), - Interfaces.C.int (Finish), - Interfaces.C.int (Buffer)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Output_File; - - - procedure Save_File - (This : in Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024) - is - Err_No : Interfaces.C.int := fl_text_buffer_savefile - (This.Void_Ptr, - Interfaces.C.To_C (Name), - Interfaces.C.int (Buffer)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Save_File; - - - - - procedure Insert_Text - (This : in out Text_Buffer; - Place : in Position; - Text : in String) is - begin - fl_text_buffer_insert - (This.Void_Ptr, - Interfaces.C.int (Place), - Interfaces.C.To_C (Text)); - end Insert_Text; - - - procedure Append_Text - (This : in out Text_Buffer; - Text : in String) is - begin - fl_text_buffer_append - (This.Void_Ptr, - Interfaces.C.To_C (Text)); - end Append_Text; - - - procedure Replace_Text - (This : in out Text_Buffer; - Start, Finish : in Position; - Text : in String) is - begin - fl_text_buffer_replace - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish), - Interfaces.C.To_C (Text)); - end Replace_Text; - - - procedure Remove_Text - (This : in out Text_Buffer; - Start, Finish : in Position) is - begin - fl_text_buffer_remove - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Remove_Text; - - - function Get_Entire_Text - (This : in Text_Buffer) - return String - is - Raw : Interfaces.C.Strings.chars_ptr := - fl_text_buffer_get_text (This.Void_Ptr); - begin - if Raw = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); - begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; - end; - end if; - end Get_Entire_Text; - - - procedure Set_Entire_Text - (This : in out Text_Buffer; - Text : in String) is - begin - fl_text_buffer_set_text (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Entire_Text; - - - function Byte_At - (This : in Text_Buffer; - Place : in Position) - return Character is - begin - return Character'Val (Interfaces.C.char'Pos - (fl_text_buffer_byte_at (This.Void_Ptr, Interfaces.C.int (Place)))); - end Byte_At; - - - function Character_At - (This : in Text_Buffer; - Place : in Position) - return Character is - begin - return Character'Val (fl_text_buffer_char_at - (This.Void_Ptr, - Interfaces.C.int (Place))); - end Character_At; - - - function Text_At - (This : in Text_Buffer; - Start, Finish : in Position) - return String - is - C_Str : Interfaces.C.Strings.chars_ptr := fl_text_buffer_text_range - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - begin - if C_Str = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - The_Text : String := Interfaces.C.Strings.Value (C_Str); - begin - Interfaces.C.Strings.Free (C_Str); - return The_Text; - end; - end if; - end Text_At; - - - function Next_Char - (This : in Text_Buffer; - Place : in Position) - return Character is - begin - return Character'Val (fl_text_buffer_next_char - (This.Void_Ptr, - Interfaces.C.int (Place))); - end Next_Char; - - - function Prev_Char - (This : in Text_Buffer; - Place : in Position) - return Character is - begin - return Character'Val (fl_text_buffer_prev_char - (This.Void_Ptr, - Interfaces.C.int (Place))); - end Prev_Char; - - - - - function Count_Displayed_Characters - (This : in Text_Buffer; - Start, Finish : in Position) - return Integer is - begin - return Integer (fl_text_buffer_count_displayed_characters - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish))); - end Count_Displayed_Characters; - - - function Count_Lines - (This : in Text_Buffer; - Start, Finish : in Position) - return Integer is - begin - return Integer (fl_text_buffer_count_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish))); - end Count_Lines; - - - function Length - (This : in Text_Buffer) - return Natural is - begin - return Natural (fl_text_buffer_length (This.Void_Ptr)); - end Length; - - - function Get_Tab_Width - (This : in Text_Buffer) - return Natural is - begin - return Natural (fl_text_buffer_get_tab_distance (This.Void_Ptr)); - end Get_Tab_Width; - - - procedure Set_Tab_Width - (This : in out Text_Buffer; - To : in Natural) is - begin - fl_text_buffer_set_tab_distance (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Tab_Width; - - - - - function Get_Selection - (This : in Text_Buffer; - Start, Finish : out Position) - return Boolean - is - S, F : Interfaces.C.int; - begin - if fl_text_buffer_selection_position (This.Void_Ptr, S, F) /= 0 then - Start := Position (S); - Finish := Position (F); - return True; - else - return False; - end if; - end Get_Selection; - - - function Get_Secondary_Selection - (This : in Text_Buffer; - Start, Finish : out Position) - return Boolean - is - S, F : Interfaces.C.int; - begin - if fl_text_buffer_secondary_selection_position (This.Void_Ptr, S, F) /= 0 then - Start := Position (S); - Finish := Position (F); - return True; - else - return False; - end if; - end Get_Secondary_Selection; - - - procedure Set_Selection - (This : in out Text_Buffer; - Start, Finish : in Position) is - begin - fl_text_buffer_select - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Set_Selection; - - - procedure Set_Secondary_Selection - (This : in out Text_Buffer; - Start, Finish : in Position) is - begin - fl_text_buffer_secondary_select - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Set_Secondary_Selection; - - - function Has_Selection - (This : in Text_Buffer) - return Boolean is - begin - return fl_text_buffer_selected (This.Void_Ptr) /= 0; - end Has_Selection; - - - function Has_Secondary_Selection - (This : in Text_Buffer) - return Boolean is - begin - return fl_text_buffer_secondary_selected (This.Void_Ptr) /= 0; - end Has_Secondary_Selection; - - - function Selection_Text - (This : in Text_Buffer) - return String - is - Raw : Interfaces.C.Strings.chars_ptr := - fl_text_buffer_selection_text (This.Void_Ptr); - begin - if Raw = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); - begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; - end; - end if; - end Selection_Text; - - - function Secondary_Selection_Text - (This : in Text_Buffer) - return String - is - Raw : Interfaces.C.Strings.chars_ptr := - fl_text_buffer_secondary_selection_text (This.Void_Ptr); - begin - if Raw = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); - begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; - end; - end if; - end Secondary_Selection_Text; - - - procedure Replace_Selection - (This : in out Text_Buffer; - Text : in String) is - begin - fl_text_buffer_replace_selection (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Replace_Selection; - - - procedure Replace_Secondary_Selection - (This : in out Text_Buffer; - Text : in String) is - begin - fl_text_buffer_replace_secondary_selection (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Replace_Secondary_Selection; - - - procedure Remove_Selection - (This : in out Text_Buffer) is - begin - fl_text_buffer_remove_selection (This.Void_Ptr); - end Remove_Selection; - - - procedure Remove_Secondary_Selection - (This : in out Text_Buffer) is - begin - fl_text_buffer_remove_secondary_selection (This.Void_Ptr); - end Remove_Secondary_Selection; - - - procedure Unselect - (This : in out Text_Buffer) is - begin - fl_text_buffer_unselect (This.Void_Ptr); - end Unselect; - - - procedure Secondary_Unselect - (This : in out Text_Buffer) is - begin - fl_text_buffer_secondary_unselect (This.Void_Ptr); - end Secondary_Unselect; - - - - - procedure Get_Highlight - (This : in Text_Buffer; - Start, Finish : out Position) is - begin - Start := This.High_From; - Finish := This.High_To; - end Get_Highlight; - - - procedure Set_Highlight - (This : in out Text_Buffer; - Start, Finish : in Position) is - begin - This.High_From := Start; - This.High_To := Finish; - fl_text_buffer_highlight - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Set_Highlight; - - - function Get_Highlighted_Text - (This : in Text_Buffer) - return String - is - Raw : Interfaces.C.Strings.chars_ptr := - fl_text_buffer_highlight_text (This.Void_Ptr); - begin - if Raw = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); - begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; - end; - end if; - end Get_Highlighted_Text; - - - procedure Unhighlight - (This : in out Text_Buffer) is - begin - fl_text_buffer_unhighlight (This.Void_Ptr); - end Unhighlight; - - - - - function Findchar_Forward - (This : in Text_Buffer; - Start_At : in Position; - Item : in Character; - Found_At : out Position) - return Boolean - is - Place : Interfaces.C.int; - begin - if fl_text_buffer_findchar_forward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Character'Pos (Item), - Place) /= 0 - then - Found_At := Position (Place); - return True; - else - return False; - end if; - end Findchar_Forward; - - - function Findchar_Backward - (This : in Text_Buffer; - Start_At : in Position; - Item : in Character; - Found_At : out Position) - return Boolean - is - Place : Interfaces.C.int; - begin - if fl_text_buffer_findchar_backward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Character'Pos (Item), - Place) /= 0 - then - Found_At := Position (Place); - return True; - else - return False; - end if; - end Findchar_Backward; - - - function Search_Forward - (This : in Text_Buffer; - Start_At : in Position; - Item : in String; - Found_At : out Position; - Match_Case : in Boolean := False) - return Boolean - is - Place : Interfaces.C.int; - begin - if fl_text_buffer_search_forward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Interfaces.C.To_C (Item), - Place, - Boolean'Pos (Match_Case)) /= 0 - then - Found_At := Position (Place); - return True; - else - return False; - end if; - end Search_Forward; - - - function Search_Backward - (This : in Text_Buffer; - Start_At : in Position; - Item : in String; - Found_At : out Position; - Match_Case : in Boolean := False) - return Boolean - is - Place : Interfaces.C.int; - begin - if fl_text_buffer_search_backward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Interfaces.C.To_C (Item), - Place, - Boolean'Pos (Match_Case)) /= 0 - then - Found_At := Position (Place); - return True; - else - return False; - end if; - end Search_Backward; - - - - - function Word_Start - (This : in Text_Buffer; - Place : in Position) - return Position is - begin - return Position (fl_text_buffer_word_start (This.Void_Ptr, Interfaces.C.int (Place))); - end Word_Start; - - - function Word_End - (This : in Text_Buffer; - Place : in Position) - return Position is - begin - return Position (fl_text_buffer_word_end (This.Void_Ptr, Interfaces.C.int (Place))); - end Word_End; - - - function Line_Start - (This : in Text_Buffer; - Place : in Position) - return Position is - begin - return Position (fl_text_buffer_line_start (This.Void_Ptr, Interfaces.C.int (Place))); - end Line_Start; - - - function Line_End - (This : in Text_Buffer; - Place : in Position) - return Position is - begin - return Position (fl_text_buffer_line_end (This.Void_Ptr, Interfaces.C.int (Place))); - end Line_End; - - - function Line_Text - (This : in Text_Buffer; - Place : in Position) - return String - is - Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_line_text - (This.Void_Ptr, - Interfaces.C.int (Place)); - begin - if Raw = Interfaces.C.Strings.Null_Ptr then - return ""; - else - declare - Ada_String : String := Interfaces.C.Strings.Value (Raw); - begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; - end; - end if; - end Line_Text; - - - function Skip_Lines - (This : in out Text_Buffer; - Start : in Position; - Lines : in Natural) - return Position is - begin - return Natural (fl_text_buffer_skip_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); - end Skip_Lines; - - - function Rewind_Lines - (This : in out Text_Buffer; - Start : in Position; - Lines : in Natural) - return Position is - begin - return Natural (fl_text_buffer_rewind_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); - end Rewind_Lines; - - - function Skip_Displayed_Characters - (This : in Text_Buffer; - Start : in Position; - Chars : in Natural) - return Position is - begin - return Natural (fl_text_buffer_skip_displayed_characters - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Chars))); - end Skip_Displayed_Characters; - - - - - procedure Can_Undo - (This : in out Text_Buffer; - Flag : in Boolean) is - begin - fl_text_buffer_canundo (This.Void_Ptr, Interfaces.C.char'Val (Boolean'Pos (Flag))); - end Can_Undo; - - - procedure Copy - (This : in out Text_Buffer; - From : in Text_Buffer; - Start, Finish : in Position; - Insert_Pos : in Position) is - begin - fl_text_buffer_copy - (This.Void_Ptr, - From.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish), - Interfaces.C.int (Insert_Pos)); - end Copy; - - - function UTF8_Align - (This : in Text_Buffer; - Place : in Position) - return Position is - begin - return Position (fl_text_buffer_utf8_align (This.Void_Ptr, Interfaces.C.int (Place))); - end UTF8_Align; - - -end FLTK.Text_Buffers; - diff --git a/src/fltk-text_buffers.ads b/src/fltk-text_buffers.ads deleted file mode 100644 index 956c03e..0000000 --- a/src/fltk-text_buffers.ads +++ /dev/null @@ -1,486 +0,0 @@ - - -private with - - Ada.Containers.Vectors, - System.Address_To_Access_Conversions, - Interfaces.C.Strings; - - -package FLTK.Text_Buffers is - - - type Text_Buffer is new Wrapper with private; - - type Text_Buffer_Reference (Data : access Text_Buffer'Class) is limited null record - with Implicit_Dereference => Data; - - subtype Position is Natural; - - type Modification is (Insert, Restyle, Delete, None); - - type Modify_Callback is access procedure - (Action : in Modification; - Place : in Position; - Length : in Natural; - Deleted_Text : in String); - - type Predelete_Callback is access procedure - (Place : in Position; - Length : in Natural); - - - - - package Forge is - - function Create - (Requested_Size : in Natural := 0; - Preferred_Gap_Size : in Natural := 1024) - return Text_Buffer; - - end Forge; - - - - - procedure Add_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback); - - procedure Add_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback); - - procedure Remove_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback); - - procedure Remove_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback); - - procedure Call_Modify_Callbacks - (This : in out Text_Buffer); - - procedure Call_Predelete_Callbacks - (This : in out Text_Buffer); - - procedure Enable_Callbacks - (This : in out Text_Buffer); - - procedure Disable_Callbacks - (This : in out Text_Buffer); - - - - - procedure Load_File - (This : in out Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024); - - procedure Append_File - (This : in out Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024); - - procedure Insert_File - (This : in out Text_Buffer; - Name : in String; - Place : in Position; - Buffer : in Natural := 128 * 1024); - - procedure Output_File - (This : in Text_Buffer; - Name : in String; - Start, Finish : in Position; - Buffer : in Natural := 128 * 1024); - - procedure Save_File - (This : in Text_Buffer; - Name : in String; - Buffer : in Natural := 128 * 1024); - - - - - procedure Insert_Text - (This : in out Text_Buffer; - Place : in Position; - Text : in String); - - procedure Append_Text - (This : in out Text_Buffer; - Text : in String); - - procedure Replace_Text - (This : in out Text_Buffer; - Start, Finish : in Position; - Text : in String); - - procedure Remove_Text - (This : in out Text_Buffer; - Start, Finish : in Position); - - function Get_Entire_Text - (This : in Text_Buffer) - return String; - - procedure Set_Entire_Text - (This : in out Text_Buffer; - Text : in String); - - function Byte_At - (This : in Text_Buffer; - Place : in Position) - return Character; - - function Character_At - (This : in Text_Buffer; - Place : in Position) - return Character; - - function Text_At - (This : in Text_Buffer; - Start, Finish : in Position) - return String; - - function Next_Char - (This : in Text_Buffer; - Place : in Position) - return Character; - - function Prev_Char - (This : in Text_Buffer; - Place : in Position) - return Character; - - - - - function Count_Displayed_Characters - (This : in Text_Buffer; - Start, Finish : in Position) - return Integer; - - function Count_Lines - (This : in Text_Buffer; - Start, Finish : in Position) - return Integer; - - function Length - (This : in Text_Buffer) - return Natural; - - function Get_Tab_Width - (This : in Text_Buffer) - return Natural; - - procedure Set_Tab_Width - (This : in out Text_Buffer; - To : in Natural); - - - - - function Get_Selection - (This : in Text_Buffer; - Start, Finish : out Position) - return Boolean; - - function Get_Secondary_Selection - (This : in Text_Buffer; - Start, Finish : out Position) - return Boolean; - - procedure Set_Selection - (This : in out Text_Buffer; - Start, Finish : in Position); - - procedure Set_Secondary_Selection - (This : in out Text_Buffer; - Start, Finish : in Position); - - function Has_Selection - (This : in Text_Buffer) - return Boolean; - - function Has_Secondary_Selection - (This : in Text_Buffer) - return Boolean; - - function Selection_Text - (This : in Text_Buffer) - return String; - - function Secondary_Selection_Text - (This : in Text_Buffer) - return String; - - procedure Replace_Selection - (This : in out Text_Buffer; - Text : in String); - - procedure Replace_Secondary_Selection - (This : in out Text_Buffer; - Text : in String); - - procedure Remove_Selection - (This : in out Text_Buffer); - - procedure Remove_Secondary_Selection - (This : in out Text_Buffer); - - procedure Unselect - (This : in out Text_Buffer); - - procedure Secondary_Unselect - (This : in out Text_Buffer); - - - - - procedure Get_Highlight - (This : in Text_Buffer; - Start, Finish : out Position); - - procedure Set_Highlight - (This : in out Text_Buffer; - Start, Finish : in Position); - - function Get_Highlighted_Text - (This : in Text_Buffer) - return String; - - procedure Unhighlight - (This : in out Text_Buffer); - - - - - function Findchar_Forward - (This : in Text_Buffer; - Start_At : in Position; - Item : in Character; - Found_At : out Position) - return Boolean; - - function Findchar_Backward - (This : in Text_Buffer; - Start_At : in Position; - Item : in Character; - Found_At : out Position) - return Boolean; - - function Search_Forward - (This : in Text_Buffer; - Start_At : in Position; - Item : in String; - Found_At : out Position; - Match_Case : in Boolean := False) - return Boolean; - - function Search_Backward - (This : in Text_Buffer; - Start_At : in Position; - Item : in String; - Found_At : out Position; - Match_Case : in Boolean := False) - return Boolean; - - - - - function Word_Start - (This : in Text_Buffer; - Place : in Position) - return Position; - - function Word_End - (This : in Text_Buffer; - Place : in Position) - return Position; - - function Line_Start - (This : in Text_Buffer; - Place : in Position) - return Position; - - function Line_End - (This : in Text_Buffer; - Place : in Position) - return Position; - - function Line_Text - (This : in Text_Buffer; - Place : in Position) - return String; - - -- only takes into account newline characters, not word wrap - function Skip_Lines - (This : in out Text_Buffer; - Start : in Position; - Lines : in Natural) - return Position; - - -- only takes into account newline characters, not word wrap - function Rewind_Lines - (This : in out Text_Buffer; - Start : in Position; - Lines : in Natural) - return Position; - - function Skip_Displayed_Characters - (This : in Text_Buffer; - Start : in Position; - Chars : in Natural) - return Position; - - - - - procedure Can_Undo - (This : in out Text_Buffer; - Flag : in Boolean); - - procedure Copy - (This : in out Text_Buffer; - From : in Text_Buffer; - Start, Finish : in Position; - Insert_Pos : in Position); - - function UTF8_Align - (This : in Text_Buffer; - Place : in Position) - return Position; - - -private - - - package Modify_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Modify_Callback); - package Predelete_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Predelete_Callback); - - - - - type Text_Buffer is new Wrapper with - record - CB_Active : Boolean; - Modify_CBs : Modify_Vectors.Vector; - Predelete_CBs : Predelete_Vectors.Vector; - High_From, High_To : Natural := 0; - end record; - - overriding procedure Finalize - (This : in out Text_Buffer); - - - - - procedure Modify_Callback_Hook - (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address); - pragma Convention (C, Modify_Callback_Hook); - - procedure Predelete_Callback_Hook - (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address); - pragma Convention (C, Predelete_Callback_Hook); - - - - - package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); - - - - - pragma Inline (Add_Modify_Callback); - pragma Inline (Add_Predelete_Callback); - pragma Inline (Remove_Modify_Callback); - pragma Inline (Remove_Predelete_Callback); - pragma Inline (Call_Modify_Callbacks); - pragma Inline (Call_Predelete_Callbacks); - pragma Inline (Enable_Callbacks); - pragma Inline (Disable_Callbacks); - - - pragma Inline (Load_File); - pragma Inline (Append_File); - pragma Inline (Insert_File); - pragma Inline (Output_File); - pragma Inline (Save_File); - - - pragma Inline (Insert_Text); - pragma Inline (Append_Text); - pragma Inline (Replace_Text); - pragma Inline (Remove_Text); - pragma Inline (Get_Entire_Text); - pragma Inline (Set_Entire_Text); - pragma Inline (Byte_At); - pragma Inline (Character_At); - pragma Inline (Text_At); - pragma Inline (Next_Char); - pragma Inline (Prev_Char); - - - pragma Inline (Count_Displayed_Characters); - pragma Inline (Count_Lines); - pragma Inline (Length); - pragma Inline (Get_Tab_Width); - pragma Inline (Set_Tab_Width); - - - pragma Inline (Get_Selection); - pragma Inline (Get_Secondary_Selection); - pragma Inline (Set_Selection); - pragma Inline (Set_Secondary_Selection); - pragma Inline (Has_Selection); - pragma Inline (Has_Secondary_Selection); - pragma Inline (Selection_Text); - pragma Inline (Secondary_Selection_Text); - pragma Inline (Replace_Selection); - pragma Inline (Replace_Secondary_Selection); - pragma Inline (Remove_Selection); - pragma Inline (Remove_Secondary_Selection); - pragma Inline (Unselect); - pragma Inline (Secondary_Unselect); - - - pragma Inline (Get_Highlight); - pragma Inline (Set_Highlight); - pragma Inline (Get_Highlighted_Text); - pragma Inline (Unhighlight); - - - pragma Inline (Findchar_Forward); - pragma Inline (Findchar_Backward); - pragma Inline (Search_Forward); - pragma Inline (Search_Backward); - - - pragma Inline (Word_Start); - pragma Inline (Word_End); - pragma Inline (Line_Start); - pragma Inline (Line_End); - pragma Inline (Line_Text); - pragma Inline (Skip_Lines); - pragma Inline (Rewind_Lines); - pragma Inline (Skip_Displayed_Characters); - - - pragma Inline (Can_Undo); - pragma Inline (Copy); - pragma Inline (UTF8_Align); - - -end FLTK.Text_Buffers; - diff --git a/src/fltk-tooltips.adb b/src/fltk-tooltips.adb deleted file mode 100644 index 720e417..0000000 --- a/src/fltk-tooltips.adb +++ /dev/null @@ -1,340 +0,0 @@ - - -with - - Interfaces.C, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Tooltips is - - - function fl_tooltip_get_current - return System.Address; - pragma Import (C, fl_tooltip_get_current, "fl_tooltip_get_current"); - pragma Inline (fl_tooltip_get_current); - - procedure fl_tooltip_set_current - (I : in System.Address); - pragma Import (C, fl_tooltip_set_current, "fl_tooltip_set_current"); - pragma Inline (fl_tooltip_set_current); - - function fl_tooltip_enabled - return Interfaces.C.int; - pragma Import (C, fl_tooltip_enabled, "fl_tooltip_enabled"); - pragma Inline (fl_tooltip_enabled); - - procedure fl_tooltip_enable - (V : in Interfaces.C.int); - pragma Import (C, fl_tooltip_enable, "fl_tooltip_enable"); - pragma Inline (fl_tooltip_enable); - - procedure fl_tooltip_enter_area - (I : in System.Address; - X, Y, W, H : in Interfaces.C.int; - T : in Interfaces.C.char_array); - pragma Import (C, fl_tooltip_enter_area, "fl_tooltip_enter_area"); - pragma Inline (fl_tooltip_enter_area); - - - - - function fl_tooltip_get_delay - return Interfaces.C.C_float; - pragma Import (C, fl_tooltip_get_delay, "fl_tooltip_get_delay"); - pragma Inline (fl_tooltip_get_delay); - - procedure fl_tooltip_set_delay - (V : in Interfaces.C.C_float); - pragma Import (C, fl_tooltip_set_delay, "fl_tooltip_set_delay"); - pragma Inline (fl_tooltip_set_delay); - - function fl_tooltip_get_hoverdelay - return Interfaces.C.C_float; - pragma Import (C, fl_tooltip_get_hoverdelay, "fl_tooltip_get_hoverdelay"); - pragma Inline (fl_tooltip_get_hoverdelay); - - procedure fl_tooltip_set_hoverdelay - (V : in Interfaces.C.C_float); - pragma Import (C, fl_tooltip_set_hoverdelay, "fl_tooltip_set_hoverdelay"); - pragma Inline (fl_tooltip_set_hoverdelay); - - - - - function fl_tooltip_get_color - return Interfaces.C.unsigned; - pragma Import (C, fl_tooltip_get_color, "fl_tooltip_get_color"); - pragma Inline (fl_tooltip_get_color); - - procedure fl_tooltip_set_color - (V : in Interfaces.C.unsigned); - pragma Import (C, fl_tooltip_set_color, "fl_tooltip_set_color"); - pragma Inline (fl_tooltip_set_color); - - function fl_tooltip_get_margin_height - return Interfaces.C.int; - pragma Import (C, fl_tooltip_get_margin_height, "fl_tooltip_get_margin_height"); - pragma Inline (fl_tooltip_get_margin_height); - - -- procedure fl_tooltip_set_margin_height - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_margin_height, "fl_tooltip_set_margin_height"); - -- pragma Inline (fl_tooltip_set_margin_height); - - function fl_tooltip_get_margin_width - return Interfaces.C.int; - pragma Import (C, fl_tooltip_get_margin_width, "fl_tooltip_get_margin_width"); - pragma Inline (fl_tooltip_get_margin_width); - - -- procedure fl_tooltip_set_margin_width - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_margin_width, "fl_tooltip_set_margin_width"); - -- pragma Inline (fl_tooltip_set_margin_width); - - function fl_tooltip_get_wrap_width - return Interfaces.C.int; - pragma Import (C, fl_tooltip_get_wrap_width, "fl_tooltip_get_wrap_width"); - pragma Inline (fl_tooltip_get_wrap_width); - - -- procedure fl_tooltip_set_wrap_width - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_wrap_width, "fl_tooltip_set_wrap_width"); - -- pragma Inline (fl_tooltip_set_wrap_width); - - - - - function fl_tooltip_get_textcolor - return Interfaces.C.unsigned; - pragma Import (C, fl_tooltip_get_textcolor, "fl_tooltip_get_textcolor"); - pragma Inline (fl_tooltip_get_textcolor); - - procedure fl_tooltip_set_textcolor - (V : in Interfaces.C.unsigned); - pragma Import (C, fl_tooltip_set_textcolor, "fl_tooltip_set_textcolor"); - pragma Inline (fl_tooltip_set_textcolor); - - function fl_tooltip_get_font - return Interfaces.C.int; - pragma Import (C, fl_tooltip_get_font, "fl_tooltip_get_font"); - pragma Inline (fl_tooltip_get_font); - - procedure fl_tooltip_set_font - (V : in Interfaces.C.int); - pragma Import (C, fl_tooltip_set_font, "fl_tooltip_set_font"); - pragma Inline (fl_tooltip_set_font); - - function fl_tooltip_get_size - return Interfaces.C.int; - pragma Import (C, fl_tooltip_get_size, "fl_tooltip_get_size"); - pragma Inline (fl_tooltip_get_size); - - procedure fl_tooltip_set_size - (V : in Interfaces.C.int); - pragma Import (C, fl_tooltip_set_size, "fl_tooltip_set_size"); - pragma Inline (fl_tooltip_set_size); - - - - - function fl_widget_get_user_data - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - pragma Inline (fl_widget_get_user_data); - - package Widget_Convert is new - System.Address_To_Access_Conversions (FLTK.Widgets.Widget'Class); - - - - - function Get_Target - return access FLTK.Widgets.Widget'Class - is - Widget_Ptr : System.Address := fl_tooltip_get_current; - begin - if Widget_Ptr /= System.Null_Address then - return Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - else - return null; - end if; - end Get_Target; - - - procedure Set_Target - (To : in FLTK.Widgets.Widget'Class) is - begin - fl_tooltip_set_current (Wrapper (To).Void_Ptr); - end Set_Target; - - - function Is_Enabled - return Boolean is - begin - return fl_tooltip_enabled /= 0; - end Is_Enabled; - - - procedure Set_Enabled - (To : in Boolean) is - begin - fl_tooltip_enable (Boolean'Pos (To)); - end Set_Enabled; - - - procedure Enter_Area - (Item : in FLTK.Widgets.Widget'Class; - X, Y, W, H : in Integer; - Tip : in String) is - begin - fl_tooltip_enter_area - (Wrapper (Item).Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Tip)); - end Enter_Area; - - - - - function Get_Delay - return Float is - begin - return Float (fl_tooltip_get_delay); - end Get_Delay; - - - procedure Set_Delay - (To : in Float) is - begin - fl_tooltip_set_delay (Interfaces.C.C_float (To)); - end Set_Delay; - - - function Get_Hover_Delay - return Float is - begin - return Float (fl_tooltip_get_hoverdelay); - end Get_Hover_Delay; - - - procedure Set_Hover_Delay - (To : in Float) is - begin - fl_tooltip_set_hoverdelay (Interfaces.C.C_float (To)); - end Set_Hover_Delay; - - - - - function Get_Background_Color - return Color is - begin - return Color (fl_tooltip_get_color); - end Get_Background_Color; - - - procedure Set_Background_Color - (To : in Color) is - begin - fl_tooltip_set_color (Interfaces.C.unsigned (To)); - end Set_Background_Color; - - - function Get_Margin_Height - return Natural is - begin - return Natural (fl_tooltip_get_margin_height); - end Get_Margin_Height; - - - -- procedure Set_Margin_Height - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_margin_height (Interfaces.C.int (To)); - -- end Set_Margin_Height; - - - function Get_Margin_Width - return Natural is - begin - return Natural (fl_tooltip_get_margin_width); - end Get_Margin_Width; - - - -- procedure Set_Margin_Width - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_margin_width (Interfaces.C.int (To)); - -- end Set_Margin_Width; - - - function Get_Wrap_Width - return Natural is - begin - return Natural (fl_tooltip_get_wrap_width); - end Get_Wrap_Width; - - - -- procedure Set_Wrap_Width - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_wrap_width (Interfaces.C.int (To)); - -- end Set_Wrap_Width; - - - - - function Get_Text_Color - return Color is - begin - return Color (fl_tooltip_get_textcolor); - end Get_Text_Color; - - - procedure Set_Text_Color - (To : in Color) is - begin - fl_tooltip_set_textcolor (Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - return Font_Kind is - begin - return Font_Kind'Val (fl_tooltip_get_font); - end Get_Text_Font; - - - procedure Set_Text_Font - (To : in Font_Kind) is - begin - fl_tooltip_set_font (Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - return Font_Size is - begin - return Font_Size (fl_tooltip_get_size); - end Get_Text_Size; - - - procedure Set_Text_Size - (To : in Font_Size) is - begin - fl_tooltip_set_size (Interfaces.C.int (To)); - end Set_Text_Size; - - -end FLTK.Tooltips; - diff --git a/src/fltk-tooltips.ads b/src/fltk-tooltips.ads deleted file mode 100644 index f4b3044..0000000 --- a/src/fltk-tooltips.ads +++ /dev/null @@ -1,127 +0,0 @@ - - -with - - FLTK.Widgets; - - -package FLTK.Tooltips is - - - function Get_Target - return access FLTK.Widgets.Widget'Class; - - procedure Set_Target - (To : in FLTK.Widgets.Widget'Class); - - function Is_Enabled - return Boolean; - - procedure Set_Enabled - (To : in Boolean); - - procedure Enter_Area - (Item : in FLTK.Widgets.Widget'Class; - X, Y, W, H : in Integer; - Tip : in String); - - - - - function Get_Delay - return Float; - - procedure Set_Delay - (To : in Float); - - function Get_Hover_Delay - return Float; - - procedure Set_Hover_Delay - (To : in Float); - - - - - function Get_Background_Color - return Color; - - procedure Set_Background_Color - (To : in Color); - - function Get_Margin_Height - return Natural; - - -- procedure Set_Margin_Height - -- (To : in Natural); - - function Get_Margin_Width - return Natural; - - -- procedure Set_Margin_Width - -- (To : in Natural); - - function Get_Wrap_Width - return Natural; - - -- procedure Set_Wrap_Width - -- (To : in Natural); - - - - - function Get_Text_Color - return Color; - - procedure Set_Text_Color - (To : in Color); - - function Get_Text_Font - return Font_Kind; - - procedure Set_Text_Font - (To : in Font_Kind); - - function Get_Text_Size - return Font_Size; - - procedure Set_Text_Size - (To : in Font_Size); - - -private - - - pragma Inline (Get_Target); - pragma Inline (Set_Target); - pragma Inline (Is_Enabled); - pragma Inline (Set_Enabled); - pragma Inline (Enter_Area); - - - pragma Inline (Get_Delay); - pragma Inline (Set_Delay); - pragma Inline (Get_Hover_Delay); - pragma Inline (Set_Hover_Delay); - - - pragma Inline (Get_Background_Color); - pragma Inline (Set_Background_Color); - pragma Inline (Get_Margin_Height); - -- pragma Inline (Set_Margin_Height); - pragma Inline (Get_Margin_Width); - -- pragma Inline (Set_Margin_Width); - pragma Inline (Get_Wrap_Width); - -- pragma Inline (Set_Wrap_Width); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - -end FLTK.Tooltips; - diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb deleted file mode 100644 index a5c3087..0000000 --- a/src/fltk-widgets-boxes.adb +++ /dev/null @@ -1,122 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Boxes is - - - procedure box_set_draw_hook - (W, D : in System.Address); - pragma Import (C, box_set_draw_hook, "box_set_draw_hook"); - pragma Inline (box_set_draw_hook); - - procedure box_set_handle_hook - (W, H : in System.Address); - pragma Import (C, box_set_handle_hook, "box_set_handle_hook"); - pragma Inline (box_set_handle_hook); - - - - - function new_fl_box - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_box, "new_fl_box"); - pragma Inline (new_fl_box); - - procedure free_fl_box - (B : in System.Address); - pragma Import (C, free_fl_box, "free_fl_box"); - pragma Inline (free_fl_box); - - - - - procedure fl_box_draw - (W : in System.Address); - pragma Import (C, fl_box_draw, "fl_box_draw"); - pragma Inline (fl_box_draw); - - function fl_box_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_box_handle, "fl_box_handle"); - pragma Inline (fl_box_handle); - - - - - procedure Finalize - (This : in out Box) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Box'Class - then - if This.Needs_Dealloc then - free_fl_box (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Box is - begin - return This : Box do - This.Void_Ptr := new_fl_box - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - box_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - box_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Box) is - begin - fl_box_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Box; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_box_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Boxes; - diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads deleted file mode 100644 index 9005e41..0000000 --- a/src/fltk-widgets-boxes.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Boxes is - - - type Box is new Widget with private; - - type Box_Reference (Data : not null access Box'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Box; - - end Forge; - - - - - procedure Draw - (This : in out Box); - - function Handle - (This : in out Box; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Box is new Widget with null record; - - overriding procedure Finalize - (This : in out Box); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Boxes; - diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb deleted file mode 100644 index 1753811..0000000 --- a/src/fltk-widgets-buttons-enter.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Enter is - - - procedure return_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, return_button_set_draw_hook, "return_button_set_draw_hook"); - pragma Inline (return_button_set_draw_hook); - - procedure return_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, return_button_set_handle_hook, "return_button_set_handle_hook"); - pragma Inline (return_button_set_handle_hook); - - - - - function new_fl_return_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_return_button, "new_fl_return_button"); - pragma Inline (new_fl_return_button); - - procedure free_fl_return_button - (B : in System.Address); - pragma Import (C, free_fl_return_button, "free_fl_return_button"); - pragma Inline (free_fl_return_button); - - - - - procedure fl_return_button_draw - (W : in System.Address); - pragma Import (C, fl_return_button_draw, "fl_return_button_draw"); - pragma Inline (fl_return_button_draw); - - function fl_return_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_return_button_handle, "fl_return_button_handle"); - pragma Inline (fl_return_button_handle); - - - - - procedure Finalize - (This : in out Enter_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Enter_Button'Class - then - free_fl_return_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Enter_Button is - begin - return This : Enter_Button do - This.Void_Ptr := new_fl_return_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - return_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - return_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Enter_Button) is - begin - fl_return_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Enter_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_return_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Enter; - diff --git a/src/fltk-widgets-buttons-enter.ads b/src/fltk-widgets-buttons-enter.ads deleted file mode 100644 index 11251dd..0000000 --- a/src/fltk-widgets-buttons-enter.ads +++ /dev/null @@ -1,54 +0,0 @@ - - --- Return Buttons, but return is a reserved word, so they're Enter Buttons instead - - -package FLTK.Widgets.Buttons.Enter is - - - type Enter_Button is new Button with private; - - type Enter_Button_Reference (Data : not null access Enter_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Enter_Button; - - end Forge; - - - - - procedure Draw - (This : in out Enter_Button); - - function Handle - (This : in out Enter_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Enter_Button is new Button with null record; - - overriding procedure Finalize - (This : in out Enter_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Enter; - diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb deleted file mode 100644 index 027f9f7..0000000 --- a/src/fltk-widgets-buttons-light-check.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Light.Check is - - - procedure check_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, check_button_set_draw_hook, "check_button_set_draw_hook"); - pragma Inline (check_button_set_draw_hook); - - procedure check_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, check_button_set_handle_hook, "check_button_set_handle_hook"); - pragma Inline (check_button_set_handle_hook); - - - - - function new_fl_check_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_check_button, "new_fl_check_button"); - pragma Inline (new_fl_check_button); - - procedure free_fl_check_button - (B : in System.Address); - pragma Import (C, free_fl_check_button, "free_fl_check_button"); - pragma Inline (free_fl_check_button); - - - - - procedure fl_check_button_draw - (W : in System.Address); - pragma Import (C, fl_check_button_draw, "fl_check_button_draw"); - pragma Inline (fl_check_button_draw); - - function fl_check_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_button_handle, "fl_check_button_handle"); - pragma Inline (fl_check_button_handle); - - - - - procedure Finalize - (This : in out Check_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Check_Button'Class - then - free_fl_check_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Light_Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Check_Button is - begin - return This : Check_Button do - This.Void_Ptr := new_fl_check_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - check_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - check_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Check_Button) is - begin - fl_check_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Check_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_check_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Light.Check; - diff --git a/src/fltk-widgets-buttons-light-check.ads b/src/fltk-widgets-buttons-light-check.ads deleted file mode 100644 index abf5d9f..0000000 --- a/src/fltk-widgets-buttons-light-check.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Check is - - - type Check_Button is new Light_Button with private; - - type Check_Button_Reference (Data : not null access Check_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Check_Button; - - end Forge; - - - - - procedure Draw - (This : in out Check_Button); - - function Handle - (This : in out Check_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Check_Button is new Light_Button with null record; - - overriding procedure Finalize - (This : in out Check_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Light.Check; - diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb deleted file mode 100644 index 339e1f2..0000000 --- a/src/fltk-widgets-buttons-light-radio.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Light.Radio is - - - procedure radio_light_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, radio_light_button_set_draw_hook, "radio_light_button_set_draw_hook"); - pragma Inline (radio_light_button_set_draw_hook); - - procedure radio_light_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, radio_light_button_set_handle_hook, "radio_light_button_set_handle_hook"); - pragma Inline (radio_light_button_set_handle_hook); - - - - - function new_fl_radio_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); - pragma Inline (new_fl_radio_light_button); - - procedure free_fl_radio_light_button - (B : in System.Address); - pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); - pragma Inline (free_fl_radio_light_button); - - - - - procedure fl_radio_light_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_light_button_draw, "fl_radio_light_button_draw"); - pragma Inline (fl_radio_light_button_draw); - - function fl_radio_light_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_light_button_handle, "fl_radio_light_button_handle"); - pragma Inline (fl_radio_light_button_handle); - - - - - procedure Finalize - (This : in out Radio_Light_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Radio_Light_Button'Class - then - free_fl_radio_light_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Light_Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Light_Button is - begin - return This : Radio_Light_Button do - This.Void_Ptr := new_fl_radio_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_light_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_light_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Light_Button) is - begin - fl_radio_light_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Radio_Light_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Light.Radio; - diff --git a/src/fltk-widgets-buttons-light-radio.ads b/src/fltk-widgets-buttons-light-radio.ads deleted file mode 100644 index b1fe574..0000000 --- a/src/fltk-widgets-buttons-light-radio.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Radio is - - - type Radio_Light_Button is new Light_Button with private; - - type Radio_Light_Button_Reference (Data : not null access Radio_Light_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Light_Button; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Light_Button); - - function Handle - (This : in out Radio_Light_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Radio_Light_Button is new Light_Button with null record; - - overriding procedure Finalize - (This : in out Radio_Light_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Light.Radio; - diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb deleted file mode 100644 index c1a9271..0000000 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Light.Round.Radio is - - - procedure radio_round_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, radio_round_button_set_draw_hook, "radio_round_button_set_draw_hook"); - pragma Inline (radio_round_button_set_draw_hook); - - procedure radio_round_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, radio_round_button_set_handle_hook, "radio_round_button_set_handle_hook"); - pragma Inline (radio_round_button_set_handle_hook); - - - - - function new_fl_radio_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); - pragma Inline (new_fl_radio_round_button); - - procedure free_fl_radio_round_button - (B : in System.Address); - pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); - pragma Inline (free_fl_radio_round_button); - - - - - procedure fl_radio_round_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_round_button_draw, "fl_radio_round_button_draw"); - pragma Inline (fl_radio_round_button_draw); - - function fl_radio_round_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_round_button_handle, "fl_radio_round_button_handle"); - pragma Inline (fl_radio_round_button_handle); - - - - - procedure Finalize - (This : in out Radio_Round_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Radio_Round_Button'Class - then - free_fl_radio_round_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Round_Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Round_Button is - begin - return This : Radio_Round_Button do - This.Void_Ptr := new_fl_radio_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_round_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_round_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Round_Button) is - begin - fl_radio_round_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Radio_Round_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Light.Round.Radio; - diff --git a/src/fltk-widgets-buttons-light-round-radio.ads b/src/fltk-widgets-buttons-light-round-radio.ads deleted file mode 100644 index 9424450..0000000 --- a/src/fltk-widgets-buttons-light-round-radio.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Round.Radio is - - - type Radio_Round_Button is new Round_Button with private; - - type Radio_Round_Button_Reference (Data : not null access Radio_Round_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Round_Button; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Round_Button); - - function Handle - (This : in out Radio_Round_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Radio_Round_Button is new Round_Button with null record; - - overriding procedure Finalize - (This : in out Radio_Round_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Light.Round.Radio; - diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb deleted file mode 100644 index bceb70e..0000000 --- a/src/fltk-widgets-buttons-light-round.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Light.Round is - - - procedure round_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, round_button_set_draw_hook, "round_button_set_draw_hook"); - pragma Inline (round_button_set_draw_hook); - - procedure round_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, round_button_set_handle_hook, "round_button_set_handle_hook"); - pragma Inline (round_button_set_handle_hook); - - - - - function new_fl_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_round_button, "new_fl_round_button"); - pragma Inline (new_fl_round_button); - - procedure free_fl_round_button - (B : in System.Address); - pragma Import (C, free_fl_round_button, "free_fl_round_button"); - pragma Inline (free_fl_round_button); - - - - - procedure fl_round_button_draw - (W : in System.Address); - pragma Import (C, fl_round_button_draw, "fl_round_button_draw"); - pragma Inline (fl_round_button_draw); - - function fl_round_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_round_button_handle, "fl_round_button_handle"); - pragma Inline (fl_round_button_handle); - - - - - procedure Finalize - (This : in out Round_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Round_Button'Class - then - free_fl_round_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Light_Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Round_Button is - begin - return This : Round_Button do - This.Void_Ptr := new_fl_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - round_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - round_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Round_Button) is - begin - fl_round_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Round_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_round_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Light.Round; - diff --git a/src/fltk-widgets-buttons-light-round.ads b/src/fltk-widgets-buttons-light-round.ads deleted file mode 100644 index 22428c6..0000000 --- a/src/fltk-widgets-buttons-light-round.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Round is - - - type Round_Button is new Light_Button with private; - - type Round_Button_Reference (Data : not null access Round_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Round_Button; - - end Forge; - - - - - procedure Draw - (This : in out Round_Button); - - function Handle - (This : in out Round_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Round_Button is new Light_Button with null record; - - overriding procedure Finalize - (This : in out Round_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Light.Round; - diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb deleted file mode 100644 index 6290054..0000000 --- a/src/fltk-widgets-buttons-light.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Light is - - - procedure light_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, light_button_set_draw_hook, "light_button_set_draw_hook"); - pragma Inline (light_button_set_draw_hook); - - procedure light_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, light_button_set_handle_hook, "light_button_set_handle_hook"); - pragma Inline (light_button_set_handle_hook); - - - - - function new_fl_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_light_button, "new_fl_light_button"); - pragma Inline (new_fl_light_button); - - procedure free_fl_light_button - (B : in System.Address); - pragma Import (C, free_fl_light_button, "free_fl_light_button"); - pragma Inline (free_fl_light_button); - - - - - procedure fl_light_button_draw - (W : in System.Address); - pragma Import (C, fl_light_button_draw, "fl_light_button_draw"); - pragma Inline (fl_light_button_draw); - - function fl_light_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_light_button_handle, "fl_light_button_handle"); - pragma Inline (fl_light_button_handle); - - - - - procedure Finalize - (This : in out Light_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Light_Button'Class - then - free_fl_light_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Light_Button is - begin - return This : Light_Button do - This.Void_Ptr := new_fl_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - light_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - light_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Light_Button) is - begin - fl_light_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Light_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_light_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Light; - diff --git a/src/fltk-widgets-buttons-light.ads b/src/fltk-widgets-buttons-light.ads deleted file mode 100644 index 8e8f725..0000000 --- a/src/fltk-widgets-buttons-light.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light is - - - type Light_Button is new Button with private; - - type Light_Button_Reference (Data : not null access Light_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Light_Button; - - end Forge; - - - - - procedure Draw - (This : in out Light_Button); - - function Handle - (This : in out Light_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Light_Button is new Button with null record; - - overriding procedure Finalize - (This : in out Light_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Light; - diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb deleted file mode 100644 index 8d8e164..0000000 --- a/src/fltk-widgets-buttons-radio.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Radio is - - - procedure radio_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, radio_button_set_draw_hook, "radio_button_set_draw_hook"); - pragma Inline (radio_button_set_draw_hook); - - procedure radio_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, radio_button_set_handle_hook, "radio_button_set_handle_hook"); - pragma Inline (radio_button_set_handle_hook); - - - - - function new_fl_radio_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); - pragma Inline (new_fl_radio_button); - - procedure free_fl_radio_button - (B : in System.Address); - pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); - pragma Inline (free_fl_radio_button); - - - - - procedure fl_radio_button_draw - (W : in System.Address); - pragma Import (C, fl_radio_button_draw, "fl_radio_button_draw"); - pragma Inline (fl_radio_button_draw); - - function fl_radio_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_radio_button_handle, "fl_radio_button_handle"); - pragma Inline (fl_radio_button_handle); - - - - - procedure Finalize - (This : in out Radio_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Radio_Button'Class - then - free_fl_radio_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Button is - begin - return This : Radio_Button do - This.Void_Ptr := new_fl_radio_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Button) is - begin - fl_radio_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Radio_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_radio_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Radio; - diff --git a/src/fltk-widgets-buttons-radio.ads b/src/fltk-widgets-buttons-radio.ads deleted file mode 100644 index 4a2cdf5..0000000 --- a/src/fltk-widgets-buttons-radio.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Radio is - - - type Radio_Button is new Button with private; - - type Radio_Button_Reference (Data : not null access Radio_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Radio_Button; - - end Forge; - - - - - procedure Draw - (This : in out Radio_Button); - - function Handle - (This : in out Radio_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Radio_Button is new Button with null record; - - overriding procedure Finalize - (This : in out Radio_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Radio; - diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb deleted file mode 100644 index 9b3af65..0000000 --- a/src/fltk-widgets-buttons-repeat.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Repeat is - - - procedure repeat_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, repeat_button_set_draw_hook, "repeat_button_set_draw_hook"); - pragma Inline (repeat_button_set_draw_hook); - - procedure repeat_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, repeat_button_set_handle_hook, "repeat_button_set_handle_hook"); - pragma Inline (repeat_button_set_handle_hook); - - - - - function new_fl_repeat_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); - pragma Inline (new_fl_repeat_button); - - procedure free_fl_repeat_button - (B : in System.Address); - pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); - pragma Inline (free_fl_repeat_button); - - - - - procedure fl_repeat_button_draw - (W : in System.Address); - pragma Import (C, fl_repeat_button_draw, "fl_repeat_button_draw"); - pragma Inline (fl_repeat_button_draw); - - function fl_repeat_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_repeat_button_handle, "fl_repeat_button_handle"); - pragma Inline (fl_repeat_button_handle); - - - - - procedure Finalize - (This : in out Repeat_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Repeat_Button'Class - then - free_fl_repeat_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Repeat_Button is - begin - return This : Repeat_Button do - This.Void_Ptr := new_fl_repeat_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - repeat_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - repeat_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Repeat_Button) is - begin - fl_repeat_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Repeat_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_repeat_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Repeat; - diff --git a/src/fltk-widgets-buttons-repeat.ads b/src/fltk-widgets-buttons-repeat.ads deleted file mode 100644 index 22f1088..0000000 --- a/src/fltk-widgets-buttons-repeat.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Repeat is - - - type Repeat_Button is new Button with private; - - type Repeat_Button_Reference (Data : not null access Repeat_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Repeat_Button; - - end Forge; - - - - - procedure Draw - (This : in out Repeat_Button); - - function Handle - (This : in out Repeat_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Repeat_Button is new Button with null record; - - overriding procedure Finalize - (This : in out Repeat_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Repeat; - diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb deleted file mode 100644 index 21df56b..0000000 --- a/src/fltk-widgets-buttons-toggle.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons.Toggle is - - - procedure toggle_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, toggle_button_set_draw_hook, "toggle_button_set_draw_hook"); - pragma Inline (toggle_button_set_draw_hook); - - procedure toggle_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, toggle_button_set_handle_hook, "toggle_button_set_handle_hook"); - pragma Inline (toggle_button_set_handle_hook); - - - - - function new_fl_toggle_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); - pragma Inline (new_fl_toggle_button); - - procedure free_fl_toggle_button - (B : in System.Address); - pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); - pragma Inline (free_fl_toggle_button); - - - - - procedure fl_toggle_button_draw - (W : in System.Address); - pragma Import (C, fl_toggle_button_draw, "fl_toggle_button_draw"); - pragma Inline (fl_toggle_button_draw); - - function fl_toggle_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_toggle_button_handle, "fl_toggle_button_handle"); - pragma Inline (fl_toggle_button_handle); - - - - - procedure Finalize - (This : in out Toggle_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Toggle_Button'Class - then - free_fl_toggle_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Button (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Toggle_Button is - begin - return This : Toggle_Button do - This.Void_Ptr := new_fl_toggle_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - toggle_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - toggle_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Toggle_Button) is - begin - fl_toggle_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Toggle_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_toggle_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons.Toggle; - diff --git a/src/fltk-widgets-buttons-toggle.ads b/src/fltk-widgets-buttons-toggle.ads deleted file mode 100644 index 7e185ca..0000000 --- a/src/fltk-widgets-buttons-toggle.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Buttons.Toggle is - - - type Toggle_Button is new Button with private; - - type Toggle_Button_Reference (Data : not null access Toggle_Button'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Toggle_Button; - - end Forge; - - - - - procedure Draw - (This : in out Toggle_Button); - - function Handle - (This : in out Toggle_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Toggle_Button is new Button with null record; - - overriding procedure Finalize - (This : in out Toggle_Button); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons.Toggle; - diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb deleted file mode 100644 index fb2735f..0000000 --- a/src/fltk-widgets-buttons.adb +++ /dev/null @@ -1,226 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Buttons is - - - procedure button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, button_set_draw_hook, "button_set_draw_hook"); - pragma Inline (button_set_draw_hook); - - procedure button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, button_set_handle_hook, "button_set_handle_hook"); - pragma Inline (button_set_handle_hook); - - - - - function new_fl_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_button, "new_fl_button"); - pragma Inline (new_fl_button); - - procedure free_fl_button - (B : in System.Address); - pragma Import (C, free_fl_button, "free_fl_button"); - pragma Inline (free_fl_button); - - - - - function fl_button_get_state - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_button_get_state, "fl_button_get_state"); - pragma Inline (fl_button_get_state); - - procedure fl_button_set_state - (B : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_button_set_state, "fl_button_set_state"); - pragma Inline (fl_button_set_state); - - procedure fl_button_set_only - (B : in System.Address); - pragma Import (C, fl_button_set_only, "fl_button_set_only"); - pragma Inline (fl_button_set_only); - - - - - function fl_button_get_down_box - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_button_get_down_box, "fl_button_get_down_box"); - pragma Inline (fl_button_get_down_box); - - procedure fl_button_set_down_box - (B : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_button_set_down_box, "fl_button_set_down_box"); - pragma Inline (fl_button_set_down_box); - - function fl_button_get_shortcut - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_button_get_shortcut, "fl_button_get_shortcut"); - pragma Inline (fl_button_get_shortcut); - - procedure fl_button_set_shortcut - (B : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_button_set_shortcut, "fl_button_set_shortcut"); - pragma Inline (fl_button_set_shortcut); - - - - - procedure fl_button_draw - (W : in System.Address); - pragma Import (C, fl_button_draw, "fl_button_draw"); - pragma Inline (fl_button_draw); - - function fl_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_button_handle, "fl_button_handle"); - pragma Inline (fl_button_handle); - - - - - procedure Finalize - (This : in out Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Button'Class - then - free_fl_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Button is - begin - return This : Button do - This.Void_Ptr := new_fl_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_State - (This : in Button) - return State is - begin - return State'Val (fl_button_get_state (This.Void_Ptr)); - end Get_State; - - - procedure Set_State - (This : in out Button; - St : in State) is - begin - fl_button_set_state (This.Void_Ptr, State'Pos (St)); - end Set_State; - - - procedure Set_Only - (This : in out Button) is - begin - fl_button_set_only (This.Void_Ptr); - end Set_Only; - - - - - function Get_Down_Box - (This : in Button) - return Box_Kind is - begin - return Box_Kind'Val (fl_button_get_down_box (This.Void_Ptr)); - end Get_Down_Box; - - - procedure Set_Down_Box - (This : in out Button; - To : in Box_Kind) is - begin - fl_button_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Down_Box; - - - function Get_Shortcut - (This : in Button) - return Key_Combo is - begin - return To_Ada (Interfaces.C.unsigned_long (fl_button_get_shortcut (This.Void_Ptr))); - end Get_Shortcut; - - - procedure Set_Shortcut - (This : in out Button; - Key : in Key_Combo) is - begin - fl_button_set_shortcut (This.Void_Ptr, Interfaces.C.int (To_C (Key))); - end Set_Shortcut; - - - - - procedure Draw - (This : in out Button) is - begin - fl_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Buttons; - diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads deleted file mode 100644 index 7772e63..0000000 --- a/src/fltk-widgets-buttons.ads +++ /dev/null @@ -1,93 +0,0 @@ - - -package FLTK.Widgets.Buttons is - - - type Button is new Widget with private; - - type Button_Reference (Data : not null access Button'Class) is limited null record - with Implicit_Dereference => Data; - - type State is (Off, On); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Button; - - end Forge; - - - - - function Get_State - (This : in Button) - return State; - - procedure Set_State - (This : in out Button; - St : in State); - - procedure Set_Only - (This : in out Button); - - - - - function Get_Down_Box - (This : in Button) - return Box_Kind; - - procedure Set_Down_Box - (This : in out Button; - To : in Box_Kind); - - function Get_Shortcut - (This : in Button) - return Key_Combo; - - procedure Set_Shortcut - (This : in out Button; - Key : in Key_Combo); - - - - - procedure Draw - (This : in out Button); - - function Handle - (This : in out Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Button is new Widget with null record; - - overriding procedure Finalize - (This : in out Button); - - - - - pragma Inline (Get_State); - pragma Inline (Set_State); - pragma Inline (Set_Only); - pragma Inline (Get_Down_Box); - pragma Inline (Set_Down_Box); - pragma Inline (Get_Shortcut); - pragma Inline (Set_Shortcut); - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Buttons; - diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb deleted file mode 100644 index 573a011..0000000 --- a/src/fltk-widgets-charts.adb +++ /dev/null @@ -1,427 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Charts is - - - procedure chart_set_draw_hook - (W, D : in System.Address); - pragma Import (C, chart_set_draw_hook, "chart_set_draw_hook"); - pragma Inline (chart_set_draw_hook); - - procedure chart_set_handle_hook - (W, H : in System.Address); - pragma Import (C, chart_set_handle_hook, "chart_set_handle_hook"); - pragma Inline (chart_set_handle_hook); - - - - - function new_fl_chart - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_chart, "new_fl_chart"); - pragma Inline (new_fl_chart); - - procedure free_fl_chart - (B : in System.Address); - pragma Import (C, free_fl_chart, "free_fl_chart"); - pragma Inline (free_fl_chart); - - - - - procedure fl_chart_add - (C : in System.Address; - V : in Interfaces.C.double; - L : in Interfaces.C.char_array; - P : in Interfaces.C.unsigned); - pragma Import (C, fl_chart_add, "fl_chart_add"); - pragma Inline (fl_chart_add); - - procedure fl_chart_insert - (C : in System.Address; - I : in Interfaces.C.int; - V : in Interfaces.C.double; - L : in Interfaces.C.char_array; - P : in Interfaces.C.unsigned); - pragma Import (C, fl_chart_insert, "fl_chart_insert"); - pragma Inline (fl_chart_insert); - - procedure fl_chart_replace - (C : in System.Address; - I : in Interfaces.C.int; - V : in Interfaces.C.double; - L : in Interfaces.C.char_array; - P : in Interfaces.C.unsigned); - pragma Import (C, fl_chart_replace, "fl_chart_replace"); - pragma Inline (fl_chart_replace); - - procedure fl_chart_clear - (C : in System.Address); - pragma Import (C, fl_chart_clear, "fl_chart_clear"); - pragma Inline (fl_chart_clear); - - - - - function fl_chart_get_autosize - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_chart_get_autosize, "fl_chart_get_autosize"); - pragma Inline (fl_chart_get_autosize); - - procedure fl_chart_set_autosize - (C : in System.Address; - A : in Interfaces.C.int); - pragma Import (C, fl_chart_set_autosize, "fl_chart_set_autosize"); - pragma Inline (fl_chart_set_autosize); - - procedure fl_chart_get_bounds - (C : in System.Address; - L, U : out Interfaces.C.double); - pragma Import (C, fl_chart_get_bounds, "fl_chart_get_bounds"); - pragma Inline (fl_chart_get_bounds); - - procedure fl_chart_set_bounds - (C : in System.Address; - L, U : in Interfaces.C.double); - pragma Import (C, fl_chart_set_bounds, "fl_chart_set_bounds"); - pragma Inline (fl_chart_set_bounds); - - function fl_chart_get_maxsize - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_chart_get_maxsize, "fl_chart_get_maxsize"); - pragma Inline (fl_chart_get_maxsize); - - procedure fl_chart_set_maxsize - (C : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_chart_set_maxsize, "fl_chart_set_maxsize"); - pragma Inline (fl_chart_set_maxsize); - - function fl_chart_size - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_chart_size, "fl_chart_size"); - pragma Inline (fl_chart_size); - - - - - function fl_chart_get_textcolor - (C : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_chart_get_textcolor, "fl_chart_get_textcolor"); - pragma Inline (fl_chart_get_textcolor); - - procedure fl_chart_set_textcolor - (C : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_chart_set_textcolor, "fl_chart_set_textcolor"); - pragma Inline (fl_chart_set_textcolor); - - function fl_chart_get_textfont - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_chart_get_textfont, "fl_chart_get_textfont"); - pragma Inline (fl_chart_get_textfont); - - procedure fl_chart_set_textfont - (C : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_chart_set_textfont, "fl_chart_set_textfont"); - pragma Inline (fl_chart_set_textfont); - - function fl_chart_get_textsize - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_chart_get_textsize, "fl_chart_get_textsize"); - pragma Inline (fl_chart_get_textsize); - - procedure fl_chart_set_textsize - (C : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_chart_set_textsize, "fl_chart_set_textsize"); - pragma Inline (fl_chart_set_textsize); - - - - - procedure fl_chart_size2 - (C : in System.Address; - W, H : in Interfaces.C.int); - pragma Import (C, fl_chart_size2, "fl_chart_size2"); - pragma Inline (fl_chart_size2); - - - - - procedure fl_chart_draw - (W : in System.Address); - pragma Import (C, fl_chart_draw, "fl_chart_draw"); - pragma Inline (fl_chart_draw); - - function fl_chart_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_chart_handle, "fl_chart_handle"); - pragma Inline (fl_chart_handle); - - - - - procedure Finalize - (This : in out Chart) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Chart'Class - then - free_fl_chart (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Chart is - begin - return This : Chart do - This.Void_Ptr := new_fl_chart - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - chart_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - chart_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Add - (This : in out Chart; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color) is - begin - fl_chart_add - (This.Void_Ptr, - Interfaces.C.double (Data_Value), - Interfaces.C.To_C (Data_Label), - Interfaces.C.unsigned (Data_Color)); - end Add; - - - procedure Insert - (This : in out Chart; - Position : in Natural; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color) is - begin - fl_chart_insert - (This.Void_Ptr, - Interfaces.C.int (Position), - Interfaces.C.double (Data_Value), - Interfaces.C.To_C (Data_Label), - Interfaces.C.unsigned (Data_Color)); - end Insert; - - - procedure Replace - (This : in out Chart; - Position : in Natural; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color) is - begin - fl_chart_replace - (This.Void_Ptr, - Interfaces.C.int (Position), - Interfaces.C.double (Data_Value), - Interfaces.C.To_C (Data_Label), - Interfaces.C.unsigned (Data_Color)); - end Replace; - - - procedure Clear - (This : in out Chart) is - begin - fl_chart_clear (This.Void_Ptr); - end Clear; - - - - - function Will_Autosize - (This : in Chart) - return Boolean is - begin - return fl_chart_get_autosize (This.Void_Ptr) /= 0; - end Will_Autosize; - - - procedure Set_Autosize - (This : in out Chart; - To : in Boolean) is - begin - fl_chart_set_autosize (This.Void_Ptr, Boolean'Pos (To)); - end Set_Autosize; - - - procedure Get_Bounds - (This : in Chart; - Lower, Upper : out Long_Float) is - begin - fl_chart_get_bounds - (This.Void_Ptr, - Interfaces.C.double (Lower), - Interfaces.C.double (Upper)); - end Get_Bounds; - - - procedure Set_Bounds - (This : in out Chart; - Lower, Upper : in Long_Float) is - begin - fl_chart_set_bounds - (This.Void_Ptr, - Interfaces.C.double (Lower), - Interfaces.C.double (Upper)); - end Set_Bounds; - - - function Get_Maximum_Size - (This : in Chart) - return Natural is - begin - return Natural (fl_chart_get_maxsize (This.Void_Ptr)); - end Get_Maximum_Size; - - - procedure Set_Maximum_Size - (This : in out Chart; - To : in Natural) is - begin - fl_chart_set_maxsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Maximum_Size; - - - function Get_Size - (This : in Chart) - return Natural is - begin - return Natural (fl_chart_size (This.Void_Ptr)); - end Get_Size; - - - - - function Get_Text_Color - (This : in Chart) - return Color is - begin - return Color (fl_chart_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Chart; - To : in Color) is - begin - fl_chart_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Chart) - return Font_Kind is - begin - return Font_Kind'Val (fl_chart_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Chart; - To : in Font_Kind) is - begin - fl_chart_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Chart) - return Font_Size is - begin - return Font_Size (fl_chart_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Chart; - To : in Font_Size) is - begin - fl_chart_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - procedure Resize - (This : in out Chart; - W, H : in Integer) is - begin - fl_chart_size2 (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)); - end Resize; - - - - - procedure Draw - (This : in out Chart) is - begin - fl_chart_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Chart; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_chart_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Charts; - diff --git a/src/fltk-widgets-charts.ads b/src/fltk-widgets-charts.ads deleted file mode 100644 index dad0f9f..0000000 --- a/src/fltk-widgets-charts.ads +++ /dev/null @@ -1,168 +0,0 @@ - - -package FLTK.Widgets.Charts is - - - type Chart is new Widget with private; - - type Chart_Reference (Data : not null access Chart'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Chart; - - end Forge; - - - - - procedure Add - (This : in out Chart; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color); - - procedure Insert - (This : in out Chart; - Position : in Natural; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color); - - procedure Replace - (This : in out Chart; - Position : in Natural; - Data_Value : in Long_Float; - Data_Label : in String := ""; - Data_Color : in Color := Foreground_Color); - - procedure Clear - (This : in out Chart); - - - - - function Will_Autosize - (This : in Chart) - return Boolean; - - procedure Set_Autosize - (This : in out Chart; - To : in Boolean); - - procedure Get_Bounds - (This : in Chart; - Lower, Upper : out Long_Float); - - procedure Set_Bounds - (This : in out Chart; - Lower, Upper : in Long_Float); - - function Get_Maximum_Size - (This : in Chart) - return Natural; - - procedure Set_Maximum_Size - (This : in out Chart; - To : in Natural); - - function Get_Size - (This : in Chart) - return Natural; - - - - - function Get_Text_Color - (This : in Chart) - return Color; - - procedure Set_Text_Color - (This : in out Chart; - To : in Color); - - function Get_Text_Font - (This : in Chart) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Chart; - To : in Font_Kind); - - function Get_Text_Size - (This : in Chart) - return Font_Size; - - procedure Set_Text_Size - (This : in out Chart; - To : in Font_Size); - - - - - procedure Resize - (This : in out Chart; - W, H : in Integer); - - - - - procedure Draw - (This : in out Chart); - - function Handle - (This : in out Chart; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Chart is new Widget with null record; - - overriding procedure Finalize - (This : in out Chart); - - - - - pragma Inline (Add); - pragma Inline (Insert); - pragma Inline (Replace); - pragma Inline (Clear); - - - pragma Inline (Will_Autosize); - pragma Inline (Set_Autosize); - pragma Inline (Get_Bounds); - pragma Inline (Set_Bounds); - pragma Inline (Get_Maximum_Size); - pragma Inline (Set_Maximum_Size); - pragma Inline (Get_Size); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Resize); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Charts; - diff --git a/src/fltk-widgets-clocks-updated-round.adb b/src/fltk-widgets-clocks-updated-round.adb deleted file mode 100644 index eb0404a..0000000 --- a/src/fltk-widgets-clocks-updated-round.adb +++ /dev/null @@ -1,139 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Clocks.Updated.Round is - - - procedure round_clock_set_draw_hook - (W, D : in System.Address); - pragma Import (C, round_clock_set_draw_hook, "round_clock_set_draw_hook"); - pragma Inline (round_clock_set_draw_hook); - - procedure round_clock_set_handle_hook - (W, H : in System.Address); - pragma Import (C, round_clock_set_handle_hook, "round_clock_set_handle_hook"); - pragma Inline (round_clock_set_handle_hook); - - - - - function new_fl_round_clock - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_round_clock, "new_fl_round_clock"); - pragma Inline (new_fl_round_clock); - - procedure free_fl_round_clock - (F : in System.Address); - pragma Import (C, free_fl_round_clock, "free_fl_round_clock"); - pragma Inline (free_fl_round_clock); - - - - - procedure fl_round_clock_draw - (W : in System.Address); - pragma Import (C, fl_round_clock_draw, "fl_round_clock_draw"); - pragma Inline (fl_round_clock_draw); - - procedure fl_round_clock_draw2 - (C : in System.Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_round_clock_draw2, "fl_round_clock_draw2"); - pragma Inline (fl_round_clock_draw2); - - function fl_round_clock_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_round_clock_handle, "fl_round_clock_handle"); - pragma Inline (fl_round_clock_handle); - - - - - procedure Finalize - (This : in out Round_Clock) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Round_Clock'Class - then - free_fl_round_clock (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Updated_Clock (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Round_Clock is - begin - return This : Round_Clock do - This.Void_Ptr := new_fl_round_clock - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - round_clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - round_clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Round_Clock) is - begin - fl_round_clock_draw (This.Void_Ptr); - end Draw; - - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer) is - begin - fl_round_clock_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Draw; - - - function Handle - (This : in out Round_Clock; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_round_clock_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Clocks.Updated.Round; - diff --git a/src/fltk-widgets-clocks-updated-round.ads b/src/fltk-widgets-clocks-updated-round.ads deleted file mode 100644 index a868e9f..0000000 --- a/src/fltk-widgets-clocks-updated-round.ads +++ /dev/null @@ -1,55 +0,0 @@ - - -package FLTK.Widgets.Clocks.Updated.Round is - - - type Round_Clock is new Updated_Clock with private; - - type Round_Clock_Reference (Data : not null access Round_Clock'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Round_Clock; - - end Forge; - - - - - procedure Draw - (This : in out Round_Clock); - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer); - - function Handle - (This : in out Round_Clock; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Round_Clock is new Updated_Clock with null record; - - overriding procedure Finalize - (This : in out Round_Clock); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Clocks.Updated.Round; - diff --git a/src/fltk-widgets-clocks-updated.adb b/src/fltk-widgets-clocks-updated.adb deleted file mode 100644 index 0d77222..0000000 --- a/src/fltk-widgets-clocks-updated.adb +++ /dev/null @@ -1,171 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Clocks.Updated is - - - procedure clock_set_draw_hook - (W, D : in System.Address); - pragma Import (C, clock_set_draw_hook, "clock_set_draw_hook"); - pragma Inline (clock_set_draw_hook); - - procedure clock_set_handle_hook - (W, H : in System.Address); - pragma Import (C, clock_set_handle_hook, "clock_set_handle_hook"); - pragma Inline (clock_set_handle_hook); - - - - - function new_fl_clock - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_clock, "new_fl_clock"); - pragma Inline (new_fl_clock); - - function new_fl_clock2 - (K : in Interfaces.C.unsigned_char; - X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_clock2, "new_fl_clock2"); - pragma Inline (new_fl_clock2); - - procedure free_fl_clock - (F : in System.Address); - pragma Import (C, free_fl_clock, "free_fl_clock"); - pragma Inline (free_fl_clock); - - - - - procedure fl_clock_draw - (W : in System.Address); - pragma Import (C, fl_clock_draw, "fl_clock_draw"); - pragma Inline (fl_clock_draw); - - procedure fl_clock_draw2 - (C : in System.Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_clock_draw2, "fl_clock_draw2"); - pragma Inline (fl_clock_draw2); - - function fl_clock_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_clock_handle, "fl_clock_handle"); - pragma Inline (fl_clock_handle); - - - - - procedure Finalize - (This : in out Updated_Clock) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Updated_Clock'Class - then - free_fl_clock (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Clock (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Updated_Clock is - begin - return This : Updated_Clock do - This.Void_Ptr := new_fl_clock - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (Kind : in Box_Kind; - X, Y, W, H : in Integer; - Text : in String := "") - return Updated_Clock is - begin - return This : Updated_Clock do - This.Void_Ptr := new_fl_clock2 - (Box_Kind'Pos (Kind), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Updated_Clock) is - begin - fl_clock_draw (This.Void_Ptr); - end Draw; - - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer) is - begin - fl_clock_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Draw; - - - function Handle - (This : in out Updated_Clock; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_clock_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Clocks.Updated; - diff --git a/src/fltk-widgets-clocks-updated.ads b/src/fltk-widgets-clocks-updated.ads deleted file mode 100644 index bbacbe4..0000000 --- a/src/fltk-widgets-clocks-updated.ads +++ /dev/null @@ -1,61 +0,0 @@ - - -package FLTK.Widgets.Clocks.Updated is - - - type Updated_Clock is new Clock with private; - - type Updated_Clock_Reference (Data : not null access Updated_Clock'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Updated_Clock; - - function Create - (Kind : in Box_Kind; - X, Y, W, H : in Integer; - Text : in String := "") - return Updated_Clock; - - end Forge; - - - - - procedure Draw - (This : in out Updated_Clock); - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer); - - function Handle - (This : in out Updated_Clock; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Updated_Clock is new Clock with null record; - - overriding procedure Finalize - (This : in out Updated_Clock); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Clocks.Updated; - diff --git a/src/fltk-widgets-clocks.adb b/src/fltk-widgets-clocks.adb deleted file mode 100644 index cf83757..0000000 --- a/src/fltk-widgets-clocks.adb +++ /dev/null @@ -1,239 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Clocks is - - - procedure clock_output_set_draw_hook - (W, D : in System.Address); - pragma Import (C, clock_output_set_draw_hook, "clock_output_set_draw_hook"); - pragma Inline (clock_output_set_draw_hook); - - procedure clock_output_set_handle_hook - (W, H : in System.Address); - pragma Import (C, clock_output_set_handle_hook, "clock_output_set_handle_hook"); - pragma Inline (clock_output_set_handle_hook); - - - - - function new_fl_clock_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_clock_output, "new_fl_clock_output"); - pragma Inline (new_fl_clock_output); - - procedure free_fl_clock_output - (F : in System.Address); - pragma Import (C, free_fl_clock_output, "free_fl_clock_output"); - pragma Inline (free_fl_clock_output); - - - - - function fl_clock_output_get_hour - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_clock_output_get_hour, "fl_clock_output_get_hour"); - pragma Inline (fl_clock_output_get_hour); - - function fl_clock_output_get_minute - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_clock_output_get_minute, "fl_clock_output_get_minute"); - pragma Inline (fl_clock_output_get_minute); - - function fl_clock_output_get_second - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_clock_output_get_second, "fl_clock_output_get_second"); - pragma Inline (fl_clock_output_get_second); - - - - - function fl_clock_output_get_value - (C : in System.Address) - return Interfaces.C.unsigned_long; - pragma Import (C, fl_clock_output_get_value, "fl_clock_output_get_value"); - pragma Inline (fl_clock_output_get_value); - - procedure fl_clock_output_set_value - (C : in System.Address; - V : in Interfaces.C.unsigned_long); - pragma Import (C, fl_clock_output_set_value, "fl_clock_output_set_value"); - pragma Inline (fl_clock_output_set_value); - - procedure fl_clock_output_set_value2 - (C : in System.Address; - H, M, S : in Interfaces.C.int); - pragma Import (C, fl_clock_output_set_value2, "fl_clock_output_set_value2"); - pragma Inline (fl_clock_output_set_value2); - - - - - procedure fl_clock_output_draw - (W : in System.Address); - pragma Import (C, fl_clock_output_draw, "fl_clock_output_draw"); - pragma Inline (fl_clock_output_draw); - - procedure fl_clock_output_draw2 - (C : in System.Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_clock_output_draw2, "fl_clock_output_draw2"); - pragma Inline (fl_clock_output_draw2); - - function fl_clock_output_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_clock_output_handle, "fl_clock_output_handle"); - pragma Inline (fl_clock_output_handle); - - - - - procedure Finalize - (This : in out Clock) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Clock'Class - then - free_fl_clock_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Clock is - begin - return This : Clock do - This.Void_Ptr := new_fl_clock_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Hour - (This : in Clock) - return Hour is - begin - return Hour (fl_clock_output_get_hour (This.Void_Ptr)); - end Get_Hour; - - - function Get_Minute - (This : in Clock) - return Minute is - begin - return Minute (fl_clock_output_get_minute (This.Void_Ptr)); - end Get_Minute; - - - function Get_Second - (This : in Clock) - return Second is - begin - return Second (fl_clock_output_get_second (This.Void_Ptr)); - end Get_Second; - - - - - function Get_Time - (This : in Clock) - return Time_Value is - begin - return Time_Value (fl_clock_output_get_value (This.Void_Ptr)); - end Get_Time; - - - procedure Set_Time - (This : in out Clock; - To : in Time_Value) is - begin - fl_clock_output_set_value (This.Void_Ptr, Interfaces.C.unsigned_long (To)); - end Set_Time; - - - procedure Set_Time - (This : in out Clock; - Hours : in Hour; - Minutes : in Minute; - Seconds : in Second) is - begin - fl_clock_output_set_value2 - (This.Void_Ptr, - Interfaces.C.int (Hours), - Interfaces.C.int (Minutes), - Interfaces.C.int (Seconds)); - end Set_Time; - - - - - procedure Draw - (This : in out Clock) is - begin - fl_clock_output_draw (This.Void_Ptr); - end Draw; - - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer) is - begin - fl_clock_output_draw2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Draw; - - - function Handle - (This : in out Clock; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_clock_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Clocks; - diff --git a/src/fltk-widgets-clocks.ads b/src/fltk-widgets-clocks.ads deleted file mode 100644 index d54e76b..0000000 --- a/src/fltk-widgets-clocks.ads +++ /dev/null @@ -1,102 +0,0 @@ - - -package FLTK.Widgets.Clocks is - - - type Clock is new Widget with private; - - type Clock_Reference (Data : not null access Clock'Class) is limited null record - with Implicit_Dereference => Data; - - subtype Hour is Integer range 0 .. 23; - subtype Minute is Integer range 0 .. 59; - subtype Second is Integer range 0 .. 60; - - type Time_Value is mod 2 ** 32; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Clock; - - end Forge; - - - - - function Get_Hour - (This : in Clock) - return Hour; - - function Get_Minute - (This : in Clock) - return Minute; - - function Get_Second - (This : in Clock) - return Second; - - - - - function Get_Time - (This : in Clock) - return Time_Value; - - procedure Set_Time - (This : in out Clock; - To : in Time_Value); - - procedure Set_Time - (This : in out Clock; - Hours : in Hour; - Minutes : in Minute; - Seconds : in Second); - - - - - procedure Draw - (This : in out Clock); - - procedure Draw - (This : in out Clock; - X, Y, W, H : in Integer); - - function Handle - (This : in out Clock; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Clock is new Widget with null record; - - overriding procedure Finalize - (This : in out Clock); - - - - - pragma Inline (Get_Hour); - pragma Inline (Get_Minute); - pragma Inline (Get_Second); - - - pragma Inline (Get_Time); - pragma Inline (Set_Time); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Clocks; - diff --git a/src/fltk-widgets-groups-color_choosers.adb b/src/fltk-widgets-groups-color_choosers.adb deleted file mode 100644 index 9c3dda2..0000000 --- a/src/fltk-widgets-groups-color_choosers.adb +++ /dev/null @@ -1,350 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Groups.Color_Choosers is - - - procedure color_chooser_set_draw_hook - (W, D : in System.Address); - pragma Import (C, color_chooser_set_draw_hook, "color_chooser_set_draw_hook"); - pragma Inline (color_chooser_set_draw_hook); - - procedure color_chooser_set_handle_hook - (W, H : in System.Address); - pragma Import (C, color_chooser_set_handle_hook, "color_chooser_set_handle_hook"); - pragma Inline (color_chooser_set_handle_hook); - - - - - function new_fl_color_chooser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_color_chooser, "new_fl_color_chooser"); - pragma Inline (new_fl_color_chooser); - - procedure free_fl_color_chooser - (W : in System.Address); - pragma Import (C, free_fl_color_chooser, "free_fl_color_chooser"); - pragma Inline (free_fl_color_chooser); - - - - - function fl_color_chooser_r - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_r, "fl_color_chooser_r"); - pragma Inline (fl_color_chooser_r); - - function fl_color_chooser_g - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_g, "fl_color_chooser_g"); - pragma Inline (fl_color_chooser_g); - - function fl_color_chooser_b - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_b, "fl_color_chooser_b"); - pragma Inline (fl_color_chooser_b); - - function fl_color_chooser_rgb - (N : in System.Address; - R, G, B : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_color_chooser_rgb, "fl_color_chooser_rgb"); - pragma Inline (fl_color_chooser_rgb); - - - - - function fl_color_chooser_hue - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_hue, "fl_color_chooser_hue"); - pragma Inline (fl_color_chooser_hue); - - function fl_color_chooser_saturation - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_saturation, "fl_color_chooser_saturation"); - pragma Inline (fl_color_chooser_saturation); - - function fl_color_chooser_value - (N : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_color_chooser_value, "fl_color_chooser_value"); - pragma Inline (fl_color_chooser_value); - - function fl_color_chooser_hsv - (N : in System.Address; - H, S, V : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_color_chooser_hsv, "fl_color_chooser_hsv"); - pragma Inline (fl_color_chooser_hsv); - - - - - procedure fl_color_chooser_hsv2rgb - (H, S, V : in Interfaces.C.double; - R, G, B : out Interfaces.C.double); - pragma Import (C, fl_color_chooser_hsv2rgb, "fl_color_chooser_hsv2rgb"); - pragma Inline (fl_color_chooser_hsv2rgb); - - procedure fl_color_chooser_rgb2hsv - (R, G, B : in Interfaces.C.double; - H, S, V : out Interfaces.C.double); - pragma Import (C, fl_color_chooser_rgb2hsv, "fl_color_chooser_rgb2hsv"); - pragma Inline (fl_color_chooser_rgb2hsv); - - - - - function fl_color_chooser_get_mode - (N : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_color_chooser_get_mode, "fl_color_chooser_get_mode"); - pragma Inline (fl_color_chooser_get_mode); - - procedure fl_color_chooser_set_mode - (N : in System.Address; - M : in Interfaces.C.int); - pragma Import (C, fl_color_chooser_set_mode, "fl_color_chooser_set_mode"); - pragma Inline (fl_color_chooser_set_mode); - - - - - procedure fl_color_chooser_draw - (W : in System.Address); - pragma Import (C, fl_color_chooser_draw, "fl_color_chooser_draw"); - pragma Inline (fl_color_chooser_draw); - - function fl_color_chooser_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_color_chooser_handle, "fl_color_chooser_handle"); - pragma Inline (fl_color_chooser_handle); - - - - - procedure Finalize - (This : in out Color_Chooser) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Color_Chooser'Class - then - This.Clear; - free_fl_color_chooser (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Color_Chooser is - begin - return This : Color_Chooser do - This.Void_Ptr := new_fl_color_chooser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - color_chooser_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - color_chooser_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Red - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_r (This.Void_Ptr)); - end Get_Red; - - - function Get_Green - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_g (This.Void_Ptr)); - end Get_Green; - - - function Get_Blue - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_b (This.Void_Ptr)); - end Get_Blue; - - - procedure Set_RGB - (This : in out Color_Chooser; - R, G, B : in Long_Float) is - begin - This.Was_Changed := fl_color_chooser_rgb - (This.Void_Ptr, - Interfaces.C.double (R), - Interfaces.C.double (G), - Interfaces.C.double (B)) /= 0; - end Set_RGB; - - - - - function Get_Hue - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_hue (This.Void_Ptr)); - end Get_Hue; - - - function Get_Saturation - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_saturation (This.Void_Ptr)); - end Get_Saturation; - - - function Get_Value - (This : in Color_Chooser) - return Long_Float is - begin - return Long_Float (fl_color_chooser_value (This.Void_Ptr)); - end Get_Value; - - - procedure Set_HSV - (This : in out Color_Chooser; - H, S, V : in Long_Float) is - begin - This.Was_Changed := fl_color_chooser_hsv - (This.Void_Ptr, - Interfaces.C.double (H), - Interfaces.C.double (S), - Interfaces.C.double (V)) /= 0; - end Set_HSV; - - - - - procedure HSV_To_RGB - (H, S, V : in Long_Float; - R, G, B : out Long_Float) is - begin - fl_color_chooser_hsv2rgb - (Interfaces.C.double (H), - Interfaces.C.double (S), - Interfaces.C.double (V), - Interfaces.C.double (R), - Interfaces.C.double (G), - Interfaces.C.double (B)); - end HSV_To_RGB; - - - procedure RGB_To_HSV - (R, G, B : in Long_Float; - H, S, V : out Long_Float) is - begin - fl_color_chooser_rgb2hsv - (Interfaces.C.double (R), - Interfaces.C.double (G), - Interfaces.C.double (B), - Interfaces.C.double (H), - Interfaces.C.double (S), - Interfaces.C.double (V)); - end RGB_To_HSV; - - - - - function Color_Was_Changed - (This : in Color_Chooser) - return Boolean is - begin - return This.Was_Changed; - end Color_Was_Changed; - - - procedure Clear_Changed - (This : in out Color_Chooser) is - begin - This.Was_Changed := False; - end Clear_Changed; - - - - - function Get_Mode - (This : in Color_Chooser) - return Color_Mode is - begin - return Color_Mode'Val (fl_color_chooser_get_mode (This.Void_Ptr)); - end Get_Mode; - - - procedure Set_Mode - (This : in out Color_Chooser; - To : in Color_Mode) is - begin - fl_color_chooser_set_mode (This.Void_Ptr, Color_Mode'Pos (To)); - end Set_Mode; - - - - - procedure Draw - (This : in out Color_Chooser) is - begin - fl_color_chooser_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Color_Chooser; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_color_chooser_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Color_Choosers; - diff --git a/src/fltk-widgets-groups-color_choosers.ads b/src/fltk-widgets-groups-color_choosers.ads deleted file mode 100644 index abc5974..0000000 --- a/src/fltk-widgets-groups-color_choosers.ads +++ /dev/null @@ -1,149 +0,0 @@ - - -package FLTK.Widgets.Groups.Color_Choosers is - - - type Color_Chooser is new Group with private; - - type Color_Chooser_Reference (Data : not null access Color_Chooser'Class) is - limited null record with Implicit_Dereference => Data; - - type Color_Mode is (RGB, Byte, Hex, HSV); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Color_Chooser; - - end Forge; - - - - - function Get_Red - (This : in Color_Chooser) - return Long_Float; - - function Get_Green - (This : in Color_Chooser) - return Long_Float; - - function Get_Blue - (This : in Color_Chooser) - return Long_Float; - - procedure Set_RGB - (This : in out Color_Chooser; - R, G, B : in Long_Float); - - - - - function Get_Hue - (This : in Color_Chooser) - return Long_Float; - - function Get_Saturation - (This : in Color_Chooser) - return Long_Float; - - function Get_Value - (This : in Color_Chooser) - return Long_Float; - - procedure Set_HSV - (This : in out Color_Chooser; - H, S, V : in Long_Float); - - - - - procedure HSV_To_RGB - (H, S, V : in Long_Float; - R, G, B : out Long_Float); - - procedure RGB_To_HSV - (R, G, B : in Long_Float; - H, S, V : out Long_Float); - - - - - function Color_Was_Changed - (This : in Color_Chooser) - return Boolean; - - procedure Clear_Changed - (This : in out Color_Chooser); - - - - - function Get_Mode - (This : in Color_Chooser) - return Color_Mode; - - procedure Set_Mode - (This : in out Color_Chooser; - To : in Color_Mode); - - - - - procedure Draw - (This : in out Color_Chooser); - - function Handle - (This : in out Color_Chooser; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Color_Chooser is new Group with record - Was_Changed : Boolean := False; - end record; - - overriding procedure Finalize - (This : in out Color_Chooser); - - - - - pragma Inline (Get_Red); - pragma Inline (Get_Green); - pragma Inline (Get_Blue); - pragma Inline (Set_RGB); - - - pragma Inline (Get_Hue); - pragma Inline (Get_Saturation); - pragma Inline (Get_Value); - pragma Inline (Set_HSV); - - - pragma Inline (HSV_To_RGB); - pragma Inline (RGB_To_HSV); - - - pragma Inline (Color_Was_Changed); - pragma Inline (Clear_Changed); - - - pragma Inline (Get_Mode); - pragma Inline (Set_Mode); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Color_Choosers; - diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb deleted file mode 100644 index 2a7db68..0000000 --- a/src/fltk-widgets-groups-input_choices.adb +++ /dev/null @@ -1,402 +0,0 @@ - - -with - - Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Groups.Input_Choices is - - - procedure input_choice_set_draw_hook - (W, D : in System.Address); - pragma Import (C, input_choice_set_draw_hook, "input_choice_set_draw_hook"); - pragma Inline (input_choice_set_draw_hook); - - procedure input_choice_set_handle_hook - (W, H : in System.Address); - pragma Import (C, input_choice_set_handle_hook, "input_choice_set_handle_hook"); - pragma Inline (input_choice_set_handle_hook); - - - - - function new_fl_input_choice - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_input_choice, "new_fl_input_choice"); - pragma Inline (new_fl_input_choice); - - procedure free_fl_input_choice - (W : in System.Address); - pragma Import (C, free_fl_input_choice, "free_fl_input_choice"); - pragma Inline (free_fl_input_choice); - - - - - function fl_input_choice_input - (N : in System.Address) - return System.Address; - pragma Import (C, fl_input_choice_input, "fl_input_choice_input"); - pragma Inline (fl_input_choice_input); - - function fl_input_choice_menubutton - (N : in System.Address) - return System.Address; - pragma Import (C, fl_input_choice_menubutton, "fl_input_choice_menubutton"); - pragma Inline (fl_input_choice_menubutton); - - - - - procedure fl_input_choice_clear - (N : in System.Address); - pragma Import (C, fl_input_choice_clear, "fl_input_choice_clear"); - pragma Inline (fl_input_choice_clear); - - - - - function fl_input_choice_changed - (N : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_choice_changed, "fl_input_choice_changed"); - pragma Inline (fl_input_choice_changed); - - procedure fl_input_choice_clear_changed - (N : in System.Address); - pragma Import (C, fl_input_choice_clear_changed, "fl_input_choice_clear_changed"); - pragma Inline (fl_input_choice_clear_changed); - - procedure fl_input_choice_set_changed - (N : in System.Address); - pragma Import (C, fl_input_choice_set_changed, "fl_input_choice_set_changed"); - pragma Inline (fl_input_choice_set_changed); - - function fl_input_choice_get_down_box - (N : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_choice_get_down_box, "fl_input_choice_get_down_box"); - pragma Inline (fl_input_choice_get_down_box); - - procedure fl_input_choice_set_down_box - (N : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_choice_set_down_box, "fl_input_choice_set_down_box"); - pragma Inline (fl_input_choice_set_down_box); - - function fl_input_choice_get_textcolor - (N : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_input_choice_get_textcolor, "fl_input_choice_get_textcolor"); - pragma Inline (fl_input_choice_get_textcolor); - - procedure fl_input_choice_set_textcolor - (N : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_input_choice_set_textcolor, "fl_input_choice_set_textcolor"); - pragma Inline (fl_input_choice_set_textcolor); - - function fl_input_choice_get_textfont - (N : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_choice_get_textfont, "fl_input_choice_get_textfont"); - pragma Inline (fl_input_choice_get_textfont); - - procedure fl_input_choice_set_textfont - (N : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_choice_set_textfont, "fl_input_choice_set_textfont"); - pragma Inline (fl_input_choice_set_textfont); - - function fl_input_choice_get_textsize - (N : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_choice_get_textsize, "fl_input_choice_get_textsize"); - pragma Inline (fl_input_choice_get_textsize); - - procedure fl_input_choice_set_textsize - (N : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_choice_set_textsize, "fl_input_choice_set_textsize"); - pragma Inline (fl_input_choice_set_textsize); - - function fl_input_choice_get_value - (N : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_input_choice_get_value, "fl_input_choice_get_value"); - pragma Inline (fl_input_choice_get_value); - - procedure fl_input_choice_set_value - (N : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_input_choice_set_value, "fl_input_choice_set_value"); - pragma Inline (fl_input_choice_set_value); - - procedure fl_input_choice_set_value2 - (N : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_choice_set_value2, "fl_input_choice_set_value2"); - pragma Inline (fl_input_choice_set_value2); - - - - - procedure fl_input_choice_draw - (W : in System.Address); - pragma Import (C, fl_input_choice_draw, "fl_input_choice_draw"); - pragma Inline (fl_input_choice_draw); - - function fl_input_choice_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_choice_handle, "fl_input_choice_handle"); - pragma Inline (fl_input_choice_handle); - - - - - procedure Free is new Ada.Unchecked_Deallocation - (INP.Input, Input_Access); - procedure Free is new Ada.Unchecked_Deallocation - (MB.Menu_Button, Menu_Button_Access); - - - - - procedure Finalize - (This : in out Input_Choice) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Input_Choice'Class - then - Group (This).Clear; - free_fl_input_choice (This.Void_Ptr); - Free (This.My_Input); - Free (This.My_Menu_Button); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Input_Choice is - begin - return This : Input_Choice do - This.Void_Ptr := new_fl_input_choice - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - input_choice_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - input_choice_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - This.My_Input := new INP.Input; - Wrapper (This.My_Input.all).Void_Ptr := - fl_input_choice_input (This.Void_Ptr); - Wrapper (This.My_Input.all).Needs_Dealloc := False; - - This.My_Menu_Button := new MB.Menu_Button; - Wrapper (This.My_Menu_Button.all).Void_Ptr := - fl_input_choice_menubutton (This.Void_Ptr); - Wrapper (This.My_Menu_Button.all).Needs_Dealloc := False; - end return; - end Create; - - end Forge; - - - - - function Input - (This : in out Input_Choice) - return INP.Input_Reference is - begin - return (Data => This.My_Input); - end Input; - - - function Menu_Button - (This : in out Input_Choice) - return MB.Menu_Button_Reference is - begin - return (Data => This.My_Menu_Button); - end Menu_Button; - - - - - procedure Clear - (This : in out Input_Choice) is - begin - fl_input_choice_clear (This.Void_Ptr); - end Clear; - - - - - function Has_Changed - (This : in Input_Choice) - return Boolean is - begin - return fl_input_choice_changed (This.Void_Ptr) /= 0; - end Has_Changed; - - - procedure Clear_Changed - (This : in out Input_Choice) is - begin - fl_input_choice_clear_changed (This.Void_Ptr); - end Clear_Changed; - - - procedure Set_Changed - (This : in out Input_Choice; - To : in Boolean) is - begin - if To then - fl_input_choice_set_changed (This.Void_Ptr); - end if; - end Set_Changed; - - - function Get_Down_Box - (This : in Input_Choice) - return Box_Kind is - begin - return Box_Kind'Val (fl_input_choice_get_down_box (This.Void_Ptr)); - end Get_Down_Box; - - - procedure Set_Down_Box - (This : in out Input_Choice; - To : in Box_Kind) is - begin - fl_input_choice_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Down_Box; - - - function Get_Text_Color - (This : in Input_Choice) - return Color is - begin - return Color (fl_input_choice_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Input_Choice; - To : in Color) is - begin - fl_input_choice_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Input_Choice) - return Font_Kind is - begin - return Font_Kind'Val (fl_input_choice_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Input_Choice; - To : in Font_Kind) is - begin - fl_input_choice_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Input_Choice) - return Font_Size is - begin - return Font_Size (fl_input_choice_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Input_Choice; - To : in Font_Size) is - begin - fl_input_choice_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - function Get_Input - (This : in Input_Choice) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_choice_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - -- pointer to internal buffer so no free necessary - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Input; - - - procedure Set_Input - (This : in out Input_Choice; - To : in String) is - begin - fl_input_choice_set_value (This.Void_Ptr, Interfaces.C.To_C (To)); - end Set_Input; - - - procedure Set_Item - (This : in out Input_Choice; - Num : in Integer) is - begin - fl_input_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Num)); - end Set_Item; - - - - - procedure Draw - (This : in out Input_Choice) is - begin - fl_input_choice_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Input_Choice; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_input_choice_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Input_Choices; - diff --git a/src/fltk-widgets-groups-input_choices.ads b/src/fltk-widgets-groups-input_choices.ads deleted file mode 100644 index bd38898..0000000 --- a/src/fltk-widgets-groups-input_choices.ads +++ /dev/null @@ -1,162 +0,0 @@ - - -with - - FLTK.Widgets.Inputs, - FLTK.Widgets.Menus.Menu_Buttons; - - -package FLTK.Widgets.Groups.Input_Choices is - - - type Input_Choice is new Group with private; - - type Input_Choice_Reference (Data : not null access Input_Choice'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Input_Choice; - - end Forge; - - - - - function Input - (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Input_Reference; - - function Menu_Button - (This : in out Input_Choice) - return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference; - - - - - procedure Clear - (This : in out Input_Choice); - - - - - function Has_Changed - (This : in Input_Choice) - return Boolean; - - procedure Clear_Changed - (This : in out Input_Choice); - - procedure Set_Changed - (This : in out Input_Choice; - To : in Boolean); - - function Get_Down_Box - (This : in Input_Choice) - return Box_Kind; - - procedure Set_Down_Box - (This : in out Input_Choice; - To : in Box_Kind); - - function Get_Text_Color - (This : in Input_Choice) - return Color; - - procedure Set_Text_Color - (This : in out Input_Choice; - To : in Color); - - function Get_Text_Font - (This : in Input_Choice) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Input_Choice; - To : in Font_Kind); - - function Get_Text_Size - (This : in Input_Choice) - return Font_Size; - - procedure Set_Text_Size - (This : in out Input_Choice; - To : in Font_Size); - - function Get_Input - (This : in Input_Choice) - return String; - - procedure Set_Input - (This : in out Input_Choice; - To : in String); - - procedure Set_Item - (This : in out Input_Choice; - Num : in Integer); - - - - - procedure Draw - (This : in out Input_Choice); - - function Handle - (This : in out Input_Choice; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - package INP renames FLTK.Widgets.Inputs; - package MB renames FLTK.Widgets.Menus.Menu_Buttons; - - - type Input_Access is access INP.Input; - type Menu_Button_Access is access MB.Menu_Button; - - - type Input_Choice is new Group with record - My_Input : Input_Access; - My_Menu_Button : Menu_Button_Access; - end record; - - overriding procedure Finalize - (This : in out Input_Choice); - - - - - pragma Inline (Input); - pragma Inline (Menu_Button); - - - pragma Inline (Has_Changed); - pragma Inline (Clear_Changed); - pragma Inline (Get_Down_Box); - pragma Inline (Set_Down_Box); - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - pragma Inline (Get_Input); - pragma Inline (Set_Input); - pragma Inline (Set_Item); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Input_Choices; - diff --git a/src/fltk-widgets-groups-packed.adb b/src/fltk-widgets-groups-packed.adb deleted file mode 100644 index 69b6e7c..0000000 --- a/src/fltk-widgets-groups-packed.adb +++ /dev/null @@ -1,155 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Packed is - - - procedure pack_set_draw_hook - (W, D : in System.Address); - pragma Import (C, pack_set_draw_hook, "pack_set_draw_hook"); - pragma Inline (pack_set_draw_hook); - - procedure pack_set_handle_hook - (W, H : in System.Address); - pragma Import (C, pack_set_handle_hook, "pack_set_handle_hook"); - pragma Inline (pack_set_handle_hook); - - - - - function new_fl_pack - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_pack, "new_fl_pack"); - pragma Inline (new_fl_pack); - - procedure free_fl_pack - (B : in System.Address); - pragma Import (C, free_fl_pack, "free_fl_pack"); - pragma Inline (free_fl_pack); - - - - - function fl_pack_get_spacing - (P : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_pack_get_spacing, "fl_pack_get_spacing"); - pragma Inline (fl_pack_get_spacing); - - procedure fl_pack_set_spacing - (P : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_pack_set_spacing, "fl_pack_set_spacing"); - pragma Inline (fl_pack_set_spacing); - - - - - procedure fl_pack_draw - (W : in System.Address); - pragma Import (C, fl_pack_draw, "fl_pack_draw"); - pragma Inline (fl_pack_draw); - - function fl_pack_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_pack_handle, "fl_pack_handle"); - pragma Inline (fl_pack_handle); - - - - - procedure Finalize - (This : in out Packed_Group) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Packed_Group'Class - then - This.Clear; - free_fl_pack (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Packed_Group is - begin - return This : Packed_Group do - This.Void_Ptr := new_fl_pack - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - pack_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - pack_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Spacing - (This : in Packed_Group) - return Integer is - begin - return Integer (fl_pack_get_spacing (This.Void_Ptr)); - end Get_Spacing; - - - procedure Set_Spacing - (This : in out Packed_Group; - To : in Integer) is - begin - fl_pack_set_spacing (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Spacing; - - - - - procedure Draw - (This : in out Packed_Group) is - begin - fl_pack_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Packed_Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_pack_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Packed; - diff --git a/src/fltk-widgets-groups-packed.ads b/src/fltk-widgets-groups-packed.ads deleted file mode 100644 index 65d5e42..0000000 --- a/src/fltk-widgets-groups-packed.ads +++ /dev/null @@ -1,66 +0,0 @@ - - -package FLTK.Widgets.Groups.Packed is - - - type Packed_Group is new Group with private; - - type Packed_Group_Reference (Data : not null access Packed_Group'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Packed_Group; - - end Forge; - - - - - function Get_Spacing - (This : in Packed_Group) - return Integer; - - procedure Set_Spacing - (This : in out Packed_Group; - To : in Integer); - - - - - procedure Draw - (This : in out Packed_Group); - - function Handle - (This : in out Packed_Group; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Packed_Group is new Group with null record; - - overriding procedure Finalize - (This : in out Packed_Group); - - - - - pragma Inline (Get_Spacing); - pragma Inline (Set_Spacing); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Packed; - diff --git a/src/fltk-widgets-groups-scrolls.adb b/src/fltk-widgets-groups-scrolls.adb deleted file mode 100644 index 50a2728..0000000 --- a/src/fltk-widgets-groups-scrolls.adb +++ /dev/null @@ -1,233 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Scrolls is - - - procedure scroll_set_draw_hook - (S, D : in System.Address); - pragma Import (C, scroll_set_draw_hook, "scroll_set_draw_hook"); - pragma Inline (scroll_set_draw_hook); - - procedure scroll_set_handle_hook - (S, H : in System.Address); - pragma Import (C, scroll_set_handle_hook, "scroll_set_handle_hook"); - pragma Inline (scroll_set_handle_hook); - - - - - function new_fl_scroll - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_scroll, "new_fl_scroll"); - pragma Inline (new_fl_scroll); - - procedure free_fl_scroll - (S : in System.Address); - pragma Import (C, free_fl_scroll, "free_fl_scroll"); - pragma Inline (free_fl_scroll); - - - - - procedure fl_scroll_clear - (S : in System.Address); - pragma Import (C, fl_scroll_clear, "fl_scroll_clear"); - pragma Inline (fl_scroll_clear); - - - - - procedure fl_scroll_to - (S : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_scroll_to, "fl_scroll_to"); - pragma Inline (fl_scroll_to); - - procedure fl_scroll_set_type - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_scroll_set_type, "fl_scroll_set_type"); - pragma Inline (fl_scroll_set_type); - - - - - function fl_scroll_get_size - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_scroll_get_size, "fl_scroll_get_size"); - pragma Inline (fl_scroll_get_size); - - procedure fl_scroll_set_size - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_scroll_set_size, "fl_scroll_set_size"); - pragma Inline (fl_scroll_set_size); - - function fl_scroll_xposition - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_scroll_xposition, "fl_scroll_xposition"); - pragma Inline (fl_scroll_xposition); - - function fl_scroll_yposition - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_scroll_yposition, "fl_scroll_yposition"); - pragma Inline (fl_scroll_yposition); - - - - - procedure fl_scroll_draw - (S : in System.Address); - pragma Import (C, fl_scroll_draw, "fl_scroll_draw"); - pragma Inline (fl_scroll_draw); - - function fl_scroll_handle - (S : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_scroll_handle, "fl_scroll_handle"); - pragma Inline (fl_scroll_handle); - - - - - procedure Finalize - (This : in out Scroll) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Scroll'Class - then - This.Clear; - free_fl_scroll (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Scroll is - begin - return This : Scroll do - This.Void_Ptr := new_fl_scroll - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - scroll_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - scroll_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Clear - (This : in out Scroll) is - begin - fl_scroll_clear (This.Void_Ptr); - end Clear; - - - - - procedure Scroll_To - (This : in out Scroll; - X, Y : in Integer) is - begin - fl_scroll_to (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)); - end Scroll_To; - - - procedure Set_Type - (This : in out Scroll; - Mode : in Scroll_Kind) is - begin - fl_scroll_set_type (This.Void_Ptr, Scroll_Kind'Pos (Mode)); - end Set_Type; - - - - - function Get_Scrollbar_Size - (This : in Scroll) - return Integer is - begin - return Integer (fl_scroll_get_size (This.Void_Ptr)); - end Get_Scrollbar_Size; - - - procedure Set_Scrollbar_Size - (This : in out Scroll; - To : in Integer) is - begin - fl_scroll_set_size (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Scrollbar_Size; - - - function Get_Scroll_X - (This : in Scroll) - return Integer is - begin - return Integer (fl_scroll_xposition (This.Void_Ptr)); - end Get_Scroll_X; - - - function Get_Scroll_Y - (This : in Scroll) - return Integer is - begin - return Integer (fl_scroll_yposition (This.Void_Ptr)); - end Get_Scroll_Y; - - - - - procedure Draw - (This : in out Scroll) is - begin - fl_scroll_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Scroll; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_scroll_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Scrolls; - diff --git a/src/fltk-widgets-groups-scrolls.ads b/src/fltk-widgets-groups-scrolls.ads deleted file mode 100644 index fcd435a..0000000 --- a/src/fltk-widgets-groups-scrolls.ads +++ /dev/null @@ -1,111 +0,0 @@ - - -package FLTK.Widgets.Groups.Scrolls is - - - type Scroll is new Group with private; - - type Scroll_Reference (Data : not null access Scroll'Class) is limited null record - with Implicit_Dereference => Data; - - type Scroll_Kind is - (Horizontal, - Vertical, - Both, - Always_On, - Horizontal_Always, - Vertical_Always, - Both_Always); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Scroll; - - end Forge; - - - - - procedure Clear - (This : in out Scroll); - - - - - procedure Scroll_To - (This : in out Scroll; - X, Y : in Integer); - - procedure Set_Type - (This : in out Scroll; - Mode : in Scroll_Kind); - - - - - function Get_Scrollbar_Size - (This : in Scroll) - return Integer; - - procedure Set_Scrollbar_Size - (This : in out Scroll; - To : in Integer); - - -- These two functions are far too similar in name and - -- function to the Get_X and Get_Y for Widgets. - function Get_Scroll_X - (This : in Scroll) - return Integer; - - function Get_Scroll_Y - (This : in Scroll) - return Integer; - - - - - procedure Draw - (This : in out Scroll); - - function Handle - (This : in out Scroll; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Scroll is new Group with null record; - - overriding procedure Finalize - (This : in out Scroll); - - - - - pragma Inline (Clear); - - - pragma Inline (Scroll_To); - pragma Inline (Set_Type); - - - pragma Inline (Get_Scrollbar_Size); - pragma Inline (Set_Scrollbar_Size); - pragma Inline (Get_Scroll_X); - pragma Inline (Get_Scroll_Y); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Scrolls; - diff --git a/src/fltk-widgets-groups-spinners.adb b/src/fltk-widgets-groups-spinners.adb deleted file mode 100644 index fa12bb3..0000000 --- a/src/fltk-widgets-groups-spinners.adb +++ /dev/null @@ -1,439 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Groups.Spinners is - - - procedure spinner_set_draw_hook - (W, D : in System.Address); - pragma Import (C, spinner_set_draw_hook, "spinner_set_draw_hook"); - pragma Inline (spinner_set_draw_hook); - - procedure spinner_set_handle_hook - (W, H : in System.Address); - pragma Import (C, spinner_set_handle_hook, "spinner_set_handle_hook"); - pragma Inline (spinner_set_handle_hook); - - - - - function new_fl_spinner - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_spinner, "new_fl_spinner"); - pragma Inline (new_fl_spinner); - - procedure free_fl_spinner - (W : in System.Address); - pragma Import (C, free_fl_spinner, "free_fl_spinner"); - pragma Inline (free_fl_spinner); - - - - - function fl_spinner_get_color - (S : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_spinner_get_color, "fl_spinner_get_color"); - pragma Inline (fl_spinner_get_color); - - procedure fl_spinner_set_color - (S : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_spinner_set_color, "fl_spinner_set_color"); - pragma Inline (fl_spinner_set_color); - - function fl_spinner_get_selection_color - (S : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_spinner_get_selection_color, "fl_spinner_get_selection_color"); - pragma Inline (fl_spinner_get_selection_color); - - procedure fl_spinner_set_selection_color - (S : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_spinner_set_selection_color, "fl_spinner_set_selection_color"); - pragma Inline (fl_spinner_set_selection_color); - - function fl_spinner_get_textcolor - (S : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_spinner_get_textcolor, "fl_spinner_get_textcolor"); - pragma Inline (fl_spinner_get_textcolor); - - procedure fl_spinner_set_textcolor - (S : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_spinner_set_textcolor, "fl_spinner_set_textcolor"); - pragma Inline (fl_spinner_set_textcolor); - - function fl_spinner_get_textfont - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_spinner_get_textfont, "fl_spinner_get_textfont"); - pragma Inline (fl_spinner_get_textfont); - - procedure fl_spinner_set_textfont - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_spinner_set_textfont, "fl_spinner_set_textfont"); - pragma Inline (fl_spinner_set_textfont); - - function fl_spinner_get_textsize - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_spinner_get_textsize, "fl_spinner_get_textsize"); - pragma Inline (fl_spinner_get_textsize); - - procedure fl_spinner_set_textsize - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_spinner_set_textsize, "fl_spinner_set_textsize"); - pragma Inline (fl_spinner_set_textsize); - - - - - function fl_spinner_get_minimum - (S : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_spinner_get_minimum, "fl_spinner_get_minimum"); - pragma Inline (fl_spinner_get_minimum); - - procedure fl_spinner_set_minimum - (S : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_spinner_set_minimum, "fl_spinner_set_minimum"); - pragma Inline (fl_spinner_set_minimum); - - function fl_spinner_get_maximum - (S : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_spinner_get_maximum, "fl_spinner_get_maximum"); - pragma Inline (fl_spinner_get_maximum); - - procedure fl_spinner_set_maximum - (S : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_spinner_set_maximum, "fl_spinner_set_maximum"); - pragma Inline (fl_spinner_set_maximum); - - procedure fl_spinner_range - (S : in System.Address; - A, B : in Interfaces.C.double); - pragma Import (C, fl_spinner_range, "fl_spinner_range"); - pragma Inline (fl_spinner_range); - - function fl_spinner_get_step - (S : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_spinner_get_step, "fl_spinner_get_step"); - pragma Inline (fl_spinner_get_step); - - procedure fl_spinner_set_step - (S : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_spinner_set_step, "fl_spinner_set_step"); - pragma Inline (fl_spinner_set_step); - - function fl_spinner_get_type - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_spinner_get_type, "fl_spinner_get_type"); - pragma Inline (fl_spinner_get_type); - - procedure fl_spinner_set_type - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_spinner_set_type, "fl_spinner_set_type"); - pragma Inline (fl_spinner_set_type); - - function fl_spinner_get_value - (S : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_spinner_get_value, "fl_spinner_get_value"); - pragma Inline (fl_spinner_get_value); - - procedure fl_spinner_set_value - (S : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_spinner_set_value, "fl_spinner_set_value"); - pragma Inline (fl_spinner_set_value); - - - - - procedure fl_spinner_draw - (W : in System.Address); - pragma Import (C, fl_spinner_draw, "fl_spinner_draw"); - pragma Inline (fl_spinner_draw); - - function fl_spinner_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_spinner_handle, "fl_spinner_handle"); - pragma Inline (fl_spinner_handle); - - - - - procedure Finalize - (This : in out Spinner) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Spinner'Class - then - This.Clear; - free_fl_spinner (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Spinner is - begin - return This : Spinner do - This.Void_Ptr := new_fl_spinner - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - spinner_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - spinner_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Background_Color - (This : in Spinner) - return Color is - begin - return Color (fl_spinner_get_color (This.Void_Ptr)); - end Get_Background_Color; - - - procedure Set_Background_Color - (This : in out Spinner; - To : in Color) is - begin - fl_spinner_set_color (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Background_Color; - - - function Get_Selection_Color - (This : in Spinner) - return Color is - begin - return Color (fl_spinner_get_selection_color (This.Void_Ptr)); - end Get_Selection_Color; - - - procedure Set_Selection_Color - (This : in out Spinner; - To : in Color) is - begin - fl_spinner_set_selection_color (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Selection_Color; - - - function Get_Text_Color - (This : in Spinner) - return Color is - begin - return Color (fl_spinner_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Spinner; - To : in Color) is - begin - fl_spinner_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Spinner) - return Font_Kind is - begin - return Font_Kind'Val (fl_spinner_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Spinner; - To : in Font_Kind) is - begin - fl_spinner_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Spinner) - return Font_Size is - begin - return Font_Size (fl_spinner_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Spinner; - To : in Font_Size) is - begin - fl_spinner_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - function Get_Minimum - (This : in Spinner) - return Long_Float is - begin - return Long_Float (fl_spinner_get_minimum (This.Void_Ptr)); - end Get_Minimum; - - - procedure Set_Minimum - (This : in out Spinner; - To : in Long_Float) is - begin - fl_spinner_set_minimum (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Minimum; - - - function Get_Maximum - (This : in Spinner) - return Long_Float is - begin - return Long_Float (fl_spinner_get_maximum (This.Void_Ptr)); - end Get_Maximum; - - - procedure Set_Maximum - (This : in out Spinner; - To : in Long_Float) is - begin - fl_spinner_set_maximum (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Maximum; - - - procedure Get_Range - (This : in Spinner; - Min, Max : out Long_Float) is - begin - Min := Long_Float (fl_spinner_get_minimum (This.Void_Ptr)); - Max := Long_Float (fl_spinner_get_maximum (This.Void_Ptr)); - end Get_Range; - - - procedure Set_Range - (This : in out Spinner; - Min, Max : in Long_Float) is - begin - fl_spinner_range - (This.Void_Ptr, - Interfaces.C.double (Min), - Interfaces.C.double (Max)); - end Set_Range; - - - function Get_Step - (This : in Spinner) - return Long_Float is - begin - return Long_Float (fl_spinner_get_step (This.Void_Ptr)); - end Get_Step; - - - procedure Set_Step - (This : in out Spinner; - To : in Long_Float) is - begin - fl_spinner_set_step (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Step; - - - function Get_Type - (This : in Spinner) - return Spinner_Kind is - begin - return Spinner_Kind'Val (fl_spinner_get_type (This.Void_Ptr) - 1); - end Get_Type; - - - procedure Set_Type - (This : in out Spinner; - To : in Spinner_Kind) is - begin - fl_spinner_set_type (This.Void_Ptr, Spinner_Kind'Pos (To) + 1); - end Set_Type; - - - function Get_Value - (This : in Spinner) - return Long_Float is - begin - return Long_Float (fl_spinner_get_value (This.Void_Ptr)); - end Get_Value; - - - procedure Set_Value - (This : in out Spinner; - To : in Long_Float) is - begin - fl_spinner_set_value (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Value; - - - - - procedure Draw - (This : in out Spinner) is - begin - fl_spinner_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Spinner; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_spinner_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Spinners; - diff --git a/src/fltk-widgets-groups-spinners.ads b/src/fltk-widgets-groups-spinners.ads deleted file mode 100644 index 103a824..0000000 --- a/src/fltk-widgets-groups-spinners.ads +++ /dev/null @@ -1,172 +0,0 @@ - - -package FLTK.Widgets.Groups.Spinners is - - - type Spinner is new Group with private; - - type Spinner_Reference (Data : not null access Spinner'Class) is limited null record - with Implicit_Dereference => Data; - - type Spinner_Kind is (Float_Spin, Int_Spin); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Spinner; - - end Forge; - - - - - function Get_Background_Color - (This : in Spinner) - return Color; - - procedure Set_Background_Color - (This : in out Spinner; - To : in Color); - - function Get_Selection_Color - (This : in Spinner) - return Color; - - procedure Set_Selection_Color - (This : in out Spinner; - To : in Color); - - function Get_Text_Color - (This : in Spinner) - return Color; - - procedure Set_Text_Color - (This : in out Spinner; - To : in Color); - - function Get_Text_Font - (This : in Spinner) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Spinner; - To : in Font_Kind); - - function Get_Text_Size - (This : in Spinner) - return Font_Size; - - procedure Set_Text_Size - (This : in out Spinner; - To : in Font_Size); - - - - - function Get_Minimum - (This : in Spinner) - return Long_Float; - - procedure Set_Minimum - (This : in out Spinner; - To : in Long_Float); - - function Get_Maximum - (This : in Spinner) - return Long_Float; - - procedure Set_Maximum - (This : in out Spinner; - To : in Long_Float); - - procedure Get_Range - (This : in Spinner; - Min, Max : out Long_Float); - - procedure Set_Range - (This : in out Spinner; - Min, Max : in Long_Float); - - function Get_Step - (This : in Spinner) - return Long_Float; - - procedure Set_Step - (This : in out Spinner; - To : in Long_Float); - - function Get_Type - (This : in Spinner) - return Spinner_Kind; - - procedure Set_Type - (This : in out Spinner; - To : in Spinner_Kind); - - function Get_Value - (This : in Spinner) - return Long_Float; - - procedure Set_Value - (This : in out Spinner; - To : in Long_Float); - - - - - procedure Draw - (This : in out Spinner); - - function Handle - (This : in out Spinner; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Spinner is new Group with null record; - - overriding procedure Finalize - (This : in out Spinner); - - - - - pragma Inline (Get_Background_Color); - pragma Inline (Set_Background_Color); - pragma Inline (Get_Selection_Color); - pragma Inline (Set_Selection_Color); - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Get_Minimum); - pragma Inline (Set_Minimum); - pragma Inline (Get_Maximum); - pragma Inline (Set_Maximum); - pragma Inline (Set_Range); - pragma Inline (Get_Step); - pragma Inline (Set_Step); - pragma Inline (Get_Type); - pragma Inline (Set_Type); - pragma Inline (Get_Value); - pragma Inline (Set_Value); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Spinners; - diff --git a/src/fltk-widgets-groups-tabbed.adb b/src/fltk-widgets-groups-tabbed.adb deleted file mode 100644 index 76e1b0d..0000000 --- a/src/fltk-widgets-groups-tabbed.adb +++ /dev/null @@ -1,239 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Tabbed is - - - procedure tabs_set_draw_hook - (W, D : in System.Address); - pragma Import (C, tabs_set_draw_hook, "tabs_set_draw_hook"); - pragma Inline (tabs_set_draw_hook); - - procedure tabs_set_handle_hook - (W, H : in System.Address); - pragma Import (C, tabs_set_handle_hook, "tabs_set_handle_hook"); - pragma Inline (tabs_set_handle_hook); - - - - - function new_fl_tabs - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_tabs, "new_fl_tabs"); - pragma Inline (new_fl_tabs); - - procedure free_fl_tabs - (S : in System.Address); - pragma Import (C, free_fl_tabs, "free_fl_tabs"); - pragma Inline (free_fl_tabs); - - - - - procedure fl_tabs_client_area - (T : in System.Address; - X, Y, W, H : out Interfaces.C.int; - I : in Interfaces.C.int); - pragma Import (C, fl_tabs_client_area, "fl_tabs_client_area"); - pragma Inline (fl_tabs_client_area); - - - - - function fl_tabs_get_push - (T : in System.Address) - return System.Address; - pragma Import (C, fl_tabs_get_push, "fl_tabs_get_push"); - pragma Inline (fl_tabs_get_push); - - procedure fl_tabs_set_push - (T, I : in System.Address); - pragma Import (C, fl_tabs_set_push, "fl_tabs_set_push"); - pragma Inline (fl_tabs_set_push); - - function fl_tabs_get_value - (T : in System.Address) - return System.Address; - pragma Import (C, fl_tabs_get_value, "fl_tabs_get_value"); - pragma Inline (fl_tabs_get_value); - - procedure fl_tabs_set_value - (T, V : in System.Address); - pragma Import (C, fl_tabs_set_value, "fl_tabs_set_value"); - pragma Inline (fl_tabs_set_value); - - function fl_tabs_which - (T : in System.Address; - X, Y : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_tabs_which, "fl_tabs_which"); - pragma Inline (fl_tabs_which); - - - - - procedure fl_tabs_draw - (W : in System.Address); - pragma Import (C, fl_tabs_draw, "fl_tabs_draw"); - pragma Inline (fl_tabs_draw); - - function fl_tabs_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_tabs_handle, "fl_tabs_handle"); - pragma Inline (fl_tabs_handle); - - - - - procedure Finalize - (This : in out Tabbed_Group) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Tabbed_Group'Class - then - This.Clear; - free_fl_tabs (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Tabbed_Group is - begin - return This : Tabbed_Group do - This.Void_Ptr := new_fl_tabs - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - tabs_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - tabs_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Get_Client_Area - (This : in Tabbed_Group; - Tab_Height : in Natural; - X, Y, W, H : out Integer) is - begin - fl_tabs_client_area - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Tab_Height)); - end Get_Client_Area; - - - - - function Get_Push - (This : in Tabbed_Group) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_tabs_get_push (This.Void_Ptr); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Get_Push; - - - procedure Set_Push - (This : in out Tabbed_Group; - Item : in out Widget'Class) is - begin - fl_tabs_set_push (This.Void_Ptr, Item.Void_Ptr); - end Set_Push; - - - function Get_Visible - (This : in Tabbed_Group) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_tabs_get_value (This.Void_Ptr); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Get_Visible; - - - procedure Set_Visible - (This : in out Tabbed_Group; - Item : in out Widget'Class) is - begin - fl_tabs_set_value (This.Void_Ptr, Item.Void_Ptr); - end Set_Visible; - - - function Get_Which - (This : in Tabbed_Group; - Event_X, Event_Y : in Integer) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_tabs_which (This.Void_Ptr, Interfaces.C.int (Event_X), Interfaces.C.int (Event_Y)); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Get_Which; - - - - - procedure Draw - (This : in out Tabbed_Group) is - begin - fl_tabs_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Tabbed_Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_tabs_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Tabbed; - diff --git a/src/fltk-widgets-groups-tabbed.ads b/src/fltk-widgets-groups-tabbed.ads deleted file mode 100644 index 7c73283..0000000 --- a/src/fltk-widgets-groups-tabbed.ads +++ /dev/null @@ -1,93 +0,0 @@ - - -package FLTK.Widgets.Groups.Tabbed is - - - type Tabbed_Group is new Group with private; - - type Tabbed_Group_Reference (Data : not null access Tabbed_Group'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Tabbed_Group; - - end Forge; - - - - - procedure Get_Client_Area - (This : in Tabbed_Group; - Tab_Height : in Natural; - X, Y, W, H : out Integer); - - - - - function Get_Push - (This : in Tabbed_Group) - return access Widget'Class; - - procedure Set_Push - (This : in out Tabbed_Group; - Item : in out Widget'Class); - - function Get_Visible - (This : in Tabbed_Group) - return access Widget'Class; - - procedure Set_Visible - (This : in out Tabbed_Group; - Item : in out Widget'Class); - - function Get_Which - (This : in Tabbed_Group; - Event_X, Event_Y : in Integer) - return access Widget'Class; - - - - - procedure Draw - (This : in out Tabbed_Group); - - function Handle - (This : in out Tabbed_Group; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Tabbed_Group is new Group with null record; - - overriding procedure Finalize - (This : in out Tabbed_Group); - - - - - pragma Inline (Get_Client_Area); - - - pragma Inline (Get_Push); - pragma Inline (Set_Push); - pragma Inline (Get_Visible); - pragma Inline (Set_Visible); - pragma Inline (Get_Which); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Tabbed; - diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb deleted file mode 100644 index 17776c4..0000000 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ /dev/null @@ -1,997 +0,0 @@ - - -with - - FLTK.Event, - Interfaces.C, - System; - -use type - - Interfaces.C.unsigned_long, - System.Address; - - -package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - - - procedure text_editor_set_draw_hook - (W, D : in System.Address); - pragma Import (C, text_editor_set_draw_hook, "text_editor_set_draw_hook"); - pragma Inline (text_editor_set_draw_hook); - - procedure text_editor_set_handle_hook - (W, H : in System.Address); - pragma Import (C, text_editor_set_handle_hook, "text_editor_set_handle_hook"); - pragma Inline (text_editor_set_handle_hook); - - - - - function new_fl_text_editor - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); - pragma Inline (new_fl_text_editor); - - procedure free_fl_text_editor - (TE : in System.Address); - pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); - pragma Inline (free_fl_text_editor); - - - - - procedure fl_text_editor_default - (TE : in System.Address; - K : in Interfaces.C.int); - pragma Import (C, fl_text_editor_default, "fl_text_editor_default"); - pragma Inline (fl_text_editor_default); - - - - - procedure fl_text_editor_undo - (TE : in System.Address); - pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); - pragma Inline (fl_text_editor_undo); - - procedure fl_text_editor_cut - (TE : in System.Address); - pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); - pragma Inline (fl_text_editor_cut); - - procedure fl_text_editor_copy - (TE : in System.Address); - pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); - pragma Inline (fl_text_editor_copy); - - procedure fl_text_editor_paste - (TE : in System.Address); - pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); - pragma Inline (fl_text_editor_paste); - - procedure fl_text_editor_delete - (TE : in System.Address); - pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); - pragma Inline (fl_text_editor_delete); - - procedure fl_text_editor_select_all - (TE : in System.Address); - pragma Import (C, fl_text_editor_select_all, "fl_text_editor_select_all"); - pragma Inline (fl_text_editor_select_all); - - - - - procedure fl_text_editor_backspace - (TE : in System.Address); - pragma Import (C, fl_text_editor_backspace, "fl_text_editor_backspace"); - pragma Inline (fl_text_editor_backspace); - - procedure fl_text_editor_insert - (TE : in System.Address); - pragma Import (C, fl_text_editor_insert, "fl_text_editor_insert"); - pragma Inline (fl_text_editor_insert); - - procedure fl_text_editor_enter - (TE : in System.Address); - pragma Import (C, fl_text_editor_enter, "fl_text_editor_enter"); - pragma Inline (fl_text_editor_enter); - - procedure fl_text_editor_ignore - (TE : in System.Address); - pragma Import (C, fl_text_editor_ignore, "fl_text_editor_ignore"); - pragma Inline (fl_text_editor_ignore); - - - - - procedure fl_text_editor_home - (TE : in System.Address); - pragma Import (C, fl_text_editor_home, "fl_text_editor_home"); - pragma Inline (fl_text_editor_home); - - procedure fl_text_editor_end - (TE : in System.Address); - pragma Import (C, fl_text_editor_end, "fl_text_editor_end"); - pragma Inline (fl_text_editor_end); - - procedure fl_text_editor_page_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_page_down, "fl_text_editor_page_down"); - pragma Inline (fl_text_editor_page_down); - - procedure fl_text_editor_page_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_page_up, "fl_text_editor_page_up"); - pragma Inline (fl_text_editor_page_up); - - procedure fl_text_editor_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_down, "fl_text_editor_down"); - pragma Inline (fl_text_editor_down); - - procedure fl_text_editor_left - (TE : in System.Address); - pragma Import (C, fl_text_editor_left, "fl_text_editor_left"); - pragma Inline (fl_text_editor_left); - - procedure fl_text_editor_right - (TE : in System.Address); - pragma Import (C, fl_text_editor_right, "fl_text_editor_right"); - pragma Inline (fl_text_editor_right); - - procedure fl_text_editor_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_up, "fl_text_editor_up"); - pragma Inline (fl_text_editor_up); - - - - - procedure fl_text_editor_shift_home - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_home, "fl_text_editor_shift_home"); - pragma Inline (fl_text_editor_shift_home); - - procedure fl_text_editor_shift_end - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_end, "fl_text_editor_shift_end"); - pragma Inline (fl_text_editor_shift_end); - - procedure fl_text_editor_shift_page_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_page_down, "fl_text_editor_shift_page_down"); - pragma Inline (fl_text_editor_shift_page_down); - - procedure fl_text_editor_shift_page_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_page_up, "fl_text_editor_shift_page_up"); - pragma Inline (fl_text_editor_shift_page_up); - - procedure fl_text_editor_shift_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_down, "fl_text_editor_shift_down"); - pragma Inline (fl_text_editor_shift_down); - - procedure fl_text_editor_shift_left - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_left, "fl_text_editor_shift_left"); - pragma Inline (fl_text_editor_shift_left); - - procedure fl_text_editor_shift_right - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_right, "fl_text_editor_shift_right"); - pragma Inline (fl_text_editor_shift_right); - - procedure fl_text_editor_shift_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_shift_up, "fl_text_editor_shift_up"); - pragma Inline (fl_text_editor_shift_up); - - - - - procedure fl_text_editor_ctrl_home - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_home, "fl_text_editor_ctrl_home"); - pragma Inline (fl_text_editor_ctrl_home); - - procedure fl_text_editor_ctrl_end - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_end, "fl_text_editor_ctrl_end"); - pragma Inline (fl_text_editor_ctrl_end); - - procedure fl_text_editor_ctrl_page_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_page_down, "fl_text_editor_ctrl_page_down"); - pragma Inline (fl_text_editor_ctrl_page_down); - - procedure fl_text_editor_ctrl_page_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_page_up, "fl_text_editor_ctrl_page_up"); - pragma Inline (fl_text_editor_ctrl_page_up); - - procedure fl_text_editor_ctrl_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_down, "fl_text_editor_ctrl_down"); - pragma Inline (fl_text_editor_ctrl_down); - - procedure fl_text_editor_ctrl_left - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_left, "fl_text_editor_ctrl_left"); - pragma Inline (fl_text_editor_ctrl_left); - - procedure fl_text_editor_ctrl_right - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_right, "fl_text_editor_ctrl_right"); - pragma Inline (fl_text_editor_ctrl_right); - - procedure fl_text_editor_ctrl_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_up, "fl_text_editor_ctrl_up"); - pragma Inline (fl_text_editor_ctrl_up); - - - - - procedure fl_text_editor_ctrl_shift_home - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_home, "fl_text_editor_ctrl_shift_home"); - pragma Inline (fl_text_editor_ctrl_shift_home); - - procedure fl_text_editor_ctrl_shift_end - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_end, "fl_text_editor_ctrl_shift_end"); - pragma Inline (fl_text_editor_ctrl_shift_end); - - procedure fl_text_editor_ctrl_shift_page_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_page_down, "fl_text_editor_ctrl_shift_page_down"); - pragma Inline (fl_text_editor_ctrl_shift_page_down); - - procedure fl_text_editor_ctrl_shift_page_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_page_up, "fl_text_editor_ctrl_shift_page_up"); - pragma Inline (fl_text_editor_ctrl_shift_page_up); - - procedure fl_text_editor_ctrl_shift_down - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_down, "fl_text_editor_ctrl_shift_down"); - pragma Inline (fl_text_editor_ctrl_shift_down); - - procedure fl_text_editor_ctrl_shift_left - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_left, "fl_text_editor_ctrl_shift_left"); - pragma Inline (fl_text_editor_ctrl_shift_left); - - procedure fl_text_editor_ctrl_shift_right - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_right, "fl_text_editor_ctrl_shift_right"); - pragma Inline (fl_text_editor_ctrl_shift_right); - - procedure fl_text_editor_ctrl_shift_up - (TE : in System.Address); - pragma Import (C, fl_text_editor_ctrl_shift_up, "fl_text_editor_ctrl_shift_up"); - pragma Inline (fl_text_editor_ctrl_shift_up); - - - - - procedure fl_text_editor_add_key_binding - (TE : in System.Address; - K, S : in Interfaces.C.int; - F : in System.Address); - pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding"); - pragma Inline (fl_text_editor_add_key_binding); - - -- this particular procedure won't be necessary when FLTK keybindings fixed - procedure fl_text_editor_remove_key_binding - (TE : in System.Address; - K, S : in Interfaces.C.int); - pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); - pragma Inline (fl_text_editor_remove_key_binding); - - procedure fl_text_editor_remove_all_key_bindings - (TE : in System.Address); - pragma Import (C, fl_text_editor_remove_all_key_bindings, - "fl_text_editor_remove_all_key_bindings"); - pragma Inline (fl_text_editor_remove_all_key_bindings); - - procedure fl_text_editor_set_default_key_function - (TE, F : in System.Address); - pragma Import (C, fl_text_editor_set_default_key_function, - "fl_text_editor_set_default_key_function"); - pragma Inline (fl_text_editor_set_default_key_function); - - - - - function fl_text_editor_get_insert_mode - (TE : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_editor_get_insert_mode, "fl_text_editor_get_insert_mode"); - pragma Inline (fl_text_editor_get_insert_mode); - - procedure fl_text_editor_set_insert_mode - (TE : in System.Address; - I : in Interfaces.C.int); - pragma Import (C, fl_text_editor_set_insert_mode, "fl_text_editor_set_insert_mode"); - pragma Inline (fl_text_editor_set_insert_mode); - - - - - -- function fl_text_editor_get_tab_nav - -- (TE : in System.Address) - -- return Interfaces.C.int; - -- pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav"); - -- pragma Inline (fl_text_editor_get_tab_nav); - - -- procedure fl_text_editor_set_tab_nav - -- (TE : in System.Address; - -- T : in Interfaces.C.int); - -- pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav"); - -- pragma Inline (fl_text_editor_set_tab_nav); - - - - - procedure fl_text_editor_draw - (W : in System.Address); - pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw"); - pragma Inline (fl_text_editor_draw); - - function fl_text_editor_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle"); - pragma Inline (fl_text_editor_handle); - - - - - function Key_Func_Hook - (K : in Interfaces.C.int; - E : in System.Address) - return Interfaces.C.int - is - Ada_Editor : access Text_Editor'Class := - Editor_Convert.To_Pointer (fl_widget_get_user_data (E)); - Modi : Modifier := FLTK.Event.Last_Modifier; - Actual_Key : Keypress := FLTK.Event.Last_Key; -- fuck you FLTK, give me the real code - Ada_Key : Key_Combo := To_Ada (To_C (Actual_Key) + To_C (Modi)); - - Found_Binding : Boolean := False; - begin - for B of Ada_Editor.Bindings loop - if B.Key = Ada_Key then - B.Func (Ada_Editor.all); - Found_Binding := True; - end if; - end loop; - if not Found_Binding and then Ada_Editor.Default_Func /= null then - Ada_Editor.Default_Func (Ada_Editor.all, Ada_Key); - end if; - return 1; - end Key_Func_Hook; - - - - - procedure Finalize - (This : in out Text_Editor) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Text_Editor'Class - then - This.Clear; - free_fl_text_editor (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Text_Display (This)); - end Finalize; - - - - - -- remove this type and array once FLTK keybindings fixed - -- type To_Remove is record - -- Press : Keypress; - -- Modif : Interfaces.C.int; - -- end record; - - -- To_Remove_List : array (Positive range <>) of To_Remove := - -- ((Home_Key, 0), - -- (End_Key, 0), - -- (Page_Down_Key, 0), - -- (Page_Up_Key, 0), - -- (Down_Key, 0), - -- (Left_Key, 0), - -- (Right_Key, 0), - -- (Up_Key, 0), - -- (Character'Pos ('/'), Interfaces.C.int (Mod_Ctrl)), - -- (Delete_Key, Interfaces.C.int (Mod_Shift)), - -- (Insert_Key, Interfaces.C.int (Mod_Ctrl)), - -- (Insert_Key, Interfaces.C.int (Mod_Shift))); - - -- use type Interfaces.C.int; - -- To_Remove_Weird : array (Positive range <>) of To_Remove := - -- ((Enter_Key, -1), - -- (Keypad_Enter_Key, -1), - -- (Backspace_Key, -1), - -- (Insert_Key, -1), - -- (Delete_Key, -1), - -- (Escape_Key, -1)); - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Editor - is - use type Interfaces.C.int; - begin - return This : Text_Editor do - This.Void_Ptr := new_fl_text_editor - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - text_editor_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - text_editor_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - -- change things over so key bindings are all handled from the Ada side - This.Bindings := Binding_Vectors.Empty_Vector; - for B of Default_Key_Bindings loop - This.Bindings.Append (B); - end loop; - This.Default_Func := Default'Access; - - -- remove these loops and uncomment subsequent "remove_all_key_bindings" - -- when FLTK keybindings fixed - -- for B of To_Remove_List loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif * 65536); - -- end loop; - -- for B of To_Remove_Weird loop - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Press), - -- B.Modif); - -- end loop; - fl_text_editor_remove_all_key_bindings (This.Void_Ptr); - - fl_text_editor_set_default_key_function (This.Void_Ptr, Key_Func_Hook'Address); - - -- this is irritatingly required due to how FLTK handles certain keys - -- for B of Default_Key_Bindings loop - -- -- remove this conditional once FLTK keybindings fixed - -- if B.Key.Modcode = Mod_None then - -- fl_text_editor_add_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (B.Key.Keycode), - -- Interfaces.C.int (B.Key.Modcode) * 65536, - -- Key_Func_Hook'Address); - -- end if; - -- end loop; - end return; - end Create; - - end Forge; - - - - - procedure Default - (This : in out Text_Editor'Class; - Key : in Key_Combo) is - begin - fl_text_editor_default - (This.Void_Ptr, - Interfaces.C.int (Key.Keycode)); - end Default; - - - - - procedure Undo - (This : in out Text_Editor'Class) is - begin - fl_text_editor_undo (This.Void_Ptr); - end Undo; - - - procedure Cut - (This : in out Text_Editor'Class) is - begin - fl_text_editor_cut (This.Void_Ptr); - end Cut; - - - procedure Copy - (This : in out Text_Editor'Class) is - begin - fl_text_editor_copy (This.Void_Ptr); - end Copy; - - - procedure Paste - (This : in out Text_Editor'Class) is - begin - fl_text_editor_paste (This.Void_Ptr); - end Paste; - - - procedure Delete - (This : in out Text_Editor'Class) is - begin - fl_text_editor_delete (This.Void_Ptr); - end Delete; - - - procedure Select_All - (This : in out Text_Editor'Class) is - begin - fl_text_editor_select_all (This.Void_Ptr); - end Select_All; - - - - - procedure KF_Backspace - (This : in out Text_Editor'Class) is - begin - fl_text_editor_backspace (This.Void_Ptr); - end KF_Backspace; - - - procedure KF_Insert - (This : in out Text_Editor'Class) is - begin - fl_text_editor_insert (This.Void_Ptr); - end KF_Insert; - - - procedure KF_Enter - (This : in out Text_Editor'Class) is - begin - fl_text_editor_enter (This.Void_Ptr); - end KF_Enter; - - - procedure KF_Ignore - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ignore (This.Void_Ptr); - end KF_Ignore; - - - - - procedure KF_Home - (This : in out Text_Editor'Class) is - begin - fl_text_editor_home (This.Void_Ptr); - end KF_Home; - - - procedure KF_End - (This : in out Text_Editor'Class) is - begin - fl_text_editor_end (This.Void_Ptr); - end KF_End; - - - procedure KF_Page_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_page_down (This.Void_Ptr); - end KF_Page_Down; - - - procedure KF_Page_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_page_up (This.Void_Ptr); - end KF_Page_Up; - - - procedure KF_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_down (This.Void_Ptr); - end KF_Down; - - - procedure KF_Left - (This : in out Text_Editor'Class) is - begin - fl_text_editor_left (This.Void_Ptr); - end KF_Left; - - - procedure KF_Right - (This : in out Text_Editor'Class) is - begin - fl_text_editor_right (This.Void_Ptr); - end KF_Right; - - - procedure KF_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_up (This.Void_Ptr); - end KF_Up; - - - - - procedure KF_Shift_Home - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_home (This.Void_Ptr); - end KF_Shift_Home; - - - procedure KF_Shift_End - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_end (This.Void_Ptr); - end KF_Shift_End; - - - procedure KF_Shift_Page_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_page_down (This.Void_Ptr); - end KF_Shift_Page_Down; - - - procedure KF_Shift_Page_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_page_up (This.Void_Ptr); - end KF_Shift_Page_Up; - - - procedure KF_Shift_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_down (This.Void_Ptr); - end KF_Shift_Down; - - - procedure KF_Shift_Left - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_left (This.Void_Ptr); - end KF_Shift_Left; - - - procedure KF_Shift_Right - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_right (This.Void_Ptr); - end KF_Shift_Right; - - - procedure KF_Shift_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_shift_up (This.Void_Ptr); - end KF_Shift_Up; - - - - - procedure KF_Ctrl_Home - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_home (This.Void_Ptr); - end KF_Ctrl_Home; - - - procedure KF_Ctrl_End - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_end (This.Void_Ptr); - end KF_Ctrl_End; - - - procedure KF_Ctrl_Page_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_page_down (This.Void_Ptr); - end KF_Ctrl_Page_Down; - - - procedure KF_Ctrl_Page_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_page_up (This.Void_Ptr); - end KF_Ctrl_Page_Up; - - - procedure KF_Ctrl_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_down (This.Void_Ptr); - end KF_Ctrl_Down; - - - procedure KF_Ctrl_Left - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_left (This.Void_Ptr); - end KF_Ctrl_Left; - - - procedure KF_Ctrl_Right - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_right (This.Void_Ptr); - end KF_Ctrl_Right; - - - procedure KF_Ctrl_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_up (This.Void_Ptr); - end KF_Ctrl_Up; - - - - - procedure KF_Ctrl_Shift_Home - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_home (This.Void_Ptr); - end KF_Ctrl_Shift_Home; - - - procedure KF_Ctrl_Shift_End - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_end (This.Void_Ptr); - end KF_Ctrl_Shift_End; - - - procedure KF_Ctrl_Shift_Page_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_page_down (This.Void_Ptr); - end KF_Ctrl_Shift_Page_Down; - - - procedure KF_Ctrl_Shift_Page_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_page_up (This.Void_Ptr); - end KF_Ctrl_Shift_Page_Up; - - - procedure KF_Ctrl_Shift_Down - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_down (This.Void_Ptr); - end KF_Ctrl_Shift_Down; - - - procedure KF_Ctrl_Shift_Left - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_left (This.Void_Ptr); - end KF_Ctrl_Shift_Left; - - - procedure KF_Ctrl_Shift_Right - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_right (This.Void_Ptr); - end KF_Ctrl_Shift_Right; - - - procedure KF_Ctrl_Shift_Up - (This : in out Text_Editor'Class) is - begin - fl_text_editor_ctrl_shift_up (This.Void_Ptr); - end KF_Ctrl_Shift_Up; - - - - - procedure Add_Key_Binding - (This : in out Text_Editor; - Key : in Key_Combo; - Func : in Key_Func) is - begin - This.Bindings.Append ((Key, Func)); - end Add_Key_Binding; - - - procedure Add_Key_Binding - (This : in out Text_Editor; - Bind : in Key_Binding) is - begin - This.Bindings.Append (Bind); - end Add_Key_Binding; - - - procedure Add_Key_Bindings - (This : in out Text_Editor; - List : in Key_Binding_List) is - begin - for I of List loop - This.Bindings.Append (I); - end loop; - end Add_Key_Bindings; - - - function Get_Bound_Key_Function - (This : in Text_Editor; - Key : in Key_Combo) - return Key_Func is - begin - for I in 1 .. Integer (This.Bindings.Length) loop - if This.Bindings.Element (I).Key = Key then - return This.Bindings.Element (I).Func; - end if; - end loop; - return null; - end Get_Bound_Key_Function; - - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Key : in Key_Combo) - is - use type Interfaces.C.int; - begin - for I in reverse 1 .. Integer (This.Bindings.Length) loop - if This.Bindings.Reference (I).Key = Key then - This.Bindings.Delete (I); - end if; - end loop; - - -- remove this once FLTK keybindings fixed - -- if Key.Modcode /= Mod_None then - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (Key.Keycode), - -- Interfaces.C.int (Key.Modcode) * 65536); - -- end if; - end Remove_Key_Binding; - - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Bind : in Key_Binding) - is - -- use type Interfaces.C.int; - begin - for I in reverse 1 .. Integer (This.Bindings.Length) loop - if This.Bindings.Reference (I).Key = Bind.Key then - This.Bindings.Delete (I); - end if; - end loop; - - -- remove this once FLTK keybindings fixed - -- if Bind.Key.Modcode /= Mod_None then - -- fl_text_editor_remove_key_binding - -- (This.Void_Ptr, - -- Interfaces.C.int (Bind.Key.Keycode), - -- Interfaces.C.int (Bind.Key.Modcode) * 65536); - -- end if; - end Remove_Key_Binding; - - - procedure Remove_Key_Bindings - (This : in out Text_Editor; - List : in Key_Binding_List) is - begin - for I of List loop - This.Remove_Key_Binding (I); - end loop; - end Remove_Key_Bindings; - - - procedure Remove_All_Key_Bindings - (This : in out Text_Editor) is - begin - This.Bindings := Binding_Vectors.Empty_Vector; - -- This.Default_Func := null; - - -- remove this once FLTK keybindings fixed - -- fl_text_editor_remove_all_key_bindings (This.Void_Ptr); - end Remove_All_Key_Bindings; - - - function Get_Default_Key_Function - (This : in Text_Editor) - return Default_Key_Func is - begin - return This.Default_Func; - end Get_Default_Key_Function; - - - procedure Set_Default_Key_Function - (This : in out Text_Editor; - Func : in Default_Key_Func) is - begin - This.Default_Func := Func; - end Set_Default_Key_Function; - - - - - function Get_Insert_Mode - (This : in Text_Editor) - return Insert_Mode is - begin - return Insert_Mode'Val (fl_text_editor_get_insert_mode (This.Void_Ptr)); - end Get_Insert_Mode; - - - procedure Set_Insert_Mode - (This : in out Text_Editor; - To : in Insert_Mode) is - begin - fl_text_editor_set_insert_mode (This.Void_Ptr, Insert_Mode'Pos (To)); - end Set_Insert_Mode; - - - - - -- function Get_Tab_Nav_Mode - -- (This : in Text_Editor) - -- return Tab_Navigation is - -- begin - -- return Tab_Navigation'Val (fl_text_editor_get_tab_nav (This.Void_Ptr)); - -- end Get_Tab_Nav_Mode; - - - -- procedure Set_Tab_Nav_Mode - -- (This : in out Text_Editor; - -- To : in Tab_Navigation) is - -- begin - -- fl_text_editor_set_tab_nav (This.Void_Ptr, Tab_Navigation'Pos (To)); - -- end Set_Tab_Nav_Mode; - - - - - procedure Draw - (This : in out Text_Editor) is - begin - fl_text_editor_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Text_Editor; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_text_editor_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Text_Displays.Text_Editors; - diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads deleted file mode 100644 index 3d1bdbe..0000000 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ /dev/null @@ -1,439 +0,0 @@ - - -private with - - Interfaces.C, - Ada.Containers.Vectors; - - -package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - - - type Text_Editor is new Text_Display with private; - - type Text_Editor_Reference (Data : not null access Text_Editor'Class) is - limited null record with Implicit_Dereference => Data; - - type Insert_Mode is (Before, After); - - -- type Tab_Navigation is (Insert_Char, Widget_Focus); - - type Key_Func is access procedure - (This : in out Text_Editor'Class); - - type Default_Key_Func is access procedure - (This : in out Text_Editor'Class; - Key : in Key_Combo); - - type Key_Binding is record - Key : Key_Combo; - Func : Key_Func; - end record; - - type Key_Binding_List is array (Positive range <>) of Key_Binding; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Editor; - - end Forge; - - - - - procedure Default - (This : in out Text_Editor'Class; - Key : in Key_Combo); - - - - - procedure Undo - (This : in out Text_Editor'Class); - - procedure Cut - (This : in out Text_Editor'Class); - - procedure Copy - (This : in out Text_Editor'Class); - - procedure Paste - (This : in out Text_Editor'Class); - - procedure Delete - (This : in out Text_Editor'Class); - - procedure Select_All - (This : in out Text_Editor'Class); - - - - - procedure KF_Backspace - (This : in out Text_Editor'Class); - - procedure KF_Insert - (This : in out Text_Editor'Class); - - procedure KF_Enter - (This : in out Text_Editor'Class); - - procedure KF_Ignore - (This : in out Text_Editor'Class); - - - - - procedure KF_Home - (This : in out Text_Editor'Class); - - procedure KF_End - (This : in out Text_Editor'Class); - - procedure KF_Page_Down - (This : in out Text_Editor'Class); - - procedure KF_Page_Up - (This : in out Text_Editor'Class); - - procedure KF_Down - (This : in out Text_Editor'Class); - - procedure KF_Left - (This : in out Text_Editor'Class); - - procedure KF_Right - (This : in out Text_Editor'Class); - - procedure KF_Up - (This : in out Text_Editor'Class); - - - - - procedure KF_Shift_Home - (This : in out Text_Editor'Class); - - procedure KF_Shift_End - (This : in out Text_Editor'Class); - - procedure KF_Shift_Page_Down - (This : in out Text_Editor'Class); - - procedure KF_Shift_Page_Up - (This : in out Text_Editor'Class); - - procedure KF_Shift_Down - (This : in out Text_Editor'Class); - - procedure KF_Shift_Left - (This : in out Text_Editor'Class); - - procedure KF_Shift_Right - (This : in out Text_Editor'Class); - - procedure KF_Shift_Up - (This : in out Text_Editor'Class); - - - - - procedure KF_Ctrl_Home - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_End - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Page_Down - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Page_Up - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Down - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Left - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Right - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Up - (This : in out Text_Editor'Class); - - - - - procedure KF_Ctrl_Shift_Home - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_End - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Page_Down - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Page_Up - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Down - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Left - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Right - (This : in out Text_Editor'Class); - - procedure KF_Ctrl_Shift_Up - (This : in out Text_Editor'Class); - - - - - Default_Key_Bindings : constant Key_Binding_List := - ((Mod_None + Enter_Key, KF_Enter'Access), - (Mod_None + Keypad_Enter_Key, KF_Enter'Access), - (Mod_None + Backspace_Key, KF_Backspace'Access), - (Mod_None + Insert_Key, KF_Insert'Access), - - (Mod_None + Delete_Key, Delete'Access), - (Mod_Ctrl + 'c', Copy'Access), - (Mod_Ctrl + 'v', Paste'Access), - (Mod_Ctrl + 'x', Cut'Access), - (Mod_Ctrl + 'z', Undo'Access), - (Mod_Ctrl + 'a', Select_All'Access), - - (Mod_None + Home_Key, KF_Home'Access), - (Mod_None + End_Key, KF_End'Access), - (Mod_None + Page_Down_Key, KF_Page_Down'Access), - (Mod_None + Page_Up_Key, KF_Page_Up'Access), - (Mod_None + Down_Key, KF_Down'Access), - (Mod_None + Left_Key, KF_Left'Access), - (Mod_None + Right_Key, KF_Right'Access), - (Mod_None + Up_Key, KF_Up'Access), - - (Mod_Shift + Home_Key, KF_Shift_Home'Access), - (Mod_Shift + End_Key, KF_Shift_End'Access), - (Mod_Shift + Page_Down_Key, KF_Shift_Page_Down'Access), - (Mod_Shift + Page_Up_Key, KF_Shift_Page_Up'Access), - (Mod_Shift + Down_Key, KF_Shift_Down'Access), - (Mod_Shift + Left_Key, KF_Shift_Left'Access), - (Mod_Shift + Right_Key, KF_Shift_Right'Access), - (Mod_Shift + Up_Key, KF_Shift_Up'Access), - - (Mod_Ctrl + Home_Key, KF_Ctrl_Home'Access), - (Mod_Ctrl + End_Key, KF_Ctrl_End'Access), - (Mod_Ctrl + Page_Down_Key, KF_Ctrl_Page_Down'Access), - (Mod_Ctrl + Page_Up_Key, KF_Ctrl_Page_Up'Access), - (Mod_Ctrl + Down_Key, KF_Ctrl_Down'Access), - (Mod_Ctrl + Left_Key, KF_Ctrl_Left'Access), - (Mod_Ctrl + Right_Key, KF_Ctrl_Right'Access), - (Mod_Ctrl + Up_Key, KF_Ctrl_Up'Access), - - (Mod_Ctrl + Mod_Shift + Home_Key, KF_Ctrl_Shift_Home'Access), - (Mod_Ctrl + Mod_Shift + End_Key, KF_Ctrl_Shift_End'Access), - (Mod_Ctrl + Mod_Shift + Page_Down_Key, KF_Ctrl_Shift_Page_Down'Access), - (Mod_Ctrl + Mod_Shift + Page_Up_Key, KF_Ctrl_Shift_Page_Up'Access), - (Mod_Ctrl + Mod_Shift + Down_Key, KF_Ctrl_Shift_Down'Access), - (Mod_Ctrl + Mod_Shift + Left_Key, KF_Ctrl_Shift_Left'Access), - (Mod_Ctrl + Mod_Shift + Right_Key, KF_Ctrl_Shift_Right'Access), - (Mod_Ctrl + Mod_Shift + Up_Key, KF_Ctrl_Shift_Up'Access)); - - - - - procedure Add_Key_Binding - (This : in out Text_Editor; - Key : in Key_Combo; - Func : in Key_Func); - - procedure Add_Key_Binding - (This : in out Text_Editor; - Bind : in Key_Binding); - - procedure Add_Key_Bindings - (This : in out Text_Editor; - List : in Key_Binding_List); - - function Get_Bound_Key_Function - (This : in Text_Editor; - Key : in Key_Combo) - return Key_Func; - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Key : in Key_Combo); - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Bind : in Key_Binding); - - procedure Remove_Key_Bindings - (This : in out Text_Editor; - List : in Key_Binding_List); - - procedure Remove_All_Key_Bindings - (This : in out Text_Editor); - - function Get_Default_Key_Function - (This : in Text_Editor) - return Default_Key_Func; - - procedure Set_Default_Key_Function - (This : in out Text_Editor; - Func : in Default_Key_Func); - - - - - function Get_Insert_Mode - (This : in Text_Editor) - return Insert_Mode; - - procedure Set_Insert_Mode - (This : in out Text_Editor; - To : in Insert_Mode); - - - - - -- function Get_Tab_Nav_Mode - -- (This : in Text_Editor) - -- return Tab_Navigation; - - -- procedure Set_Tab_Nav_Mode - -- (This : in out Text_Editor; - -- To : in Tab_Navigation); - - - - - procedure Draw - (This : in out Text_Editor); - - function Handle - (This : in out Text_Editor; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - package Binding_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, Element_Type => Key_Binding); - - - - - type Text_Editor is new Text_Display with - record - Bindings : Binding_Vectors.Vector; - Default_Func : Default_Key_Func; - end record; - - overriding procedure Finalize - (This : in out Text_Editor); - - - - - function Key_Func_Hook - (K : in Interfaces.C.int; - E : in System.Address) - return Interfaces.C.int; - pragma Convention (C, Key_Func_Hook); - - - - - package Editor_Convert is new System.Address_To_Access_Conversions (Text_Editor'Class); - - - - - pragma Inline (Default); - - - pragma Inline (Undo); - pragma Inline (Cut); - pragma Inline (Copy); - pragma Inline (Paste); - pragma Inline (Delete); - pragma Inline (Select_All); - - - pragma Inline (KF_Backspace); - pragma Inline (KF_Insert); - pragma Inline (KF_Enter); - pragma Inline (KF_Ignore); - - - pragma Inline (KF_Home); - pragma Inline (KF_End); - pragma Inline (KF_Page_Down); - pragma Inline (KF_Page_Up); - pragma Inline (KF_Down); - pragma Inline (KF_Left); - pragma Inline (KF_Right); - pragma Inline (KF_Up); - - - pragma Inline (KF_Shift_Home); - pragma Inline (KF_Shift_End); - pragma Inline (KF_Shift_Page_Down); - pragma Inline (KF_Shift_Page_Up); - pragma Inline (KF_Shift_Down); - pragma Inline (KF_Shift_Left); - pragma Inline (KF_Shift_Right); - pragma Inline (KF_Shift_Up); - - - pragma Inline (KF_Ctrl_Home); - pragma Inline (KF_Ctrl_End); - pragma Inline (KF_Ctrl_Page_Down); - pragma Inline (KF_Ctrl_Page_Up); - pragma Inline (KF_Ctrl_Down); - pragma Inline (KF_Ctrl_Left); - pragma Inline (KF_Ctrl_Right); - pragma Inline (KF_Ctrl_Up); - - - pragma Inline (KF_Ctrl_Shift_Home); - pragma Inline (KF_Ctrl_Shift_End); - pragma Inline (KF_Ctrl_Shift_Page_Down); - pragma Inline (KF_Ctrl_Shift_Page_Up); - pragma Inline (KF_Ctrl_Shift_Down); - pragma Inline (KF_Ctrl_Shift_Left); - pragma Inline (KF_Ctrl_Shift_Right); - pragma Inline (KF_Ctrl_Shift_Up); - - - pragma Inline (Add_Key_Binding); - pragma Inline (Remove_All_Key_Bindings); - pragma Inline (Get_Default_Key_Function); - pragma Inline (Set_Default_Key_Function); - - - pragma Inline (Get_Insert_Mode); - pragma Inline (Set_Insert_Mode); - - - -- pragma Inline (Get_Tab_Nav_Mode); - -- pragma Inline (Set_Tab_Nav_Mode); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Text_Displays.Text_Editors; - diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb deleted file mode 100644 index cd76007..0000000 --- a/src/fltk-widgets-groups-text_displays.adb +++ /dev/null @@ -1,1104 +0,0 @@ - - -with - - Interfaces.C, - System, - FLTK.Text_Buffers; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Groups.Text_Displays is - - - procedure text_display_set_draw_hook - (W, D : in System.Address); - pragma Import (C, text_display_set_draw_hook, "text_display_set_draw_hook"); - pragma Inline (text_display_set_draw_hook); - - procedure text_display_set_handle_hook - (W, H : in System.Address); - pragma Import (C, text_display_set_handle_hook, "text_display_set_handle_hook"); - pragma Inline (text_display_set_handle_hook); - - - - - function new_fl_text_display - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_text_display, "new_fl_text_display"); - pragma Inline (new_fl_text_display); - - procedure free_fl_text_display - (TD : in System.Address); - pragma Import (C, free_fl_text_display, "free_fl_text_display"); - pragma Inline (free_fl_text_display); - - - - - function fl_text_display_get_buffer - (TD : in System.Address) - return System.Address; - pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); - pragma Inline (fl_text_display_get_buffer); - - procedure fl_text_display_set_buffer - (TD, TB : in System.Address); - pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); - pragma Inline (fl_text_display_set_buffer); - - - - - procedure fl_text_display_highlight_data - (TD, TB, ST : in System.Address; - L : in Interfaces.C.int); - pragma Import (C, fl_text_display_highlight_data, "fl_text_display_highlight_data"); - pragma Inline (fl_text_display_highlight_data); - - procedure fl_text_display_highlight_data2 - (TD, TB, ST : in System.Address; - L : in Interfaces.C.int; - C : in Interfaces.C.unsigned; - B, A : in System.Address); - pragma Import (C, fl_text_display_highlight_data2, "fl_text_display_highlight_data2"); - pragma Inline (fl_text_display_highlight_data2); - - - - - function fl_text_display_col_to_x - (TD : in System.Address; - C : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_text_display_col_to_x, "fl_text_display_col_to_x"); - pragma Inline (fl_text_display_col_to_x); - - function fl_text_display_x_to_col - (TD : in System.Address; - X : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_text_display_x_to_col, "fl_text_display_x_to_col"); - pragma Inline (fl_text_display_x_to_col); - - function fl_text_display_in_selection - (TD : in System.Address; - X, Y : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_in_selection, "fl_text_display_in_selection"); - pragma Inline (fl_text_display_in_selection); - - function fl_text_display_position_to_xy - (TD : in System.Address; - P : in Interfaces.C.int; - X, Y : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_position_to_xy, "fl_text_display_position_to_xy"); - pragma Inline (fl_text_display_position_to_xy); - - - - - function fl_text_display_get_cursor_color - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_cursor_color, "fl_text_display_get_cursor_color"); - pragma Inline (fl_text_display_get_cursor_color); - - procedure fl_text_display_set_cursor_color - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_cursor_color, "fl_text_display_set_cursor_color"); - pragma Inline (fl_text_display_set_cursor_color); - - procedure fl_text_display_set_cursor_style - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_cursor_style, "fl_text_display_set_cursor_style"); - pragma Inline (fl_text_display_set_cursor_style); - - procedure fl_text_display_hide_cursor - (TD : in System.Address); - pragma Import (C, fl_text_display_hide_cursor, "fl_text_display_hide_cursor"); - pragma Inline (fl_text_display_hide_cursor); - - procedure fl_text_display_show_cursor - (TD : in System.Address); - pragma Import (C, fl_text_display_show_cursor, "fl_text_display_show_cursor"); - pragma Inline (fl_text_display_show_cursor); - - - - - function fl_text_display_get_text_color - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); - pragma Inline (fl_text_display_get_text_color); - - procedure fl_text_display_set_text_color - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); - pragma Inline (fl_text_display_set_text_color); - - function fl_text_display_get_text_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); - pragma Inline (fl_text_display_get_text_font); - - procedure fl_text_display_set_text_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); - pragma Inline (fl_text_display_set_text_font); - - function fl_text_display_get_text_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); - pragma Inline (fl_text_display_get_text_size); - - procedure fl_text_display_set_text_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); - pragma Inline (fl_text_display_set_text_size); - - - - - procedure fl_text_display_insert - (TD : in System.Address; - I : in Interfaces.C.char_array); - pragma Import (C, fl_text_display_insert, "fl_text_display_insert"); - pragma Inline (fl_text_display_insert); - - procedure fl_text_display_overstrike - (TD : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_text_display_overstrike, "fl_text_display_overstrike"); - pragma Inline (fl_text_display_overstrike); - - function fl_text_display_get_insert_pos - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); - pragma Inline (fl_text_display_get_insert_pos); - - procedure fl_text_display_set_insert_pos - (TD : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); - pragma Inline (fl_text_display_set_insert_pos); - - procedure fl_text_display_show_insert_pos - (TD : in System.Address); - pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); - pragma Inline (fl_text_display_show_insert_pos); - - - - - function fl_text_display_word_start - (TD : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_word_start, "fl_text_display_word_start"); - pragma Inline (fl_text_display_word_start); - - function fl_text_display_word_end - (TD : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_word_end, "fl_text_display_word_end"); - pragma Inline (fl_text_display_word_end); - - procedure fl_text_display_next_word - (TD : in System.Address); - pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); - pragma Inline (fl_text_display_next_word); - - procedure fl_text_display_previous_word - (TD : in System.Address); - pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); - pragma Inline (fl_text_display_previous_word); - - procedure fl_text_display_wrap_mode - (TD : in System.Address; - W, M : in Interfaces.C.int); - pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); - pragma Inline (fl_text_display_wrap_mode); - - - - - function fl_text_display_line_start - (TD : in System.Address; - S : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_line_start, "fl_text_display_line_start"); - pragma Inline (fl_text_display_line_start); - - function fl_text_display_line_end - (TD : in System.Address; - S, P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_line_end, "fl_text_display_line_end"); - pragma Inline (fl_text_display_line_end); - - function fl_text_display_count_lines - (TD : in System.Address; - S, F, P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_count_lines, "fl_text_display_count_lines"); - pragma Inline (fl_text_display_count_lines); - - function fl_text_display_skip_lines - (TD : in System.Address; - S, L, P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_skip_lines, "fl_text_display_skip_lines"); - pragma Inline (fl_text_display_skip_lines); - - function fl_text_display_rewind_lines - (TD : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); - pragma Inline (fl_text_display_rewind_lines); - - - - - function fl_text_display_get_linenumber_align - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_linenumber_align, - "fl_text_display_get_linenumber_align"); - pragma Inline (fl_text_display_get_linenumber_align); - - procedure fl_text_display_set_linenumber_align - (TD : in System.Address; - A : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_linenumber_align, - "fl_text_display_set_linenumber_align"); - pragma Inline (fl_text_display_set_linenumber_align); - - function fl_text_display_get_linenumber_bgcolor - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_linenumber_bgcolor, - "fl_text_display_get_linenumber_bgcolor"); - pragma Inline (fl_text_display_get_linenumber_bgcolor); - - procedure fl_text_display_set_linenumber_bgcolor - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_linenumber_bgcolor, - "fl_text_display_set_linenumber_bgcolor"); - pragma Inline (fl_text_display_set_linenumber_bgcolor); - - function fl_text_display_get_linenumber_fgcolor - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_linenumber_fgcolor, - "fl_text_display_get_linenumber_fgcolor"); - pragma Inline (fl_text_display_get_linenumber_fgcolor); - - procedure fl_text_display_set_linenumber_fgcolor - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_linenumber_fgcolor, - "fl_text_display_set_linenumber_fgcolor"); - pragma Inline (fl_text_display_set_linenumber_fgcolor); - - function fl_text_display_get_linenumber_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_linenumber_font, - "fl_text_display_get_linenumber_font"); - pragma Inline (fl_text_display_get_linenumber_font); - - procedure fl_text_display_set_linenumber_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_linenumber_font, - "fl_text_display_set_linenumber_font"); - pragma Inline (fl_text_display_set_linenumber_font); - - function fl_text_display_get_linenumber_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_linenumber_size, - "fl_text_display_get_linenumber_size"); - pragma Inline (fl_text_display_get_linenumber_size); - - procedure fl_text_display_set_linenumber_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_linenumber_size, - "fl_text_display_set_linenumber_size"); - pragma Inline (fl_text_display_set_linenumber_size); - - function fl_text_display_get_linenumber_width - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_linenumber_width, - "fl_text_display_get_linenumber_width"); - pragma Inline (fl_text_display_get_linenumber_width); - - procedure fl_text_display_set_linenumber_width - (TD : in System.Address; - W : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_linenumber_width, - "fl_text_display_set_linenumber_width"); - pragma Inline (fl_text_display_set_linenumber_width); - - - - - function fl_text_display_move_down - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_move_down, "fl_text_display_move_down"); - pragma Inline (fl_text_display_move_down); - - function fl_text_display_move_left - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_move_left, "fl_text_display_move_left"); - pragma Inline (fl_text_display_move_left); - - function fl_text_display_move_right - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_move_right, "fl_text_display_move_right"); - pragma Inline (fl_text_display_move_right); - - function fl_text_display_move_up - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_move_up, "fl_text_display_move_up"); - pragma Inline (fl_text_display_move_up); - - - - - procedure fl_text_display_scroll - (TD : in System.Address; - L : in Interfaces.C.int); - pragma Import (C, fl_text_display_scroll, "fl_text_display_scroll"); - pragma Inline (fl_text_display_scroll); - - function fl_text_display_get_scrollbar_align - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_display_get_scrollbar_align, "fl_text_display_get_scrollbar_align"); - pragma Inline (fl_text_display_get_scrollbar_align); - - procedure fl_text_display_set_scrollbar_align - (TD : in System.Address; - A : in Interfaces.C.unsigned); - pragma Import (C, fl_text_display_set_scrollbar_align, "fl_text_display_set_scrollbar_align"); - pragma Inline (fl_text_display_set_scrollbar_align); - - function fl_text_display_get_scrollbar_width - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_scrollbar_width, "fl_text_display_get_scrollbar_width"); - pragma Inline (fl_text_display_get_scrollbar_width); - - procedure fl_text_display_set_scrollbar_width - (TD : in System.Address; - W : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_scrollbar_width, "fl_text_display_set_scrollbar_width"); - pragma Inline (fl_text_display_set_scrollbar_width); - - - - - procedure fl_text_display_redisplay_range - (TD : in System.Address; - S, F : in Interfaces.C.int); - pragma Import (C, fl_text_display_redisplay_range, "fl_text_display_redisplay_range"); - pragma Inline (fl_text_display_redisplay_range); - - procedure fl_text_display_draw - (W : in System.Address); - pragma Import (C, fl_text_display_draw, "fl_text_display_draw"); - pragma Inline (fl_text_display_draw); - - function fl_text_display_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_handle, "fl_text_display_handle"); - pragma Inline (fl_text_display_handle); - - - - - procedure Style_Hook - (C : in Interfaces.C.int; - D : in System.Address) - is - use Styles; -- for maximum stylin' - - Ada_Widget : access Text_Display'Class := - Text_Display_Convert.To_Pointer (D); - begin - if Ada_Widget.Style_Callback /= null then - Ada_Widget.Style_Callback (Character'Val (C), Text_Display (Ada_Widget.all)); - end if; - end Style_Hook; - - - - - procedure Finalize - (This : in out Text_Display) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Text_Display'Class - then - This.Clear; - free_fl_text_display (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Display is - begin - return This : Text_Display do - This.Void_Ptr := new_fl_text_display - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - text_display_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - text_display_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - package body Styles is - - function Item - (Tint : in Color; - Font : in Font_Kind; - Size : in Font_Size) - return Style_Entry is - begin - return This : Style_Entry do - This.Attr := 0; - This.Col := Interfaces.C.unsigned (Tint); - This.Font := Font_Kind'Pos (Font); - This.Size := Interfaces.C.int (Size); - end return; - end Item; - - pragma Inline (Item); - - end Styles; - - - - - function Get_Buffer - (This : in Text_Display) - return FLTK.Text_Buffers.Text_Buffer_Reference is - begin - return Ref : FLTK.Text_Buffers.Text_Buffer_Reference (This.Buffer); - end Get_Buffer; - - - procedure Set_Buffer - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer) is - begin - This.Buffer := Buff'Unchecked_Access; - fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr); - end Set_Buffer; - - - - - procedure Highlight_Data - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer; - Table : in Styles.Style_Array) is - begin - fl_text_display_highlight_data - (This.Void_Ptr, - Wrapper (Buff).Void_Ptr, - Table'Address, - Table'Length); - end Highlight_Data; - - - procedure Highlight_Data - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer; - Table : in Styles.Style_Array; - Unfinished : in Styles.Style_Index; - Callback : in Styles.Unfinished_Style_Callback) is - begin - This.Style_Callback := Callback; - fl_text_display_highlight_data2 - (This.Void_Ptr, - Wrapper (Buff).Void_Ptr, - Table'Address, - Table'Length, - Character'Pos (Character (Unfinished)), - Style_Hook'Address, - This'Address); - end Highlight_Data; - - - - - function Col_To_X - (This : in Text_Display; - Col_Num : in Integer) - return Integer is - begin - return Integer (Interfaces.C.double'Rounding - (fl_text_display_col_to_x (This.Void_Ptr, Interfaces.C.double (Col_Num)))); - end Col_To_X; - - - function X_To_Col - (This : in Text_Display; - X_Pos : in Integer) - return Integer is - begin - return Integer (Interfaces.C.double'Rounding - (fl_text_display_x_to_col (This.Void_Ptr, Interfaces.C.double (X_Pos)))); - end X_To_Col; - - - function In_Selection - (This : in Text_Display; - X, Y : in Integer) - return Boolean is - begin - return fl_text_display_in_selection - (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)) /= 0; - end In_Selection; - - - procedure Position_To_XY - (This : in Text_Display; - Pos : in Integer; - X, Y : out Integer; - Vert_Out : out Boolean) is - begin - Vert_Out := fl_text_display_position_to_xy - (This.Void_Ptr, - Interfaces.C.int (Pos), - Interfaces.C.int (X), - Interfaces.C.int (Y)) /= 0; - end Position_To_XY; - - - - - function Get_Cursor_Color - (This : in Text_Display) - return Color is - begin - return Color (fl_text_display_get_cursor_color (This.Void_Ptr)); - end Get_Cursor_Color; - - - procedure Set_Cursor_Color - (This : in out Text_Display; - Col : in Color) is - begin - fl_text_display_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); - end Set_Cursor_Color; - - - procedure Set_Cursor_Style - (This : in out Text_Display; - Style : in Cursor_Style) is - begin - fl_text_display_set_cursor_style (This.Void_Ptr, Cursor_Style'Pos (Style)); - end Set_Cursor_Style; - - - procedure Hide_Cursor - (This : in out Text_Display) is - begin - fl_text_display_hide_cursor (This.Void_Ptr); - end Hide_Cursor; - - - procedure Show_Cursor - (This : in out Text_Display) is - begin - fl_text_display_show_cursor (This.Void_Ptr); - end Show_Cursor; - - - - - function Get_Text_Color - (This : in Text_Display) - return Color is - begin - return Color (fl_text_display_get_text_color (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Text_Display; - Col : in Color) is - begin - fl_text_display_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Text_Display) - return Font_Kind is - begin - return Font_Kind'Val (fl_text_display_get_text_font (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Text_Display; - Font : in Font_Kind) is - begin - fl_text_display_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Text_Display) - return Font_Size is - begin - return Font_Size (fl_text_display_get_text_size (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Text_Display; - Size : in Font_Size) is - begin - fl_text_display_set_text_size (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - procedure Insert_Text - (This : in out Text_Display; - Item : in String) is - begin - fl_text_display_insert (This.Void_Ptr, Interfaces.C.To_C (Item)); - end Insert_Text; - - - procedure Overstrike - (This : in out Text_Display; - Text : in String) is - begin - fl_text_display_overstrike (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Overstrike; - - - function Get_Insert_Position - (This : in Text_Display) - return Natural is - begin - return Natural (fl_text_display_get_insert_pos (This.Void_Ptr)); - end Get_Insert_Position; - - - procedure Set_Insert_Position - (This : in out Text_Display; - Pos : in Natural) is - begin - fl_text_display_set_insert_pos (This.Void_Ptr, Interfaces.C.int (Pos)); - end Set_Insert_Position; - - - procedure Show_Insert_Position - (This : in out Text_Display) is - begin - fl_text_display_show_insert_pos (This.Void_Ptr); - end Show_Insert_Position; - - - - - function Word_Start - (This : in out Text_Display; - Pos : in Natural) - return Natural is - begin - return Natural (fl_text_display_word_start - (This.Void_Ptr, - Interfaces.C.int (Pos))); - end Word_Start; - - - function Word_End - (This : in out Text_Display; - Pos : in Natural) - return Natural is - begin - return Natural (fl_text_display_word_end - (This.Void_Ptr, - Interfaces.C.int (Pos))); - end Word_End; - - - procedure Next_Word - (This : in out Text_Display) is - begin - fl_text_display_next_word (This.Void_Ptr); - end Next_Word; - - - procedure Previous_Word - (This : in out Text_Display) is - begin - fl_text_display_previous_word (This.Void_Ptr); - end Previous_Word; - - - procedure Set_Wrap_Mode - (This : in out Text_Display; - Mode : in Wrap_Mode; - Margin : in Natural := 0) is - begin - fl_text_display_wrap_mode - (This.Void_Ptr, - Wrap_Mode'Pos (Mode), - Interfaces.C.int (Margin)); - end Set_Wrap_Mode; - - - - - function Line_Start - (This : in Text_Display; - Pos : in Natural) - return Natural is - begin - return Natural (fl_text_display_line_start - (This.Void_Ptr, - Interfaces.C.int (Pos))); - end Line_Start; - - - function Line_End - (This : in Text_Display; - Pos : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural is - begin - return Natural (fl_text_display_line_end - (This.Void_Ptr, - Interfaces.C.int (Pos), - Boolean'Pos (Start_Pos_Is_Line_Start))); - end Line_End; - - - function Count_Lines - (This : in Text_Display; - Start, Finish : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural is - begin - return Natural (fl_text_display_count_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish), - Boolean'Pos (Start_Pos_Is_Line_Start))); - end Count_Lines; - - - function Skip_Lines - (This : in Text_Display; - Start, Lines : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural is - begin - return Natural (fl_text_display_skip_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines), - Boolean'Pos (Start_Pos_Is_Line_Start))); - end Skip_Lines; - - - function Rewind_Lines - (This : in Text_Display; - Start, Lines : in Natural) - return Natural is - begin - return Natural (fl_text_display_rewind_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); - end Rewind_Lines; - - - - - function Get_Linenumber_Alignment - (This : in Text_Display) - return Alignment is - begin - return Alignment (fl_text_display_get_linenumber_align (This.Void_Ptr)); - end Get_Linenumber_Alignment; - - - procedure Set_Linenumber_Alignment - (This : in out Text_Display; - To : in Alignment) is - begin - fl_text_display_set_linenumber_align - (This.Void_Ptr, - Interfaces.C.unsigned (To)); - end Set_Linenumber_Alignment; - - - function Get_Linenumber_Back_Color - (This : in Text_Display) - return Color is - begin - return Color (fl_text_display_get_linenumber_bgcolor (This.Void_Ptr)); - end Get_Linenumber_Back_Color; - - - procedure Set_Linenumber_Back_Color - (This : in out Text_Display; - To : in Color) is - begin - fl_text_display_set_linenumber_bgcolor - (This.Void_Ptr, - Interfaces.C.unsigned (To)); - end Set_Linenumber_Back_Color; - - - function Get_Linenumber_Fore_Color - (This : in Text_Display) - return Color is - begin - return Color (fl_text_display_get_linenumber_fgcolor (This.Void_Ptr)); - end Get_Linenumber_Fore_Color; - - - procedure Set_Linenumber_Fore_Color - (This : in out Text_Display; - To : in Color) is - begin - fl_text_display_set_linenumber_fgcolor - (This.Void_Ptr, - Interfaces.C.unsigned (To)); - end Set_Linenumber_Fore_Color; - - - function Get_Linenumber_Font - (This : in Text_Display) - return Font_Kind is - begin - return Font_Kind'Val (fl_text_display_get_linenumber_font (This.Void_Ptr)); - end Get_Linenumber_Font; - - - procedure Set_Linenumber_Font - (This : in out Text_Display; - To : in Font_Kind) is - begin - fl_text_display_set_linenumber_font - (This.Void_Ptr, - Font_Kind'Pos (To)); - end Set_Linenumber_Font; - - - function Get_Linenumber_Size - (This : in Text_Display) - return Font_Size is - begin - return Font_Size (fl_text_display_get_linenumber_size (This.Void_Ptr)); - end Get_Linenumber_Size; - - - procedure Set_Linenumber_Size - (This : in out Text_Display; - To : in Font_Size) is - begin - fl_text_display_set_linenumber_size - (This.Void_Ptr, - Interfaces.C.int (To)); - end Set_Linenumber_Size; - - - function Get_Linenumber_Width - (This : in Text_Display) - return Natural is - begin - return Natural (fl_text_display_get_linenumber_width (This.Void_Ptr)); - end Get_Linenumber_Width; - - - procedure Set_Linenumber_Width - (This : in out Text_Display; - Width : in Natural) is - begin - fl_text_display_set_linenumber_width - (This.Void_Ptr, - Interfaces.C.int (Width)); - end Set_Linenumber_Width; - - - - - procedure Move_Down - (This : in out Text_Display) is - begin - if fl_text_display_move_down (This.Void_Ptr) = 0 then - raise Bounds_Error; - end if; - end Move_Down; - - - procedure Move_Left - (This : in out Text_Display) is - begin - if fl_text_display_move_left (This.Void_Ptr) = 0 then - raise Bounds_Error; - end if; - end Move_Left; - - - procedure Move_Right - (This : in out Text_Display) is - begin - if fl_text_display_move_right (This.Void_Ptr) = 0 then - raise Bounds_Error; - end if; - end Move_Right; - - - procedure Move_Up - (This : in out Text_Display) is - begin - if fl_text_display_move_up (This.Void_Ptr) = 0 then - raise Bounds_Error; - end if; - end Move_Up; - - - - - procedure Scroll_To - (This : in out Text_Display; - Line : in Natural) is - begin - fl_text_display_scroll (This.Void_Ptr, Interfaces.C.int (Line)); - end Scroll_To; - - - function Get_Scrollbar_Alignment - (This : in Text_Display) - return Alignment is - begin - return Alignment (fl_text_display_get_scrollbar_align (This.Void_Ptr)); - end Get_Scrollbar_Alignment; - - - procedure Set_Scrollbar_Alignment - (This : in out Text_Display; - Align : in Alignment) is - begin - fl_text_display_set_scrollbar_align - (This.Void_Ptr, - Interfaces.C.unsigned (Align)); - end Set_Scrollbar_Alignment; - - - function Get_Scrollbar_Width - (This : in Text_Display) - return Natural is - begin - return Natural (fl_text_display_get_scrollbar_width (This.Void_Ptr)); - end Get_Scrollbar_Width; - - - procedure Set_Scrollbar_Width - (This : in out Text_Display; - Width : in Natural) is - begin - fl_text_display_set_scrollbar_width - (This.Void_Ptr, - Interfaces.C.int (Width)); - end Set_Scrollbar_Width; - - - - - procedure Redisplay_Range - (This : in out Text_Display; - Start, Finish : in Natural) is - begin - fl_text_display_redisplay_range - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Redisplay_Range; - - - procedure Draw - (This : in out Text_Display) is - begin - fl_text_display_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Text_Display; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_text_display_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Text_Displays; - diff --git a/src/fltk-widgets-groups-text_displays.ads b/src/fltk-widgets-groups-text_displays.ads deleted file mode 100644 index 609561e..0000000 --- a/src/fltk-widgets-groups-text_displays.ads +++ /dev/null @@ -1,458 +0,0 @@ - - -with - - FLTK.Text_Buffers; - -private with - - Interfaces.C, - System.Address_To_Access_Conversions; - - -package FLTK.Widgets.Groups.Text_Displays is - - - type Text_Display is new Group with private; - - type Text_Display_Reference (Data : not null access Text_Display'Class) is - limited null record with Implicit_Dereference => Data; - - type Wrap_Mode is (None, Column, Pixel, Bounds); - - type Cursor_Style is (Normal, Caret, Dim, Block, Heavy, Simple); - - Bounds_Error : exception; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Display; - - end Forge; - - - - - package Styles is - - type Style_Entry is private; - type Style_Index is new Character range 'A' .. '~'; - type Style_Array is array (Style_Index range <>) of Style_Entry; - - type Unfinished_Style_Callback is access procedure - (Char : in Character; - Display : in out Text_Display); - - function Item - (Tint : in Color; - Font : in Font_Kind; - Size : in Font_Size) - return Style_Entry; - - private - - type Style_Entry is record - Attr : Interfaces.C.unsigned; - Col : Interfaces.C.unsigned; - Font : Interfaces.C.int; - Size : Interfaces.C.int; - end record; - - pragma Convention (C, Style_Entry); - pragma Convention (C, Style_Array); - - end Styles; - - - - - function Get_Buffer - (This : in Text_Display) - return FLTK.Text_Buffers.Text_Buffer_Reference; - - procedure Set_Buffer - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer); - - - - - procedure Highlight_Data - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer; - Table : in Styles.Style_Array); - - procedure Highlight_Data - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer; - Table : in Styles.Style_Array; - Unfinished : in Styles.Style_Index; - Callback : in Styles.Unfinished_Style_Callback); - - - - - function Col_To_X - (This : in Text_Display; - Col_Num : in Integer) - return Integer; - - function X_To_Col - (This : in Text_Display; - X_Pos : in Integer) - return Integer; - - function In_Selection - (This : in Text_Display; - X, Y : in Integer) - return Boolean; - - procedure Position_To_XY - (This : in Text_Display; - Pos : in Integer; - X, Y : out Integer; - Vert_Out : out Boolean); - - - - - function Get_Cursor_Color - (This : in Text_Display) - return Color; - - procedure Set_Cursor_Color - (This : in out Text_Display; - Col : in Color); - - procedure Set_Cursor_Style - (This : in out Text_Display; - Style : in Cursor_Style); - - procedure Hide_Cursor - (This : in out Text_Display); - - procedure Show_Cursor - (This : in out Text_Display); - - - - - function Get_Text_Color - (This : in Text_Display) - return Color; - - procedure Set_Text_Color - (This : in out Text_Display; - Col : in Color); - - function Get_Text_Font - (This : in Text_Display) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Text_Display; - Font : in Font_Kind); - - function Get_Text_Size - (This : in Text_Display) - return Font_Size; - - procedure Set_Text_Size - (This : in out Text_Display; - Size : in Font_Size); - - - - - procedure Insert_Text - (This : in out Text_Display; - Item : in String); - - procedure Overstrike - (This : in out Text_Display; - Text : in String); - - function Get_Insert_Position - (This : in Text_Display) - return Natural; - - procedure Set_Insert_Position - (This : in out Text_Display; - Pos : in Natural); - - procedure Show_Insert_Position - (This : in out Text_Display); - - - - - function Word_Start - (This : in out Text_Display; - Pos : in Natural) - return Natural; - - function Word_End - (This : in out Text_Display; - Pos : in Natural) - return Natural; - - procedure Next_Word - (This : in out Text_Display); - - procedure Previous_Word - (This : in out Text_Display); - - procedure Set_Wrap_Mode - (This : in out Text_Display; - Mode : in Wrap_Mode; - Margin : in Natural := 0); - - - - - -- takes into account word wrap - function Line_Start - (This : in Text_Display; - Pos : in Natural) - return Natural; - - -- takes into account word wrap - function Line_End - (This : in Text_Display; - Pos : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural; - - function Count_Lines - (This : in Text_Display; - Start, Finish : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural; - - -- takes into account word wrap as well as newline characters - function Skip_Lines - (This : in Text_Display; - Start, Lines : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural; - - -- takes into account word wrap as well as newline characters - function Rewind_Lines - (This : in Text_Display; - Start, Lines : in Natural) - return Natural; - - - - - function Get_Linenumber_Alignment - (This : in Text_Display) - return Alignment; - - procedure Set_Linenumber_Alignment - (This : in out Text_Display; - To : in Alignment); - - function Get_Linenumber_Back_Color - (This : in Text_Display) - return Color; - - procedure Set_Linenumber_Back_Color - (This : in out Text_Display; - To : in Color); - - function Get_Linenumber_Fore_Color - (This : in Text_Display) - return Color; - - procedure Set_Linenumber_Fore_Color - (This : in out Text_Display; - To : in Color); - - function Get_Linenumber_Font - (This : in Text_Display) - return Font_Kind; - - procedure Set_Linenumber_Font - (This : in out Text_Display; - To : in Font_Kind); - - function Get_Linenumber_Size - (This : in Text_Display) - return Font_Size; - - procedure Set_Linenumber_Size - (This : in out Text_Display; - To : in Font_Size); - - function Get_Linenumber_Width - (This : in Text_Display) - return Natural; - - procedure Set_Linenumber_Width - (This : in out Text_Display; - Width : in Natural); - - - - - procedure Move_Down - (This : in out Text_Display); - - procedure Move_Left - (This : in out Text_Display); - - procedure Move_Right - (This : in out Text_Display); - - procedure Move_Up - (This : in out Text_Display); - - - - - procedure Scroll_To - (This : in out Text_Display; - Line : in Natural); - - function Get_Scrollbar_Alignment - (This : in Text_Display) - return Alignment; - - procedure Set_Scrollbar_Alignment - (This : in out Text_Display; - Align : in Alignment); - - function Get_Scrollbar_Width - (This : in Text_Display) - return Natural; - - procedure Set_Scrollbar_Width - (This : in out Text_Display; - Width : in Natural); - - - - - procedure Redisplay_Range - (This : in out Text_Display; - Start, Finish : in Natural); - - procedure Draw - (This : in out Text_Display); - - function Handle - (This : in out Text_Display; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Text_Display is new Group with - record - Buffer : access FLTK.Text_Buffers.Text_Buffer; - Style_Callback : Styles.Unfinished_Style_Callback; - end record; - - overriding procedure Finalize - (This : in out Text_Display); - - - - - package Text_Display_Convert is new System.Address_To_Access_Conversions (Text_Display'Class); - - - - - pragma Inline (Get_Buffer); - pragma Inline (Set_Buffer); - - - pragma Inline (Highlight_Data); - - - pragma Inline (Col_To_X); - pragma Inline (X_To_Col); - pragma Inline (In_Selection); - pragma Inline (Position_To_XY); - - - pragma Inline (Get_Cursor_Color); - pragma Inline (Set_Cursor_Color); - pragma Inline (Set_Cursor_Style); - pragma Inline (Hide_Cursor); - pragma Inline (Show_Cursor); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Insert_Text); - pragma Inline (Overstrike); - pragma Inline (Get_Insert_Position); - pragma Inline (Set_Insert_Position); - pragma Inline (Show_Insert_Position); - - - pragma Inline (Word_Start); - pragma Inline (Word_End); - pragma Inline (Next_Word); - pragma Inline (Previous_Word); - pragma Inline (Set_Wrap_Mode); - - - pragma Inline (Line_Start); - pragma Inline (Line_End); - pragma Inline (Count_Lines); - pragma Inline (Skip_Lines); - pragma Inline (Rewind_Lines); - - - pragma Inline (Get_Linenumber_Alignment); - pragma Inline (Set_Linenumber_Alignment); - pragma Inline (Get_Linenumber_Back_Color); - pragma Inline (Set_Linenumber_Back_Color); - pragma Inline (Get_Linenumber_Fore_Color); - pragma Inline (Set_Linenumber_Fore_Color); - pragma Inline (Get_Linenumber_Font); - pragma Inline (Set_Linenumber_Font); - pragma Inline (Get_Linenumber_Size); - pragma Inline (Set_Linenumber_Size); - pragma Inline (Get_Linenumber_Width); - pragma Inline (Set_Linenumber_Width); - - - pragma Inline (Move_Down); - pragma Inline (Move_Left); - pragma Inline (Move_Right); - pragma Inline (Move_Up); - - - pragma Inline (Scroll_To); - pragma Inline (Get_Scrollbar_Alignment); - pragma Inline (Set_Scrollbar_Alignment); - pragma Inline (Get_Scrollbar_Width); - pragma Inline (Set_Scrollbar_Width); - - - pragma Inline (Redisplay_Range); - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Text_Displays; - diff --git a/src/fltk-widgets-groups-tiled.adb b/src/fltk-widgets-groups-tiled.adb deleted file mode 100644 index 1652afe..0000000 --- a/src/fltk-widgets-groups-tiled.adb +++ /dev/null @@ -1,145 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Tiled is - - - procedure tile_set_draw_hook - (W, D : in System.Address); - pragma Import (C, tile_set_draw_hook, "tile_set_draw_hook"); - pragma Inline (tile_set_draw_hook); - - procedure tile_set_handle_hook - (W, H : in System.Address); - pragma Import (C, tile_set_handle_hook, "tile_set_handle_hook"); - pragma Inline (tile_set_handle_hook); - - - - - function new_fl_tile - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_tile, "new_fl_tile"); - pragma Inline (new_fl_tile); - - procedure free_fl_tile - (B : in System.Address); - pragma Import (C, free_fl_tile, "free_fl_tile"); - pragma Inline (free_fl_tile); - - - - - procedure fl_tile_position - (T : in System.Address; - OX, OY, NX, NY : in Interfaces.C.int); - pragma Import (C, fl_tile_position, "fl_tile_position"); - pragma Inline (fl_tile_position); - - - - - procedure fl_tile_draw - (W : in System.Address); - pragma Import (C, fl_tile_draw, "fl_tile_draw"); - pragma Inline (fl_tile_draw); - - function fl_tile_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_tile_handle, "fl_tile_handle"); - pragma Inline (fl_tile_handle); - - - - - procedure Finalize - (This : in out Tiled_Group) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Tiled_Group'Class - then - This.Clear; - free_fl_tile (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Tiled_Group is - begin - return This : Tiled_Group do - This.Void_Ptr := new_fl_tile - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - tile_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - tile_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Position - (This : in out Tiled_Group; - Old_X, Old_Y : in Integer; - New_X, New_Y : in Integer) is - begin - fl_tile_position - (This.Void_Ptr, - Interfaces.C.int (Old_X), Interfaces.C.int (Old_Y), - Interfaces.C.int (New_X), Interfaces.C.int (New_Y)); - end Position; - - - - - procedure Draw - (This : in out Tiled_Group) is - begin - fl_tile_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Tiled_Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_tile_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Tiled; - diff --git a/src/fltk-widgets-groups-tiled.ads b/src/fltk-widgets-groups-tiled.ads deleted file mode 100644 index 92ba031..0000000 --- a/src/fltk-widgets-groups-tiled.ads +++ /dev/null @@ -1,62 +0,0 @@ - - -package FLTK.Widgets.Groups.Tiled is - - - type Tiled_Group is new Group with private; - - type Tiled_Group_Reference (Data : not null access Tiled_Group'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Tiled_Group; - - end Forge; - - - - - procedure Position - (This : in out Tiled_Group; - Old_X, Old_Y : in Integer; - New_X, New_Y : in Integer); - - - - - procedure Draw - (This : in out Tiled_Group); - - function Handle - (This : in out Tiled_Group; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Tiled_Group is new Group with null record; - - overriding procedure Finalize - (This : in out Tiled_Group); - - - - - pragma Inline (Position); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Tiled; - diff --git a/src/fltk-widgets-groups-windows-double-overlay.adb b/src/fltk-widgets-groups-windows-double-overlay.adb deleted file mode 100644 index e61782a..0000000 --- a/src/fltk-widgets-groups-windows-double-overlay.adb +++ /dev/null @@ -1,262 +0,0 @@ - - -with - - Interfaces.C, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Groups.Windows.Double.Overlay is - - - procedure overlay_window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, overlay_window_set_draw_hook, "overlay_window_set_draw_hook"); - pragma Inline (overlay_window_set_draw_hook); - - procedure overlay_window_set_draw_overlay_hook - (W, D : in System.Address); - pragma Import (C, overlay_window_set_draw_overlay_hook, - "overlay_window_set_draw_overlay_hook"); - pragma Inline (overlay_window_set_draw_overlay_hook); - - procedure overlay_window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, overlay_window_set_handle_hook, "overlay_window_set_handle_hook"); - pragma Inline (overlay_window_set_handle_hook); - - - - - function new_fl_overlay_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_overlay_window, "new_fl_overlay_window"); - pragma Inline (new_fl_overlay_window); - - function new_fl_overlay_window2 - (W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_overlay_window2, "new_fl_overlay_window2"); - pragma Inline (new_fl_overlay_window2); - - procedure free_fl_overlay_window - (S : in System.Address); - pragma Import (C, free_fl_overlay_window, "free_fl_overlay_window"); - pragma Inline (free_fl_overlay_window); - - - - - procedure fl_overlay_window_show - (W : in System.Address); - pragma Import (C, fl_overlay_window_show, "fl_overlay_window_show"); - pragma Inline (fl_overlay_window_show); - - procedure fl_overlay_window_hide - (W : in System.Address); - pragma Import (C, fl_overlay_window_hide, "fl_overlay_window_hide"); - pragma Inline (fl_overlay_window_hide); - - procedure fl_overlay_window_flush - (W : in System.Address); - pragma Import (C, fl_overlay_window_flush, "fl_overlay_window_flush"); - pragma Inline (fl_overlay_window_flush); - - - - - function fl_overlay_window_can_do_overlay - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_overlay_window_can_do_overlay, "fl_overlay_window_can_do_overlay"); - pragma Inline (fl_overlay_window_can_do_overlay); - - - - - procedure fl_overlay_window_draw - (W : in System.Address); - pragma Import (C, fl_overlay_window_draw, "fl_overlay_window_draw"); - pragma Inline (fl_overlay_window_draw); - - procedure fl_overlay_window_redraw_overlay - (W : in System.Address); - pragma Import (C, fl_overlay_window_redraw_overlay, "fl_overlay_window_redraw_overlay"); - pragma Inline (fl_overlay_window_redraw_overlay); - - function fl_overlay_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_overlay_window_handle, "fl_overlay_window_handle"); - pragma Inline (fl_overlay_window_handle); - - - - - package Over_Convert is new System.Address_To_Access_Conversions (Overlay_Window'Class); - - - procedure Draw_Overlay_Hook - (U : in System.Address) - is - Overlay_Widget : access Overlay_Window'Class := - Over_Convert.To_Pointer (U); - begin - Overlay_Widget.Draw_Overlay; - end Draw_Overlay_Hook; - - - - - procedure Finalize - (This : in out Overlay_Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Overlay_Window'Class - then - This.Clear; - free_fl_overlay_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Double_Window (This)); - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Overlay_Window is - begin - return This : Overlay_Window do - This.Void_Ptr := new_fl_overlay_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - overlay_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - overlay_window_set_draw_overlay_hook (This.Void_Ptr, Draw_Overlay_Hook'Address); - overlay_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Overlay_Window is - begin - return This : Overlay_Window do - This.Void_Ptr := new_fl_overlay_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - overlay_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - overlay_window_set_draw_overlay_hook (This.Void_Ptr, Draw_Overlay_Hook'Address); - overlay_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - --------------- - -- Display -- - --------------- - - procedure Show - (This : in out Overlay_Window) is - begin - fl_overlay_window_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out Overlay_Window) is - begin - fl_overlay_window_hide (This.Void_Ptr); - end Hide; - - - procedure Flush - (This : in out Overlay_Window) is - begin - fl_overlay_window_flush (This.Void_Ptr); - end Flush; - - - - - ------------- - -- Other -- - ------------- - - function Can_Do_Overlay - (This : in Overlay_Window) - return Boolean is - begin - return fl_overlay_window_can_do_overlay (This.Void_Ptr) /= 0; - end Can_Do_Overlay; - - - - - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- - - procedure Draw - (This : in out Overlay_Window) is - begin - fl_overlay_window_draw (This.Void_Ptr); - end Draw; - - - procedure Redraw_Overlay - (This : in out Overlay_Window) is - begin - fl_overlay_window_redraw_overlay (This.Void_Ptr); - end Redraw_Overlay; - - - function Handle - (This : in out Overlay_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_overlay_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows.Double.Overlay; - diff --git a/src/fltk-widgets-groups-windows-double-overlay.ads b/src/fltk-widgets-groups-windows-double-overlay.ads deleted file mode 100644 index fa7fe1d..0000000 --- a/src/fltk-widgets-groups-windows-double-overlay.ads +++ /dev/null @@ -1,110 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Double.Overlay is - - - ------------- - -- Types -- - ------------- - - type Overlay_Window is new Double_Window with private; - - type Overlay_Window_Reference (Data : not null access Overlay_Window'Class) is - limited null record with Implicit_Dereference => Data; - - - - - -------------------- - -- Constructors -- - -------------------- - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Overlay_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Overlay_Window; - - end Forge; - - - - - --------------- - -- Display -- - --------------- - - procedure Show - (This : in out Overlay_Window); - - procedure Hide - (This : in out Overlay_Window); - - procedure Flush - (This : in out Overlay_Window); - - - - - ------------- - -- Other -- - ------------- - - function Can_Do_Overlay - (This : in Overlay_Window) - return Boolean; - - - - - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- - - procedure Draw - (This : in out Overlay_Window); - - procedure Draw_Overlay - (This : in out Overlay_Window) is null; - - procedure Redraw_Overlay - (This : in out Overlay_Window); - - function Handle - (This : in out Overlay_Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Overlay_Window is new Double_Window with null record; - - overriding procedure Finalize - (This : in out Overlay_Window); - - - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Flush); - - - pragma Inline (Can_Do_Overlay); - - - pragma Inline (Draw); - pragma Inline (Redraw_Overlay); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Windows.Double.Overlay; - diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb deleted file mode 100644 index cc920d9..0000000 --- a/src/fltk-widgets-groups-windows-double.adb +++ /dev/null @@ -1,191 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Windows.Double is - - - procedure double_window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, double_window_set_draw_hook, "double_window_set_draw_hook"); - pragma Inline (double_window_set_draw_hook); - - procedure double_window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, double_window_set_handle_hook, "double_window_set_handle_hook"); - pragma Inline (double_window_set_handle_hook); - - - - - function new_fl_double_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_double_window, "new_fl_double_window"); - pragma Inline (new_fl_double_window); - - function new_fl_double_window2 - (X, Y : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); - pragma Inline (new_fl_double_window2); - - procedure free_fl_double_window - (W : in System.Address); - pragma Import (C, free_fl_double_window, "free_fl_double_window"); - pragma Inline (free_fl_double_window); - - - - - procedure fl_double_window_show - (W : in System.Address); - pragma Import (C, fl_double_window_show, "fl_double_window_show"); - pragma Inline (fl_double_window_show); - - procedure fl_double_window_hide - (W : in System.Address); - pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); - pragma Inline (fl_double_window_hide); - - procedure fl_double_window_flush - (W : in System.Address); - pragma Import (C, fl_double_window_flush, "fl_double_window_flush"); - pragma Inline (fl_double_window_flush); - - - - - procedure fl_double_window_draw - (W : in System.Address); - pragma Import (C, fl_double_window_draw, "fl_double_window_draw"); - pragma Inline (fl_double_window_draw); - - function fl_double_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_double_window_handle, "fl_double_window_handle"); - pragma Inline (fl_double_window_handle); - - - - - procedure Finalize - (This : in out Double_Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Double_Window'Class - then - This.Clear; - free_fl_double_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Window (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Double_Window is - begin - return This : Double_Window do - This.Void_Ptr := new_fl_double_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - double_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - double_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Double_Window is - begin - return This : Double_Window do - This.Void_Ptr := new_fl_double_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - double_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - double_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Show - (This : in out Double_Window) is - begin - fl_double_window_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out Double_Window) is - begin - fl_double_window_hide (This.Void_Ptr); - end Hide; - - - procedure Flush - (This : in out Double_Window) is - begin - fl_double_window_flush (This.Void_Ptr); - end Flush; - - - - - procedure Draw - (This : in out Double_Window) is - begin - fl_double_window_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Double_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_double_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows.Double; - diff --git a/src/fltk-widgets-groups-windows-double.ads b/src/fltk-widgets-groups-windows-double.ads deleted file mode 100644 index 0284e59..0000000 --- a/src/fltk-widgets-groups-windows-double.ads +++ /dev/null @@ -1,72 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Double is - - - type Double_Window is new Window with private; - - type Double_Window_Reference (Data : not null access Double_Window'Class) is - limited null record with Implicit_Dereference => Data; - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Double_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Double_Window; - - end Forge; - - - - - procedure Show - (This : in out Double_Window); - - procedure Hide - (This : in out Double_Window); - - procedure Flush - (This : in out Double_Window); - - - - - procedure Draw - (This : in out Double_Window); - - function Handle - (This : in out Double_Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Double_Window is new Window with null record; - - overriding procedure Finalize - (This : in out Double_Window); - - - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Flush); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Windows.Double; - diff --git a/src/fltk-widgets-groups-windows-opengl.adb b/src/fltk-widgets-groups-windows-opengl.adb deleted file mode 100644 index c877497..0000000 --- a/src/fltk-widgets-groups-windows-opengl.adb +++ /dev/null @@ -1,502 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - Interfaces.C.signed_char, - Interfaces.C.unsigned, - System.Address; - - -package body FLTK.Widgets.Groups.Windows.OpenGL is - - - procedure gl_window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, gl_window_set_draw_hook, "gl_window_set_draw_hook"); - pragma Inline (gl_window_set_draw_hook); - - procedure gl_window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, gl_window_set_handle_hook, "gl_window_set_handle_hook"); - pragma Inline (gl_window_set_handle_hook); - - - - - function new_fl_gl_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_gl_window, "new_fl_gl_window"); - pragma Inline (new_fl_gl_window); - - function new_fl_gl_window2 - (W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_gl_window2, "new_fl_gl_window2"); - pragma Inline (new_fl_gl_window2); - - procedure free_fl_gl_window - (S : in System.Address); - pragma Import (C, free_fl_gl_window, "free_fl_gl_window"); - pragma Inline (free_fl_gl_window); - - - - - procedure fl_gl_window_show - (S : in System.Address); - pragma Import (C, fl_gl_window_show, "fl_gl_window_show"); - pragma Inline (fl_gl_window_show); - - procedure fl_gl_window_hide - (S : in System.Address); - pragma Import (C, fl_gl_window_hide, "fl_gl_window_hide"); - pragma Inline (fl_gl_window_hide); - - procedure fl_gl_window_hide_overlay - (S : in System.Address); - pragma Import (C, fl_gl_window_hide_overlay, "fl_gl_window_hide_overlay"); - pragma Inline (fl_gl_window_hide_overlay); - - procedure fl_gl_window_flush - (S : in System.Address); - pragma Import (C, fl_gl_window_flush, "fl_gl_window_flush"); - pragma Inline (fl_gl_window_flush); - - - - - function fl_gl_window_pixel_h - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_pixel_h, "fl_gl_window_pixel_h"); - pragma Inline (fl_gl_window_pixel_h); - - function fl_gl_window_pixel_w - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_pixel_w, "fl_gl_window_pixel_w"); - pragma Inline (fl_gl_window_pixel_w); - - function fl_gl_window_pixels_per_unit - (S : in System.Address) - return Interfaces.C.C_float; - pragma Import (C, fl_gl_window_pixels_per_unit, "fl_gl_window_pixels_per_unit"); - pragma Inline (fl_gl_window_pixels_per_unit); - - - - - function fl_gl_window_get_mode - (S : in System.Address) - return Mode_Mask; - pragma Import (C, fl_gl_window_get_mode, "fl_gl_window_get_mode"); - pragma Inline (fl_gl_window_get_mode); - - procedure fl_gl_window_set_mode - (S : in System.Address; - M : in Mode_Mask); - pragma Import (C, fl_gl_window_set_mode, "fl_gl_window_set_mode"); - pragma Inline (fl_gl_window_set_mode); - - function fl_gl_window_static_can_do - (M : in Mode_Mask) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_static_can_do, "fl_gl_window_static_can_do"); - pragma Inline (fl_gl_window_static_can_do); - - function fl_gl_window_can_do - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_can_do, "fl_gl_window_can_do"); - pragma Inline (fl_gl_window_can_do); - - function fl_gl_window_can_do_overlay - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_can_do_overlay, "fl_gl_window_can_do_overlay"); - pragma Inline (fl_gl_window_can_do_overlay); - - - - - function fl_gl_window_get_context - (S : in System.Address) - return System.Address; - pragma Import (C, fl_gl_window_get_context, "fl_gl_window_get_context"); - pragma Inline (fl_gl_window_get_context); - - procedure fl_gl_window_set_context - (S, P : in System.Address; - D : in Interfaces.C.int); - pragma Import (C, fl_gl_window_set_context, "fl_gl_window_set_context"); - pragma Inline (fl_gl_window_set_context); - - function fl_gl_window_context_valid - (S : in System.Address) - return Interfaces.C.signed_char; - pragma Import (C, fl_gl_window_context_valid, "fl_gl_window_context_valid"); - pragma Inline (fl_gl_window_context_valid); - - procedure fl_gl_window_set_context_valid - (S : in System.Address; - V : in Interfaces.C.signed_char); - pragma Import (C, fl_gl_window_set_context_valid, "fl_gl_window_set_context_valid"); - pragma Inline (fl_gl_window_set_context_valid); - - function fl_gl_window_valid - (S : in System.Address) - return Interfaces.C.signed_char; - pragma Import (C, fl_gl_window_valid, "fl_gl_window_valid"); - pragma Inline (fl_gl_window_valid); - - procedure fl_gl_window_set_valid - (S : in System.Address; - V : in Interfaces.C.signed_char); - pragma Import (C, fl_gl_window_set_valid, "fl_gl_window_set_valid"); - pragma Inline (fl_gl_window_set_valid); - - procedure fl_gl_window_make_current - (S : in System.Address); - pragma Import (C, fl_gl_window_make_current, "fl_gl_window_make_current"); - pragma Inline (fl_gl_window_make_current); - - procedure fl_gl_window_make_overlay_current - (S : in System.Address); - pragma Import (C, fl_gl_window_make_overlay_current, "fl_gl_window_make_overlay_current"); - pragma Inline (fl_gl_window_make_overlay_current); - - - - - procedure fl_gl_window_ortho - (W : in System.Address); - pragma Import (C, fl_gl_window_ortho, "fl_gl_window_ortho"); - pragma Inline (fl_gl_window_ortho); - - procedure fl_gl_window_redraw_overlay - (W : in System.Address); - pragma Import (C, fl_gl_window_redraw_overlay, "fl_gl_window_redraw_overlay"); - pragma Inline (fl_gl_window_redraw_overlay); - - procedure fl_gl_window_swap_buffers - (W : in System.Address); - pragma Import (C, fl_gl_window_swap_buffers, "fl_gl_window_swap_buffers"); - pragma Inline (fl_gl_window_swap_buffers); - - procedure fl_gl_window_draw - (W : in System.Address); - pragma Import (C, fl_gl_window_draw, "fl_gl_window_draw"); - pragma Inline (fl_gl_window_draw); - - function fl_gl_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_gl_window_handle, "fl_gl_window_handle"); - pragma Inline (fl_gl_window_handle); - - - - - procedure Finalize - (This : in out GL_Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in GL_Window'Class - then - This.Clear; - free_fl_gl_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Window (This)); - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return GL_Window is - begin - return This : GL_Window do - This.Void_Ptr := new_fl_gl_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - gl_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - gl_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return GL_Window is - begin - return This : GL_Window do - This.Void_Ptr := new_fl_gl_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - gl_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - gl_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - --------------- - -- Display -- - --------------- - - procedure Show - (This : in out GL_Window) is - begin - fl_gl_window_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out GL_Window) is - begin - fl_gl_window_hide (This.Void_Ptr); - end Hide; - - - procedure Hide_Overlay - (This : in out GL_Window) is - begin - fl_gl_window_hide_overlay (This.Void_Ptr); - end Hide_Overlay; - - - procedure Flush - (This : in out GL_Window) is - begin - fl_gl_window_flush (This.Void_Ptr); - end Flush; - - - - - ------------------ - -- Dimensions -- - ------------------ - - function Pixel_H - (This : in GL_Window) - return Integer is - begin - return Integer (fl_gl_window_pixel_h (This.Void_Ptr)); - end Pixel_H; - - - function Pixel_W - (This : in GL_Window) - return Integer is - begin - return Integer (fl_gl_window_pixel_w (This.Void_Ptr)); - end Pixel_W; - - - function Pixels_Per_Unit - (This : in GL_Window) - return Float is - begin - return Float (fl_gl_window_pixels_per_unit (This.Void_Ptr)); - end Pixels_Per_Unit; - - - - - -------------------- - -- OpenGL Modes -- - -------------------- - - function Get_Mode - (This : in GL_Window) - return Mode_Mask is - begin - return fl_gl_window_get_mode (This.Void_Ptr); - end Get_Mode; - - - procedure Set_Mode - (This : in out GL_Window; - Mask : in Mode_Mask) is - begin - fl_gl_window_set_mode (This.Void_Ptr, Mask); - end Set_Mode; - - - function Can_Do - (Mask : in Mode_Mask) - return Boolean is - begin - return fl_gl_window_static_can_do (Mask) /= 0; - end Can_Do; - - - function Can_Do - (This : in GL_Window) - return Boolean is - begin - return fl_gl_window_can_do (This.Void_Ptr) /= 0; - end Can_Do; - - - function Can_Do_Overlay - (This : in GL_Window) - return Boolean is - begin - return fl_gl_window_can_do_overlay (This.Void_Ptr) /= 0; - end Can_Do_Overlay; - - - - - ----------------------- - -- OpenGL Contexts -- - ----------------------- - - function Get_Context - (This : in GL_Window) - return System.Address is - begin - return fl_gl_window_get_context (This.Void_Ptr); - end Get_Context; - - - procedure Set_Context - (This : in out GL_Window; - Struct : in System.Address; - Destroy : in Boolean := False) is - begin - fl_gl_window_set_context (This.Void_Ptr, Struct, Boolean'Pos (Destroy)); - end Set_Context; - - - function Get_Context_Valid - (This : in GL_Window) - return Boolean is - begin - return fl_gl_window_context_valid (This.Void_Ptr) /= 0; - end Get_Context_Valid; - - - procedure Set_Context_Valid - (This : in out GL_Window; - Value : in Boolean) is - begin - fl_gl_window_set_context_valid (This.Void_Ptr, Boolean'Pos (Value)); - end Set_Context_Valid; - - - function Get_Valid - (This : in GL_Window) - return Boolean is - begin - return fl_gl_window_valid (This.Void_Ptr) /= 0; - end Get_Valid; - - - procedure Set_Valid - (This : in out GL_Window; - Value : in Boolean) is - begin - fl_gl_window_set_valid (This.Void_Ptr, Boolean'Pos (Value)); - end Set_Valid; - - - procedure Make_Current - (This : in out GL_Window) is - begin - fl_gl_window_make_current (This.Void_Ptr); - end Make_Current; - - - procedure Make_Overlay_Current - (This : in out GL_Window) is - begin - fl_gl_window_make_overlay_current (This.Void_Ptr); - end Make_Overlay_Current; - - - - - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- - - procedure Ortho - (This : in out GL_Window) is - begin - fl_gl_window_ortho (This.Void_Ptr); - end Ortho; - - - procedure Redraw_Overlay - (This : in out GL_Window) is - begin - fl_gl_window_redraw_overlay (This.Void_Ptr); - end Redraw_Overlay; - - - procedure Swap_Buffers - (This : in out GL_Window) is - begin - fl_gl_window_swap_buffers (This.Void_Ptr); - end Swap_Buffers; - - - procedure Draw - (This : in out GL_Window) is - begin - fl_gl_window_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out GL_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_gl_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows.OpenGL; - diff --git a/src/fltk-widgets-groups-windows-opengl.ads b/src/fltk-widgets-groups-windows-opengl.ads deleted file mode 100644 index 8d76884..0000000 --- a/src/fltk-widgets-groups-windows-opengl.ads +++ /dev/null @@ -1,252 +0,0 @@ - - -with - - System; - -private with - - Interfaces.C; - - -package FLTK.Widgets.Groups.Windows.OpenGL is - - - ------------- - -- Types -- - ------------- - - type GL_Window is new Window with private; - - type GL_Window_Reference (Data : not null access GL_Window'Class) is - limited null record with Implicit_Dereference => Data; - - -- RGB mode is achieved by Index being set to False - -- Single buffer mode is achieved by Double being set to False - type Mode_Mask is record - Index : Boolean := False; - Double : Boolean := False; - Accum : Boolean := False; - Alpha : Boolean := False; - Depth : Boolean := False; - Stencil : Boolean := False; - RGB8 : Boolean := False; - Multisample : Boolean := False; - Stereo : Boolean := False; - Fake_Single : Boolean := False; - OpenGL3 : Boolean := False; - end record; - - - - - -------------------- - -- Constructors -- - -------------------- - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return GL_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return GL_Window; - - end Forge; - - - - - --------------- - -- Display -- - --------------- - - procedure Show - (This : in out GL_Window); - - procedure Hide - (This : in out GL_Window); - - procedure Hide_Overlay - (This : in out GL_Window); - - procedure Flush - (This : in out GL_Window); - - - - - ------------------ - -- Dimensions -- - ------------------ - - function Pixel_H - (This : in GL_Window) - return Integer; - - function Pixel_W - (This : in GL_Window) - return Integer; - - function Pixels_Per_Unit - (This : in GL_Window) - return Float; - - - - - -------------------- - -- OpenGL Modes -- - -------------------- - - function Get_Mode - (This : in GL_Window) - return Mode_Mask; - - procedure Set_Mode - (This : in out GL_Window; - Mask : in Mode_Mask); - - function Can_Do - (Mask : in Mode_Mask) - return Boolean; - - function Can_Do - (This : in GL_Window) - return Boolean; - - function Can_Do_Overlay - (This : in GL_Window) - return Boolean; - - - - - ----------------------- - -- OpenGL Contexts -- - ----------------------- - - function Get_Context - (This : in GL_Window) - return System.Address; - - procedure Set_Context - (This : in out GL_Window; - Struct : in System.Address; - Destroy : in Boolean := False); - - function Get_Context_Valid - (This : in GL_Window) - return Boolean; - - procedure Set_Context_Valid - (This : in out GL_Window; - Value : in Boolean); - - function Get_Valid - (This : in GL_Window) - return Boolean; - - procedure Set_Valid - (This : in out GL_Window; - Value : in Boolean); - - procedure Make_Current - (This : in out GL_Window); - - procedure Make_Overlay_Current - (This : in out GL_Window); - - - - - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- - - procedure Ortho - (This : in out GL_Window); - - procedure Redraw_Overlay - (This : in out GL_Window); - - procedure Swap_Buffers - (This : in out GL_Window); - - procedure Draw - (This : in out GL_Window); - - function Handle - (This : in out GL_Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type GL_Window is new Window with null record; - - overriding procedure Finalize - (This : in out GL_Window); - - - for Mode_Mask use record - Index at 0 range 0 .. 0; - Double at 0 range 1 .. 1; - Accum at 0 range 2 .. 2; - Alpha at 0 range 3 .. 3; - Depth at 0 range 4 .. 4; - Stencil at 0 range 5 .. 5; - RGB8 at 0 range 6 .. 6; - Multisample at 0 range 7 .. 7; - Stereo at 0 range 8 .. 8; - Fake_Single at 0 range 9 .. 9; - OpenGL3 at 0 range 10 .. Interfaces.C.unsigned'Size - 1; - end record; - - for Mode_Mask'Size use Interfaces.C.unsigned'Size; - - pragma Convention (C_Pass_By_Copy, Mode_Mask); - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Hide_Overlay); - pragma Inline (Flush); - - - pragma Inline (Pixel_H); - pragma Inline (Pixel_W); - pragma Inline (Pixels_Per_Unit); - - - pragma Inline (Get_Mode); - pragma Inline (Set_Mode); - pragma Inline (Can_Do); - pragma Inline (Can_Do_Overlay); - - - pragma Inline (Get_Context); - pragma Inline (Set_Context); - pragma Inline (Get_Context_Valid); - pragma Inline (Set_Context_Valid); - pragma Inline (Get_Valid); - pragma Inline (Set_Valid); - pragma Inline (Make_Current); - pragma Inline (Make_Overlay_Current); - - - pragma Inline (Ortho); - pragma Inline (Redraw_Overlay); - pragma Inline (Swap_Buffers); - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Windows.OpenGL; - diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb deleted file mode 100644 index d26b33f..0000000 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ /dev/null @@ -1,233 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address, - Interfaces.C.unsigned; - - -package body FLTK.Widgets.Groups.Windows.Single.Menu is - - - procedure menu_window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, menu_window_set_draw_hook, "menu_window_set_draw_hook"); - pragma Inline (menu_window_set_draw_hook); - - procedure menu_window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, menu_window_set_handle_hook, "menu_window_set_handle_hook"); - pragma Inline (menu_window_set_handle_hook); - - - - - function new_fl_menu_window - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_window, "new_fl_menu_window"); - pragma Inline (new_fl_menu_window); - - function new_fl_menu_window2 - (W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2"); - pragma Inline (new_fl_menu_window2); - - procedure free_fl_menu_window - (M : in System.Address); - pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); - pragma Inline (free_fl_menu_window); - - - - - procedure fl_menu_window_show - (M : in System.Address); - pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); - pragma Inline (fl_menu_window_show); - - procedure fl_menu_window_hide - (M : in System.Address); - pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide"); - pragma Inline (fl_menu_window_hide); - - procedure fl_menu_window_flush - (M : in System.Address); - pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); - pragma Inline (fl_menu_window_flush); - - - - - procedure fl_menu_window_set_overlay - (M : in System.Address); - pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay"); - pragma Inline (fl_menu_window_set_overlay); - - procedure fl_menu_window_clear_overlay - (M : in System.Address); - pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay"); - pragma Inline (fl_menu_window_clear_overlay); - - function fl_menu_window_overlay - (M : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); - pragma Inline (fl_menu_window_overlay); - - - - - procedure fl_menu_window_draw - (W : in System.Address); - pragma Import (C, fl_menu_window_draw, "fl_menu_window_draw"); - pragma Inline (fl_menu_window_draw); - - function fl_menu_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_window_handle, "fl_menu_window_handle"); - pragma Inline (fl_menu_window_handle); - - - - - procedure Finalize - (This : in out Menu_Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Menu_Window'Class - then - This.Clear; - free_fl_menu_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Single_Window (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Window is - begin - return This : Menu_Window do - This.Void_Ptr := new_fl_menu_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Menu_Window is - begin - return This : Menu_Window do - This.Void_Ptr := new_fl_menu_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Show - (This : in out Menu_Window) is - begin - fl_menu_window_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out Menu_Window) is - begin - fl_menu_window_hide (This.Void_Ptr); - end Hide; - - - procedure Flush - (This : in out Menu_Window) is - begin - fl_menu_window_flush (This.Void_Ptr); - end Flush; - - - - - function Is_Overlay - (This : in Menu_Window) - return Boolean is - begin - return fl_menu_window_overlay (This.Void_Ptr) /= 0; - end Is_Overlay; - - - procedure Set_Overlay - (This : in out Menu_Window; - Value : in Boolean) is - begin - if Value then - fl_menu_window_set_overlay (This.Void_Ptr); - else - fl_menu_window_clear_overlay (This.Void_Ptr); - end if; - end Set_Overlay; - - - - - procedure Draw - (This : in out Menu_Window) is - begin - fl_menu_window_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Menu_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows.Single.Menu; - diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads deleted file mode 100644 index 7596298..0000000 --- a/src/fltk-widgets-groups-windows-single-menu.ads +++ /dev/null @@ -1,88 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Single.Menu is - - - type Menu_Window is new Single_Window with private; - - type Menu_Window_Reference (Data : not null access Menu_Window'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Menu_Window; - - end Forge; - - - - - procedure Show - (This : in out Menu_Window); - - procedure Hide - (This : in out Menu_Window); - - procedure Flush - (This : in out Menu_Window); - - - - - function Is_Overlay - (This : in Menu_Window) - return Boolean; - - procedure Set_Overlay - (This : in out Menu_Window; - Value : in Boolean); - - - - - procedure Draw - (This : in out Menu_Window); - - function Handle - (This : in out Menu_Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Menu_Window is new Single_Window with null record; - - overriding procedure Finalize - (This : in out Menu_Window); - - - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Flush); - - - pragma Inline (Is_Overlay); - pragma Inline (Set_Overlay); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Windows.Single.Menu; - diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb deleted file mode 100644 index 2bc5608..0000000 --- a/src/fltk-widgets-groups-windows-single.adb +++ /dev/null @@ -1,179 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Windows.Single is - - - procedure single_window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, single_window_set_draw_hook, "single_window_set_draw_hook"); - pragma Inline (single_window_set_draw_hook); - - procedure single_window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, single_window_set_handle_hook, "single_window_set_handle_hook"); - pragma Inline (single_window_set_handle_hook); - - - - - function new_fl_single_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_single_window, "new_fl_single_window"); - pragma Inline (new_fl_single_window); - - function new_fl_single_window2 - (W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_single_window2, "new_fl_single_window2"); - pragma Inline (new_fl_single_window2); - - procedure free_fl_single_window - (S : in System.Address); - pragma Import (C, free_fl_single_window, "free_fl_single_window"); - pragma Inline (free_fl_single_window); - - - - - procedure fl_single_window_show - (S : in System.Address); - pragma Import (C, fl_single_window_show, "fl_single_window_show"); - pragma Inline (fl_single_window_show); - - procedure fl_single_window_flush - (S : in System.Address); - pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); - pragma Inline (fl_single_window_flush); - - - - - procedure fl_single_window_draw - (W : in System.Address); - pragma Import (C, fl_single_window_draw, "fl_single_window_draw"); - pragma Inline (fl_single_window_draw); - - function fl_single_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_single_window_handle, "fl_single_window_handle"); - pragma Inline (fl_single_window_handle); - - - - - procedure Finalize - (This : in out Single_Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Single_Window'Class - then - This.Clear; - free_fl_single_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Window (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Single_Window is - begin - return This : Single_Window do - This.Void_Ptr := new_fl_single_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - single_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - single_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Single_Window is - begin - return This : Single_Window do - This.Void_Ptr := new_fl_single_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - single_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - single_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Show - (This : in out Single_Window) is - begin - fl_single_window_show (This.Void_Ptr); - end Show; - - - procedure Flush - (This : in out Single_Window) is - begin - fl_single_window_flush (This.Void_Ptr); - end Flush; - - - - - procedure Draw - (This : in out Single_Window) is - begin - fl_single_window_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Single_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_single_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows.Single; - diff --git a/src/fltk-widgets-groups-windows-single.ads b/src/fltk-widgets-groups-windows-single.ads deleted file mode 100644 index 6a36727..0000000 --- a/src/fltk-widgets-groups-windows-single.ads +++ /dev/null @@ -1,69 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Single is - - - type Single_Window is new Window with private; - - type Single_Window_Reference (Data : not null access Single_Window'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Single_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Single_Window; - - end Forge; - - - - - procedure Show - (This : in out Single_Window); - - procedure Flush - (This : in out Single_Window); - - - - - procedure Draw - (This : in out Single_Window); - - function Handle - (This : in out Single_Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Single_Window is new Window with null record; - - overriding procedure Finalize - (This : in out Single_Window); - - - - - pragma Inline (Show); - pragma Inline (Flush); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Windows.Single; - diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb deleted file mode 100644 index 68b2301..0000000 --- a/src/fltk-widgets-groups-windows.adb +++ /dev/null @@ -1,738 +0,0 @@ - - -with - - Interfaces.C.Strings, - System, - FLTK.Images.RGB; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Groups.Windows is - - - procedure window_set_draw_hook - (W, D : in System.Address); - pragma Import (C, window_set_draw_hook, "window_set_draw_hook"); - pragma Inline (window_set_draw_hook); - - procedure window_set_handle_hook - (W, H : in System.Address); - pragma Import (C, window_set_handle_hook, "window_set_handle_hook"); - pragma Inline (window_set_handle_hook); - - - - - function new_fl_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_window, "new_fl_window"); - pragma Inline (new_fl_window); - - function new_fl_window2 - (W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_window2, "new_fl_window2"); - pragma Inline (new_fl_window2); - - procedure free_fl_window - (W : in System.Address); - pragma Import (C, free_fl_window, "free_fl_window"); - pragma Inline (free_fl_window); - - - - - procedure fl_window_show - (W : in System.Address); - pragma Import (C, fl_window_show, "fl_window_show"); - pragma Inline (fl_window_show); - - procedure fl_window_hide - (W : in System.Address); - pragma Import (C, fl_window_hide, "fl_window_hide"); - pragma Inline (fl_window_hide); - - function fl_window_shown - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_window_shown, "fl_window_shown"); - pragma Inline (fl_window_shown); - - procedure fl_window_wait_for_expose - (W : in System.Address); - pragma Import (C, fl_window_wait_for_expose, "fl_window_wait_for_expose"); - pragma Inline (fl_window_wait_for_expose); - - procedure fl_window_iconize - (W : in System.Address); - pragma Import (C, fl_window_iconize, "fl_window_iconize"); - pragma Inline (fl_window_iconize); - - procedure fl_window_make_current - (W : in System.Address); - pragma Import (C, fl_window_make_current, "fl_window_make_current"); - pragma Inline (fl_window_make_current); - - procedure fl_window_free_position - (W : in System.Address); - pragma Import (C, fl_window_free_position, "fl_window_free_position"); - pragma Inline (fl_window_free_position); - - - - - function fl_window_fullscreen_active - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_window_fullscreen_active, "fl_window_fullscreen_active"); - pragma Inline (fl_window_fullscreen_active); - - procedure fl_window_fullscreen - (W : in System.Address); - pragma Import (C, fl_window_fullscreen, "fl_window_fullscreen"); - pragma Inline (fl_window_fullscreen); - - procedure fl_window_fullscreen_off - (W : in System.Address); - pragma Import (C, fl_window_fullscreen_off, "fl_window_fullscreen_off"); - pragma Inline (fl_window_fullscreen_off); - - procedure fl_window_fullscreen_off2 - (N : in System.Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_window_fullscreen_off2, "fl_window_fullscreen_off2"); - pragma Inline (fl_window_fullscreen_off2); - - procedure fl_window_fullscreen_screens - (W : in System.Address; - T, B, L, R : in Interfaces.C.int); - pragma Import (C, fl_window_fullscreen_screens, "fl_window_fullscreen_screens"); - pragma Inline (fl_window_fullscreen_screens); - - - - - procedure fl_window_set_icon - (W, P : in System.Address); - pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); - pragma Inline (fl_window_set_icon); - - procedure fl_window_default_icon - (P : in System.Address); - pragma Import (C, fl_window_default_icon, "fl_window_default_icon"); - pragma Inline (fl_window_default_icon); - - function fl_window_get_iconlabel - (W : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_window_get_iconlabel, "fl_window_get_iconlabel"); - pragma Inline (fl_window_get_iconlabel); - - procedure fl_window_set_iconlabel - (W : in System.Address; - S : in Interfaces.C.char_array); - pragma Import (C, fl_window_set_iconlabel, "fl_window_set_iconlabel"); - pragma Inline (fl_window_set_iconlabel); - - procedure fl_window_set_cursor - (W : in System.Address; - C : in Interfaces.C.int); - pragma Import (C, fl_window_set_cursor, "fl_window_set_cursor"); - pragma Inline (fl_window_set_cursor); - - procedure fl_window_set_cursor2 - (W, P : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_window_set_cursor2, "fl_window_set_cursor2"); - pragma Inline (fl_window_set_cursor2); - - procedure fl_window_set_default_cursor - (W : in System.Address; - C : in Interfaces.C.int); - pragma Import (C, fl_window_set_default_cursor, "fl_window_set_default_cursor"); - pragma Inline (fl_window_set_default_cursor); - - - - - function fl_window_get_border - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_window_get_border, "fl_window_get_border"); - pragma Inline (fl_window_get_border); - - procedure fl_window_set_border - (W : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_window_set_border, "fl_window_set_border"); - pragma Inline (fl_window_set_border); - - function fl_window_get_override - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_window_get_override, "fl_window_get_override"); - pragma Inline (fl_window_get_override); - - procedure fl_window_set_override - (W : in System.Address); - pragma Import (C, fl_window_set_override, "fl_window_set_override"); - pragma Inline (fl_window_set_override); - - function fl_window_modal - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_window_modal, "fl_window_modal"); - pragma Inline (fl_window_modal); - - function fl_window_non_modal - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_window_non_modal, "fl_window_non_modal"); - pragma Inline (fl_window_non_modal); - - procedure fl_window_clear_modal_states - (W : in System.Address); - pragma Import (C, fl_window_clear_modal_states, "fl_window_clear_modal_states"); - pragma Inline (fl_window_clear_modal_states); - - procedure fl_window_set_modal - (W : in System.Address); - pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); - pragma Inline (fl_window_set_modal); - - procedure fl_window_set_non_modal - (W : in System.Address); - pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); - pragma Inline (fl_window_set_non_modal); - - - - - function fl_window_get_label - (W : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_window_get_label, "fl_window_get_label"); - pragma Inline (fl_window_get_label); - - procedure fl_window_set_label - (W : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_window_set_label, "fl_window_set_label"); - pragma Inline (fl_window_set_label); - - procedure fl_window_hotspot - (W : in System.Address; - X, Y, S : in Interfaces.C.int); - pragma Import (C, fl_window_hotspot, "fl_window_hotspot"); - pragma Inline (fl_window_hotspot); - - procedure fl_window_hotspot2 - (W, I : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_window_hotspot2, "fl_window_hotspot2"); - pragma Inline (fl_window_hotspot2); - - procedure fl_window_size_range - (W : in System.Address; - LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); - pragma Import (C, fl_window_size_range, "fl_window_size_range"); - pragma Inline (fl_window_size_range); - - procedure fl_window_shape - (W, P : in System.Address); - pragma Import (C, fl_window_shape, "fl_window_shape"); - pragma Inline (fl_window_shape); - - - - - function fl_window_get_x_root - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_window_get_x_root, "fl_window_get_x_root"); - pragma Inline (fl_window_get_x_root); - - function fl_window_get_y_root - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_window_get_y_root, "fl_window_get_y_root"); - pragma Inline (fl_window_get_y_root); - - function fl_window_get_decorated_w - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_window_get_decorated_w, "fl_window_get_decorated_w"); - pragma Inline (fl_window_get_decorated_w); - - function fl_window_get_decorated_h - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_window_get_decorated_h, "fl_window_get_decorated_h"); - pragma Inline (fl_window_get_decorated_h); - - - - - procedure fl_window_draw - (W : in System.Address); - pragma Import (C, fl_window_draw, "fl_window_draw"); - pragma Inline (fl_window_draw); - - function fl_window_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_window_handle, "fl_window_handle"); - pragma Inline (fl_window_handle); - - - - - procedure Finalize - (This : in out Window) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Window'Class - then - This.Clear; - free_fl_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Window is - begin - return This : Window do - This.Void_Ptr := new_fl_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Window is - begin - return This : Window do - This.Void_Ptr := new_fl_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Show - (This : in out Window) is - begin - fl_window_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out Window) is - begin - fl_window_hide (This.Void_Ptr); - end Hide; - - - function Is_Shown - (This : in Window) - return Boolean is - begin - return fl_window_shown (This.Void_Ptr) /= 0; - end Is_Shown; - - - procedure Wait_For_Expose - (This : in out Window) is - begin - fl_window_wait_for_expose (This.Void_Ptr); - end Wait_For_Expose; - - - procedure Iconify - (This : in out Window) is - begin - fl_window_iconize (This.Void_Ptr); - end Iconify; - - - procedure Make_Current - (This : in out Window) is - begin - fl_window_make_current (This.Void_Ptr); - Last_Current := This'Unchecked_Access; - end Make_Current; - - - function Last_Made_Current - return access Window'Class is - begin - return Last_Current; - end Last_Made_Current; - - - procedure Free_Position - (This : in out Window) is - begin - fl_window_free_position (This.Void_Ptr); - end Free_Position; - - - - - function Is_Fullscreen - (This : in Window) - return Boolean is - begin - return fl_window_fullscreen_active (This.Void_Ptr) /= 0; - end Is_Fullscreen; - - - procedure Fullscreen_On - (This : in out Window) is - begin - fl_window_fullscreen (This.Void_Ptr); - end Fullscreen_On; - - - procedure Fullscreen_Off - (This : in out Window) is - begin - fl_window_fullscreen_off (This.Void_Ptr); - end Fullscreen_Off; - - - procedure Fullscreen_Off - (This : in out Window; - X, Y, W, H : in Integer) is - begin - fl_window_fullscreen_off2 - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Fullscreen_Off; - - - procedure Fullscreen_Screens - (This : in out Window; - Top, Bottom, Left, Right : in Natural) is - begin - fl_window_fullscreen_screens - (This.Void_Ptr, - Interfaces.C.int (Top), - Interfaces.C.int (Bottom), - Interfaces.C.int (Left), - Interfaces.C.int (Right)); - end Fullscreen_Screens; - - - - - procedure Set_Icon - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class) is - begin - fl_window_set_icon - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); - end Set_Icon; - - - procedure Set_Default_Icon - (Pic : in out FLTK.Images.RGB.RGB_Image'Class) is - begin - fl_window_default_icon (Wrapper (Pic).Void_Ptr); - end Set_Default_Icon; - - - function Get_Icon_Label - (This : in Window) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_iconlabel (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_Icon_Label; - - - procedure Set_Icon_Label - (This : in out Window; - To : in String) is - begin - fl_window_set_iconlabel (This.Void_Ptr, Interfaces.C.To_C (To)); - end Set_Icon_Label; - - - procedure Set_Cursor - (This : in out Window; - To : in Mouse_Cursor_Kind) is - begin - fl_window_set_cursor (This.Void_Ptr, Cursor_Values (To)); - end Set_Cursor; - - - procedure Set_Cursor - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class; - Hot_X, Hot_Y : in Integer) is - begin - fl_window_set_cursor2 - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr, - Interfaces.C.int (Hot_X), - Interfaces.C.int (Hot_Y)); - end Set_Cursor; - - - procedure Set_Default_Cursor - (This : in out Window; - To : in Mouse_Cursor_Kind) is - begin - fl_window_set_default_cursor (This.Void_Ptr, Cursor_Values (To)); - end Set_Default_Cursor; - - - - - function Get_Border_State - (This : in Window) - return Border_State is - begin - return Border_State'Val (fl_window_get_border (This.Void_Ptr)); - end Get_Border_State; - - - procedure Set_Border_State - (This : in out Window; - To : in Border_State) is - begin - fl_window_set_border (This.Void_Ptr, Border_State'Pos (To)); - end Set_Border_State; - - - function Is_Override - (This : in Window) - return Boolean is - begin - return fl_window_get_override (This.Void_Ptr) /= 0; - end Is_Override; - - - procedure Set_Override - (This : in out Window) is - begin - fl_window_set_override (This.Void_Ptr); - end Set_Override; - - - function Get_Modal_State - (This : in Window) - return Modal_State is - begin - if fl_window_modal (This.Void_Ptr) /= 0 then - return Modal; - elsif fl_window_non_modal (This.Void_Ptr) /= 0 then - return Non_Modal; - else - return Normal; - end if; - end Get_Modal_State; - - - procedure Set_Modal_State - (This : in out Window; - To : in Modal_State) is - begin - case To is - when Normal => - fl_window_clear_modal_states (This.Void_Ptr); - when Non_Modal => - fl_window_set_non_modal (This.Void_Ptr); - when Modal => - fl_window_set_modal (This.Void_Ptr); - end case; - end Set_Modal_State; - - - - - function Get_Label - (This : in Window) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_label (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_Label; - - - procedure Set_Label - (This : in out Window; - Text : in String) is - begin - fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Label; - - - procedure Hotspot - (This : in out Window; - X, Y : in Integer; - Offscreen : in Boolean := False) is - begin - fl_window_hotspot - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Boolean'Pos (Offscreen)); - end Hotspot; - - - procedure Hotspot - (This : in out Window; - Item : in Widget'Class; - Offscreen : in Boolean := False) is - begin - fl_window_hotspot2 - (This.Void_Ptr, - Item.Void_Ptr, - Boolean'Pos (Offscreen)); - end Hotspot; - - - procedure Set_Size_Range - (This : in out Window; - Min_W, Min_H : in Integer; - Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; - Keep_Aspect : in Boolean := False) is - begin - fl_window_size_range - (This.Void_Ptr, - Interfaces.C.int (Min_W), - Interfaces.C.int (Min_H), - Interfaces.C.int (Max_W), - Interfaces.C.int (Max_H), - Interfaces.C.int (Incre_W), - Interfaces.C.int (Incre_H), - Boolean'Pos (Keep_Aspect)); - end Set_Size_Range; - - - procedure Shape - (This : in out Window; - Pic : in out FLTK.Images.Image'Class) is - begin - fl_window_shape (This.Void_Ptr, Wrapper (Pic).Void_Ptr); - end Shape; - - - - - function Get_X_Root - (This : in Window) - return Integer is - begin - return Integer (fl_window_get_x_root (This.Void_Ptr)); - end Get_X_Root; - - - function Get_Y_Root - (This : in Window) - return Integer is - begin - return Integer (fl_window_get_y_root (This.Void_Ptr)); - end Get_Y_Root; - - - function Get_Decorated_W - (This : in Window) - return Integer is - begin - return Integer (fl_window_get_decorated_w (This.Void_Ptr)); - end Get_Decorated_W; - - - function Get_Decorated_H - (This : in Window) - return Integer is - begin - return Integer (fl_window_get_decorated_h (This.Void_Ptr)); - end Get_Decorated_H; - - - - - procedure Draw - (This : in out Window) is - begin - fl_window_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_window_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Windows; - diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads deleted file mode 100644 index 176aced..0000000 --- a/src/fltk-widgets-groups-windows.ads +++ /dev/null @@ -1,275 +0,0 @@ - - -with - - FLTK.Images.RGB; - -private with - - Interfaces.C; - - -package FLTK.Widgets.Groups.Windows is - - - type Window is new Group with private; - - type Window_Reference (Data : not null access Window'Class) is limited null record - with Implicit_Dereference => Data; - - type Border_State is (None, Visible); - - type Modal_State is (Normal, Non_Modal, Modal); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Window; - - end Forge; - - - - - procedure Show - (This : in out Window); - - procedure Hide - (This : in out Window); - - function Is_Shown - (This : in Window) - return Boolean; - - procedure Wait_For_Expose - (This : in out Window); - - procedure Iconify - (This : in out Window); - - procedure Make_Current - (This : in out Window); - - function Last_Made_Current - return access Window'Class; - - procedure Free_Position - (This : in out Window); - - - - - function Is_Fullscreen - (This : in Window) - return Boolean; - - procedure Fullscreen_On - (This : in out Window); - - procedure Fullscreen_Off - (This : in out Window); - - procedure Fullscreen_Off - (This : in out Window; - X, Y, W, H : in Integer); - - procedure Fullscreen_Screens - (This : in out Window; - Top, Bottom, Left, Right : in Natural); - - - - - procedure Set_Icon - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class); - - procedure Set_Default_Icon - (Pic : in out FLTK.Images.RGB.RGB_Image'Class); - - function Get_Icon_Label - (This : in Window) - return String; - - procedure Set_Icon_Label - (This : in out Window; - To : in String); - - procedure Set_Cursor - (This : in out Window; - To : in Mouse_Cursor_Kind); - - procedure Set_Cursor - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class; - Hot_X, Hot_Y : in Integer); - - procedure Set_Default_Cursor - (This : in out Window; - To : in Mouse_Cursor_Kind); - - - - - function Get_Border_State - (This : in Window) - return Border_State; - - procedure Set_Border_State - (This : in out Window; - To : in Border_State); - - function Is_Override - (This : in Window) - return Boolean; - - procedure Set_Override - (This : in out Window); - - function Get_Modal_State - (This : in Window) - return Modal_State; - - procedure Set_Modal_State - (This : in out Window; - To : in Modal_State); - - - - - function Get_Label - (This : in Window) - return String; - - procedure Set_Label - (This : in out Window; - Text : in String); - - procedure Hotspot - (This : in out Window; - X, Y : in Integer; - Offscreen : in Boolean := False); - - procedure Hotspot - (This : in out Window; - Item : in Widget'Class; - Offscreen : in Boolean := False); - - procedure Set_Size_Range - (This : in out Window; - Min_W, Min_H : in Integer; - Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; - Keep_Aspect : in Boolean := False); - - procedure Shape - (This : in out Window; - Pic : in out FLTK.Images.Image'Class); - - - - - function Get_X_Root - (This : in Window) - return Integer; - - function Get_Y_Root - (This : in Window) - return Integer; - - function Get_Decorated_W - (This : in Window) - return Integer; - - function Get_Decorated_H - (This : in Window) - return Integer; - - - - - procedure Draw - (This : in out Window); - - function Handle - (This : in out Window; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Window is new Group with null record; - - overriding procedure Finalize - (This : in out Window); - - - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Is_Shown); - pragma Inline (Wait_For_Expose); - pragma Inline (Iconify); - pragma Inline (Make_Current); - pragma Inline (Last_Made_Current); - pragma Inline (Free_Position); - - - pragma Inline (Is_Fullscreen); - pragma Inline (Fullscreen_On); - pragma Inline (Fullscreen_Off); - pragma Inline (Fullscreen_Screens); - - - pragma Inline (Set_Icon); - pragma Inline (Set_Default_Icon); - pragma Inline (Get_Icon_Label); - pragma Inline (Set_Icon_Label); - pragma Inline (Set_Cursor); - pragma Inline (Set_Default_Cursor); - - - pragma Inline (Get_Border_State); - pragma Inline (Set_Border_State); - pragma Inline (Is_Override); - pragma Inline (Set_Override); - pragma Inline (Get_Modal_State); - pragma Inline (Set_Modal_State); - - - pragma Inline (Get_Label); - pragma Inline (Set_Label); - pragma Inline (Hotspot); - pragma Inline (Set_Size_Range); - pragma Inline (Shape); - - - pragma Inline (Get_X_Root); - pragma Inline (Get_Y_Root); - pragma Inline (Get_Decorated_W); - pragma Inline (Get_Decorated_H); - - - pragma Inline (Draw); - pragma Inline (Handle); - - - - - Last_Current : access Window'Class := null; - - -end FLTK.Widgets.Groups.Windows; - diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb deleted file mode 100644 index f7ab3ed..0000000 --- a/src/fltk-widgets-groups-wizards.adb +++ /dev/null @@ -1,188 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Groups.Wizards is - - - procedure wizard_set_draw_hook - (W, D : in System.Address); - pragma Import (C, wizard_set_draw_hook, "wizard_set_draw_hook"); - pragma Inline (wizard_set_draw_hook); - - procedure wizard_set_handle_hook - (W, H : in System.Address); - pragma Import (C, wizard_set_handle_hook, "wizard_set_handle_hook"); - pragma Inline (wizard_set_handle_hook); - - - - - function new_fl_wizard - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_wizard, "new_fl_wizard"); - pragma Inline (new_fl_wizard); - - procedure free_fl_wizard - (S : in System.Address); - pragma Import (C, free_fl_wizard, "free_fl_wizard"); - pragma Inline (free_fl_wizard); - - - - - procedure fl_wizard_next - (W : in System.Address); - pragma Import (C, fl_wizard_next, "fl_wizard_next"); - pragma Inline (fl_wizard_next); - - procedure fl_wizard_prev - (W : in System.Address); - pragma Import (C, fl_wizard_prev, "fl_wizard_prev"); - pragma Inline (fl_wizard_prev); - - - - - function fl_wizard_get_visible - (W : in System.Address) - return System.Address; - pragma Import (C, fl_wizard_get_visible, "fl_wizard_get_visible"); - pragma Inline (fl_wizard_get_visible); - - procedure fl_wizard_set_visible - (W, I : in System.Address); - pragma Import (C, fl_wizard_set_visible, "fl_wizard_set_visible"); - pragma Inline (fl_wizard_set_visible); - - - - - procedure fl_wizard_draw - (W : in System.Address); - pragma Import (C, fl_wizard_draw, "fl_wizard_draw"); - pragma Inline (fl_wizard_draw); - - function fl_wizard_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_wizard_handle, "fl_wizard_handle"); - pragma Inline (fl_wizard_handle); - - - - - procedure Finalize - (This : in out Wizard) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Wizard'Class - then - This.Clear; - free_fl_wizard (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Group (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Wizard is - begin - return This : Wizard do - This.Void_Ptr := new_fl_wizard - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - wizard_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - wizard_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Next - (This : in out Wizard) is - begin - fl_wizard_next (This.Void_Ptr); - end Next; - - - procedure Prev - (This : in out Wizard) is - begin - fl_wizard_prev (This.Void_Ptr); - end Prev; - - - - - function Get_Visible - (This : in Wizard) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_wizard_get_visible (This.Void_Ptr); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Get_Visible; - - - procedure Set_Visible - (This : in out Wizard; - Item : in out Widget'Class) is - begin - fl_wizard_set_visible (This.Void_Ptr, Item.Void_Ptr); - end Set_Visible; - - - - - procedure Draw - (This : in out Wizard) is - begin - fl_wizard_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Wizard; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_wizard_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Wizards; - diff --git a/src/fltk-widgets-groups-wizards.ads b/src/fltk-widgets-groups-wizards.ads deleted file mode 100644 index 63c68e5..0000000 --- a/src/fltk-widgets-groups-wizards.ads +++ /dev/null @@ -1,79 +0,0 @@ - - -package FLTK.Widgets.Groups.Wizards is - - - type Wizard is new Group with private; - - type Wizard_Reference (Data : not null access Wizard'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Wizard; - - end Forge; - - - - - procedure Next - (This : in out Wizard); - - procedure Prev - (This : in out Wizard); - - - - - function Get_Visible - (This : in Wizard) - return access Widget'Class; - - procedure Set_Visible - (This : in out Wizard; - Item : in out Widget'Class); - - - - - procedure Draw - (This : in out Wizard); - - function Handle - (This : in out Wizard; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Wizard is new Group with null record; - - overriding procedure Finalize - (This : in out Wizard); - - - - - pragma Inline (Next); - pragma Inline (Prev); - - - pragma Inline (Get_Visible); - pragma Inline (Set_Visible); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Wizards; - diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb deleted file mode 100644 index 08c61ab..0000000 --- a/src/fltk-widgets-groups.adb +++ /dev/null @@ -1,474 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Groups is - - - procedure group_set_draw_hook - (W, D : in System.Address); - pragma Import (C, group_set_draw_hook, "group_set_draw_hook"); - pragma Inline (group_set_draw_hook); - - procedure group_set_handle_hook - (W, H : in System.Address); - pragma Import (C, group_set_handle_hook, "group_set_handle_hook"); - pragma Inline (group_set_handle_hook); - - - - - function new_fl_group - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_group, "new_fl_group"); - pragma Inline (new_fl_group); - - procedure free_fl_group - (G : in System.Address); - pragma Import (C, free_fl_group, "free_fl_group"); - pragma Inline (free_fl_group); - - - - - procedure fl_group_add - (G, W : in System.Address); - pragma Import (C, fl_group_add, "fl_group_add"); - pragma Inline (fl_group_add); - - procedure fl_group_insert - (G, W : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_insert, "fl_group_insert"); - pragma Inline (fl_group_insert); - - procedure fl_group_insert2 - (G, W, B : in System.Address); - pragma Import (C, fl_group_insert2, "fl_group_insert2"); - pragma Inline (fl_group_insert2); - - procedure fl_group_remove - (G, W : in System.Address); - pragma Import (C, fl_group_remove, "fl_group_remove"); - pragma Inline (fl_group_remove); - - procedure fl_group_remove2 - (G : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_remove2, "fl_group_remove2"); - pragma Inline (fl_group_remove2); - - - - - function fl_group_child - (G : in System.Address; - I : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_group_child, "fl_group_child"); - pragma Inline (fl_group_child); - - function fl_group_find - (G, W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_group_find, "fl_group_find"); - pragma Inline (fl_group_find); - - function fl_group_children - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_group_children, "fl_group_children"); - pragma Inline (fl_group_children); - - - - - -- function fl_group_get_clip_children - -- (G : in System.Address) - -- return Interfaces.C.unsigned; - -- pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children"); - -- pragma Inline (fl_group_get_clip_children); - - -- procedure fl_group_set_clip_children - -- (G : in System.Address; - -- C : in Interfaces.C.unsigned); - -- pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); - -- pragma Inline (fl_group_set_clip_children); - - - - - function fl_group_get_resizable - (G : in System.Address) - return System.Address; - pragma Import (C, fl_group_get_resizable, "fl_group_get_resizable"); - pragma Inline (fl_group_get_resizable); - - procedure fl_group_set_resizable - (G, W : in System.Address); - pragma Import (C, fl_group_set_resizable, "fl_group_set_resizable"); - pragma Inline (fl_group_set_resizable); - - procedure fl_group_init_sizes - (G : in System.Address); - pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes"); - pragma Inline (fl_group_init_sizes); - - - - - function fl_group_get_current - return System.Address; - pragma Import (C, fl_group_get_current, "fl_group_get_current"); - pragma Inline (fl_group_get_current); - - procedure fl_group_set_current - (G : in System.Address); - pragma Import (C, fl_group_set_current, "fl_group_set_current"); - pragma Inline (fl_group_set_current); - - - - - procedure fl_group_draw - (W : in System.Address); - pragma Import (C, fl_group_draw, "fl_group_draw"); - pragma Inline (fl_group_draw); - - function fl_group_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_group_handle, "fl_group_handle"); - pragma Inline (fl_group_handle); - - - - - procedure Finalize - (This : in out Group) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Group'Class - then - This.Clear; - free_fl_group (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Group is - begin - return This : Group do - This.Void_Ptr := new_fl_group - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - group_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - group_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Add - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_add (This.Void_Ptr, Item.Void_Ptr); - end Add; - - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Place : in Index) is - begin - fl_group_insert - (This.Void_Ptr, - Item.Void_Ptr, - Interfaces.C.int (Place) - 1); - end Insert; - - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Before : in Widget'Class) is - begin - fl_group_insert2 - (This.Void_Ptr, - Item.Void_Ptr, - Before.Void_Ptr); - end Insert; - - - procedure Remove - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_remove (This.Void_Ptr, Item.Void_Ptr); - end Remove; - - - procedure Remove - (This : in out Group; - Place : in Index) is - begin - fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place) - 1); - end Remove; - - - procedure Clear - (This : in out Group) is - begin - for I in reverse 1 .. This.Number_Of_Children loop - This.Remove (Index (I)); - end loop; - end Clear; - - - - - function Has_Child - (This : in Group; - Place : in Index) - return Boolean is - begin - return Place in 1 .. This.Number_Of_Children; - end Has_Child; - - - function Has_Child - (Place : in Cursor) - return Boolean is - begin - return Place.My_Container.Has_Child (Place.My_Index); - end Has_Child; - - - function Child - (This : in Group; - Place : in Index) - return Widget_Reference - is - Widget_Ptr : System.Address := - fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return (Data => Actual_Widget); - end Child; - - - function Child - (This : in Group; - Place : in Cursor) - return Widget_Reference is - begin - return This.Child (Place.My_Index); - end Child; - - - function Find - (This : in Group; - Item : in out Widget'Class) - return Extended_Index - is - Ret : Interfaces.C.int; - begin - Ret := fl_group_find (This.Void_Ptr, Item.Void_Ptr); - if Ret = fl_group_children (This.Void_Ptr) then - return No_Index; - end if; - return Extended_Index (Ret + 1); - end Find; - - - function Number_Of_Children - (This : in Group) - return Natural is - begin - return Natural (fl_group_children (This.Void_Ptr)); - end Number_Of_Children; - - - - - function Iterate - (This : in Group) - return Group_Iterators.Reversible_Iterator'Class is - begin - return It : Iterator := (My_Container => This'Unrestricted_Access); - end Iterate; - - - function First - (Object : in Iterator) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Object.My_Container, - My_Index => 1); - end First; - - - function Next - (Object : in Iterator; - Place : in Cursor) - return Cursor is - begin - if Object.My_Container /= Place.My_Container then - raise Program_Error; - end if; - return Cu : Cursor := - (My_Container => Place.My_Container, - My_Index => Place.My_Index + 1); - end Next; - - - function Last - (Object : in Iterator) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Object.My_Container, - My_Index => Object.My_Container.Number_Of_Children); - end Last; - - - function Previous - (Object : in Iterator; - Place : in Cursor) - return Cursor is - begin - if Object.My_Container /= Place.My_Container then - raise Program_Error; - end if; - return Cu : Cursor := - (My_Container => Place.My_Container, - My_Index => Place.My_Index - 1); - end Previous; - - - - - -- function Get_Clip_Mode - -- (This : in Group) - -- return Clip_Mode is - -- begin - -- return Clip_Mode'Val (fl_group_get_clip_children (This.Void_Ptr)); - -- end Get_Clip_Mode; - - - -- procedure Set_Clip_Mode - -- (This : in out Group; - -- Mode : in Clip_Mode) is - -- begin - -- fl_group_set_clip_children (This.Void_Ptr, Clip_Mode'Pos (Mode)); - -- end Set_Clip_Mode; - - - - - function Get_Resizable - (This : in Group) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_group_get_resizable (This.Void_Ptr); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Get_Resizable; - - - procedure Set_Resizable - (This : in out Group; - Item : in Widget'Class) is - begin - fl_group_set_resizable (This.Void_Ptr, Item.Void_Ptr); - end Set_Resizable; - - - procedure Reset_Initial_Sizes - (This : in out Group) is - begin - fl_group_init_sizes (This.Void_Ptr); - end Reset_Initial_Sizes; - - - - - function Get_Current - return access Group'Class - is - Group_Ptr : System.Address := fl_group_get_current; - Actual_Group : access Group'Class; - begin - if Group_Ptr /= System.Null_Address then - Actual_Group := Group_Convert.To_Pointer (Group_Ptr); - end if; - return Actual_Group; - end Get_Current; - - - procedure Set_Current - (To : in Group'Class) is - begin - fl_group_set_current (To.Void_Ptr); - end Set_Current; - - - - - procedure Draw - (This : in out Group) is - begin - fl_group_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_group_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups; - diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads deleted file mode 100644 index 1c2c30a..0000000 --- a/src/fltk-widgets-groups.ads +++ /dev/null @@ -1,241 +0,0 @@ - - -with - - Ada.Iterator_Interfaces; - -private with - - System.Address_To_Access_Conversions; - - -package FLTK.Widgets.Groups is - - - type Group is new Widget with private - with Default_Iterator => Iterate, - Iterator_Element => Widget_Reference, - Variable_Indexing => Child; - - type Group_Reference (Data : not null access Group'Class) is limited null record - with Implicit_Dereference => Data; - - subtype Index is Positive; - subtype Extended_Index is Natural; - No_Index : constant Extended_Index := Extended_Index'First; - - -- type Clip_Mode is (No_Clip, Clip); - - type Cursor is private; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Group; - - end Forge; - - - - - procedure Add - (This : in out Group; - Item : in out Widget'Class); - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Place : in Index); - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Before : in Widget'Class); - - procedure Remove - (This : in out Group; - Item : in out Widget'Class); - - procedure Remove - (This : in out Group; - Place : in Index); - - procedure Clear - (This : in out Group); - - - - - function Has_Child - (This : in Group; - Place : in Index) - return Boolean; - - function Has_Child - (Place : in Cursor) - return Boolean; - - function Child - (This : in Group; - Place : in Index) - return Widget_Reference; - - function Child - (This : in Group; - Place : in Cursor) - return Widget_Reference; - - function Find - (This : in Group; - Item : in out Widget'Class) - return Extended_Index; - - function Number_Of_Children - (This : in Group) - return Natural; - - - - - package Group_Iterators is - new Ada.Iterator_Interfaces (Cursor, Has_Child); - - function Iterate - (This : in Group) - return Group_Iterators.Reversible_Iterator'Class; - - - - - -- function Get_Clip_Mode - -- (This : in Group) - -- return Clip_Mode; - - -- procedure Set_Clip_Mode - -- (This : in out Group; - -- Mode : in Clip_Mode); - - - - - function Get_Resizable - (This : in Group) - return access Widget'Class; - - procedure Set_Resizable - (This : in out Group; - Item : in Widget'Class); - - procedure Reset_Initial_Sizes - (This : in out Group); - - - - - function Get_Current - return access Group'Class; - - procedure Set_Current - (To : in Group'Class); - - - - - procedure Draw - (This : in out Group); - - function Handle - (This : in out Group; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Group is new Widget with null record; - - overriding procedure Finalize - (This : in out Group); - - package Group_Convert is new System.Address_To_Access_Conversions (Group); - - - - - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - - type Cursor is record - My_Container : access Group; - My_Index : Index'Base := Index'First; - end record; - - type Iterator is new Group_Iterators.Reversible_Iterator with record - My_Container : access Group; - end record; - - overriding function First - (Object : in Iterator) - return Cursor; - - overriding function Next - (Object : in Iterator; - Place : in Cursor) - return Cursor; - - overriding function Last - (Object : in Iterator) - return Cursor; - - overriding function Previous - (Object : in Iterator; - Place : in Cursor) - return Cursor; - - - - - pragma Inline (Add); - pragma Inline (Insert); - pragma Inline (Remove); - pragma Inline (Clear); - - - pragma Inline (Has_Child); - pragma Inline (Child); - pragma Inline (Find); - pragma Inline (Number_Of_Children); - - - pragma Inline (Iterate); - - - -- pragma Inline (Get_Clip_Mode); - -- pragma Inline (Set_Clip_Mode); - - - pragma Inline (Get_Resizable); - pragma Inline (Set_Resizable); - pragma Inline (Reset_Initial_Sizes); - - - pragma Inline (Get_Current); - pragma Inline (Set_Current); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups; - diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb deleted file mode 100644 index f69cb9b..0000000 --- a/src/fltk-widgets-inputs-file.adb +++ /dev/null @@ -1,223 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Inputs.File is - - - procedure file_input_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out File_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in File_Input'Class - then - free_fl_file_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - file_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - file_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - 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 b3175c8..0000000 --- a/src/fltk-widgets-inputs-file.ads +++ /dev/null @@ -1,91 +0,0 @@ - - -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); - - - - - 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-float.adb b/src/fltk-widgets-inputs-float.adb deleted file mode 100644 index b278b14..0000000 --- a/src/fltk-widgets-inputs-float.adb +++ /dev/null @@ -1,139 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Inputs.Float is - - - procedure float_input_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out Float_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Float_Input'Class - then - free_fl_float_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - float_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - float_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Value - (This : in Float_Input) - return Standard.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 Standard.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.Float; - diff --git a/src/fltk-widgets-inputs-float.ads b/src/fltk-widgets-inputs-float.ads deleted file mode 100644 index f848ae0..0000000 --- a/src/fltk-widgets-inputs-float.ads +++ /dev/null @@ -1,61 +0,0 @@ - - -package FLTK.Widgets.Inputs.Float 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 Standard.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); - - - - - pragma Inline (Get_Value); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Float; - diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb deleted file mode 100644 index bc794e4..0000000 --- a/src/fltk-widgets-inputs-integer.adb +++ /dev/null @@ -1,139 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Inputs.Integer is - - - procedure int_input_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out Integer_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Integer_Input'Class - then - free_fl_int_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - int_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - int_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Value - (This : in Integer_Input) - return Standard.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 Standard.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.Integer; - diff --git a/src/fltk-widgets-inputs-integer.ads b/src/fltk-widgets-inputs-integer.ads deleted file mode 100644 index 821710a..0000000 --- a/src/fltk-widgets-inputs-integer.ads +++ /dev/null @@ -1,61 +0,0 @@ - - -package FLTK.Widgets.Inputs.Integer 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 Standard.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); - - - - - pragma Inline (Get_Value); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Integer; - diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb deleted file mode 100644 index a319ab4..0000000 --- a/src/fltk-widgets-inputs-multiline.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Inputs.Multiline is - - - procedure multiline_input_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out Multiline_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Multiline_Input'Class - then - free_fl_multiline_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - multiline_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - multiline_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - 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 7ebf76d..0000000 --- a/src/fltk-widgets-inputs-multiline.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -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); - - - - - 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 7f95fcc..0000000 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Inputs.Outputs.Multiline is - - - procedure multiline_output_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out Multiline_Output) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Multiline_Output'Class - then - free_fl_multiline_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Output (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - multiline_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - multiline_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - 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 8f1a2be..0000000 --- a/src/fltk-widgets-inputs-outputs-multiline.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -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); - - - - - 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 e70db5c..0000000 --- a/src/fltk-widgets-inputs-outputs.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Inputs.Outputs is - - - procedure output_set_draw_hook - (W, D : in System.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 System.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 System.Address; - pragma Import (C, new_fl_output, "new_fl_output"); - pragma Inline (new_fl_output); - - procedure free_fl_output - (F : in System.Address); - pragma Import (C, free_fl_output, "free_fl_output"); - pragma Inline (free_fl_output); - - - - - procedure fl_output_draw - (W : in System.Address); - pragma Import (C, fl_output_draw, "fl_output_draw"); - pragma Inline (fl_output_draw); - - function fl_output_handle - (W : in System.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 Finalize - (This : in out Output) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Output'Class - then - free_fl_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - 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 f5135e8..0000000 --- a/src/fltk-widgets-inputs-outputs.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -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); - - - - - 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 d5a68b4..0000000 --- a/src/fltk-widgets-inputs-secret.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Inputs.Secret is - - - procedure secret_input_set_draw_hook - (W, D : in System.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 System.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 System.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 System.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 System.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 System.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 Finalize - (This : in out Secret_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Secret_Input'Class - then - free_fl_secret_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Input (This)); - end Finalize; - - - - - 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)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - secret_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - secret_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - 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 362bdc8..0000000 --- a/src/fltk-widgets-inputs-secret.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -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); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Secret; - diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb deleted file mode 100644 index 30334b8..0000000 --- a/src/fltk-widgets-inputs.adb +++ /dev/null @@ -1,732 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets.Inputs is - - - procedure input_set_draw_hook - (W, D : in System.Address); - pragma Import (C, input_set_draw_hook, "input_set_draw_hook"); - pragma Inline (input_set_draw_hook); - - procedure input_set_handle_hook - (W, H : in System.Address); - pragma Import (C, input_set_handle_hook, "input_set_handle_hook"); - pragma Inline (input_set_handle_hook); - - - - - function new_fl_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_input, "new_fl_input"); - pragma Inline (new_fl_input); - - procedure free_fl_input - (F : in System.Address); - pragma Import (C, free_fl_input, "free_fl_input"); - pragma Inline (free_fl_input); - - - - - function fl_input_copy - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_copy, "fl_input_copy"); - pragma Inline (fl_input_copy); - - function fl_input_cut - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_cut, "fl_input_cut"); - pragma Inline (fl_input_cut); - - function fl_input_cut2 - (I : in System.Address; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_cut2, "fl_input_cut2"); - pragma Inline (fl_input_cut2); - - function fl_input_cut3 - (I : in System.Address; - A, B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_cut3, "fl_input_cut3"); - pragma Inline (fl_input_cut3); - - function fl_input_copy_cuts - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_copy_cuts, "fl_input_copy_cuts"); - pragma Inline (fl_input_copy_cuts); - - function fl_input_undo - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_undo, "fl_input_undo"); - pragma Inline (fl_input_undo); - - - - - function fl_input_get_readonly - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_readonly, "fl_input_get_readonly"); - pragma Inline (fl_input_get_readonly); - - procedure fl_input_set_readonly - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_readonly, "fl_input_set_readonly"); - pragma Inline (fl_input_set_readonly); - - function fl_input_get_tab_nav - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_tab_nav, "fl_input_get_tab_nav"); - pragma Inline (fl_input_get_tab_nav); - - procedure fl_input_set_tab_nav - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_tab_nav, "fl_input_set_tab_nav"); - pragma Inline (fl_input_set_tab_nav); - - function fl_input_get_wrap - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_wrap, "fl_input_get_wrap"); - pragma Inline (fl_input_get_wrap); - - procedure fl_input_set_wrap - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_wrap, "fl_input_set_wrap"); - pragma Inline (fl_input_set_wrap); - - - - - function fl_input_get_input_type - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_input_type, "fl_input_get_input_type"); - pragma Inline (fl_input_get_input_type); - - procedure fl_input_set_input_type - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_input_type, "fl_input_set_input_type"); - pragma Inline (fl_input_set_input_type); - - function fl_input_get_shortcut - (I : in System.Address) - return Interfaces.C.unsigned_long; - pragma Import (C, fl_input_get_shortcut, "fl_input_get_shortcut"); - pragma Inline (fl_input_get_shortcut); - - procedure fl_input_set_shortcut - (I : in System.Address; - T : in Interfaces.C.unsigned_long); - pragma Import (C, fl_input_set_shortcut, "fl_input_set_shortcut"); - pragma Inline (fl_input_set_shortcut); - - function fl_input_get_mark - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_mark, "fl_input_get_mark"); - pragma Inline (fl_input_get_mark); - - function fl_input_set_mark - (I : in System.Address; - T : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_set_mark, "fl_input_set_mark"); - pragma Inline (fl_input_set_mark); - - function fl_input_get_position - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_position, "fl_input_get_position"); - pragma Inline (fl_input_get_position); - - function fl_input_set_position - (I : in System.Address; - T : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_set_position, "fl_input_set_position"); - pragma Inline (fl_input_set_position); - - - - - function fl_input_index - (I : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.unsigned; - pragma Import (C, fl_input_index, "fl_input_index"); - pragma Inline (fl_input_index); - - function fl_input_insert - (I : in System.Address; - S : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_insert, "fl_input_insert"); - pragma Inline (fl_input_insert); - - function fl_input_replace - (I : in System.Address; - B, E : in Interfaces.C.int; - S : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_replace, "fl_input_replace"); - pragma Inline (fl_input_replace); - - procedure fl_input_set_value - (I : in System.Address; - T : in Interfaces.C.char_array; - L : in Interfaces.C.int); - pragma Import (C, fl_input_set_value, "fl_input_set_value"); - pragma Inline (fl_input_set_value); - - - - - function fl_input_get_maximum_size - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_maximum_size, "fl_input_get_maximum_size"); - pragma Inline (fl_input_get_maximum_size); - - procedure fl_input_set_maximum_size - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_maximum_size, "fl_input_set_maximum_size"); - pragma Inline (fl_input_set_maximum_size); - - function fl_input_get_size - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_size, "fl_input_get_size"); - pragma Inline (fl_input_get_size); - - - - - function fl_input_get_cursor_color - (I : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_input_get_cursor_color, "fl_input_get_cursor_color"); - pragma Inline (fl_input_get_cursor_color); - - procedure fl_input_set_cursor_color - (I : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_input_set_cursor_color, "fl_input_set_cursor_color"); - pragma Inline (fl_input_set_cursor_color); - - function fl_input_get_textcolor - (I : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_input_get_textcolor, "fl_input_get_textcolor"); - pragma Inline (fl_input_get_textcolor); - - procedure fl_input_set_textcolor - (I : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_input_set_textcolor, "fl_input_set_textcolor"); - pragma Inline (fl_input_set_textcolor); - - function fl_input_get_textfont - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_textfont, "fl_input_get_textfont"); - pragma Inline (fl_input_get_textfont); - - procedure fl_input_set_textfont - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_textfont, "fl_input_set_textfont"); - pragma Inline (fl_input_set_textfont); - - function fl_input_get_textsize - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_input_get_textsize, "fl_input_get_textsize"); - pragma Inline (fl_input_get_textsize); - - procedure fl_input_set_textsize - (I : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_input_set_textsize, "fl_input_set_textsize"); - pragma Inline (fl_input_set_textsize); - - - - - procedure fl_input_set_size - (I : in System.Address; - W, H : in Interfaces.C.int); - pragma Import (C, fl_input_set_size, "fl_input_set_size"); - pragma Inline (fl_input_set_size); - - - - - procedure fl_input_draw - (W : in System.Address); - pragma Import (C, fl_input_draw, "fl_input_draw"); - pragma Inline (fl_input_draw); - - function fl_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_handle, "fl_input_handle"); - pragma Inline (fl_input_handle); - - - - - procedure Finalize - (This : in out Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Input'Class - then - if This.Needs_Dealloc then - free_fl_input (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Input is - begin - return This : Input do - This.Void_Ptr := new_fl_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Copy - (This : in out Input) is - begin - This.Was_Changed := fl_input_copy (This.Void_Ptr) /= 0; - end Copy; - - - procedure Cut - (This : in out Input) is - begin - This.Was_Changed := fl_input_cut (This.Void_Ptr) /= 0; - end Cut; - - - procedure Cut - (This : in out Input; - Num_Bytes : in Integer) is - begin - This.Was_Changed := fl_input_cut2 - (This.Void_Ptr, - Interfaces.C.int (Num_Bytes)) /= 0; - end Cut; - - - procedure Cut - (This : in out Input; - Start, Finish : in Integer) is - begin - This.Was_Changed := fl_input_cut3 - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)) /= 0; - end Cut; - - - procedure Copy_Cuts - (This : in out Input) is - begin - This.Was_Changed := fl_input_copy_cuts (This.Void_Ptr) /= 0; - end Copy_Cuts; - - - procedure Undo - (This : in out Input) is - begin - This.Was_Changed := fl_input_undo (This.Void_Ptr) /= 0; - end Undo; - - - - - function Has_Changed - (This : in Input) - return Boolean is - begin - return This.Was_Changed; - end Has_Changed; - - - procedure Clear_Changed - (This : in out Input) is - begin - This.Was_Changed := False; - end Clear_Changed; - - - function Is_Readonly - (This : in Input) - return Boolean is - begin - return fl_input_get_readonly (This.Void_Ptr) /= 0; - end Is_Readonly; - - - procedure Set_Readonly - (This : in out Input; - To : in Boolean) is - begin - fl_input_set_readonly (This.Void_Ptr, Boolean'Pos (To)); - end Set_Readonly; - - - function Is_Tab_Nav - (This : in Input) - return Boolean is - begin - return fl_input_get_tab_nav (This.Void_Ptr) /= 0; - end Is_Tab_Nav; - - - procedure Set_Tab_Nav - (This : in out Input; - To : in Boolean) is - begin - fl_input_set_tab_nav (This.Void_Ptr, Boolean'Pos (To)); - end Set_Tab_Nav; - - - function Is_Wrap - (This : in Input) - return Boolean is - begin - return fl_input_get_wrap (This.Void_Ptr) /= 0; - end Is_Wrap; - - - procedure Set_Wrap - (This : in out Input; - To : in Boolean) is - begin - fl_input_set_wrap (This.Void_Ptr, Boolean'Pos (To)); - end Set_Wrap; - - - - - function Get_Input_Type - (This : in Input) - return Input_Kind - is - C_Val : Interfaces.C.int := fl_input_get_input_type (This.Void_Ptr); - begin - for V in Input_Kind loop - if Input_Kind_Values (V) = C_Val then - return V; - end if; - end loop; - return Normal_Kind; - end Get_Input_Type; - - - function Get_Shortcut_Key - (This : in Input) - return Key_Combo is - begin - return To_Ada (fl_input_get_shortcut (This.Void_Ptr)); - end Get_Shortcut_Key; - - - procedure Set_Shortcut_Key - (This : in out Input; - To : in Key_Combo) is - begin - fl_input_set_shortcut (This.Void_Ptr, To_C (To)); - end Set_Shortcut_Key; - - - function Get_Mark - (This : in Input) - return Natural is - begin - return Natural (fl_input_get_mark (This.Void_Ptr)); - end Get_Mark; - - - procedure Set_Mark - (This : in out Input; - To : in Natural) is - begin - This.Was_Changed := fl_input_set_mark - (This.Void_Ptr, Interfaces.C.int (To)) /= 0; - end Set_Mark; - - - function Get_Position - (This : in Input) - return Natural is - begin - return Natural (fl_input_get_position (This.Void_Ptr)); - end Get_Position; - - - procedure Set_Position - (This : in out Input; - To : in Natural) is - begin - This.Was_Changed := fl_input_set_position - (This.Void_Ptr, Interfaces.C.int (To)) /= 0; - end Set_Position; - - - - - function Index - (This : in Input; - Place : in Integer) - return Character is - begin - return Character'Val (fl_input_index (This.Void_Ptr, Interfaces.C.int (Place))); - end Index; - - - procedure Insert - (This : in out Input; - Str : in String) is - begin - This.Was_Changed := fl_input_insert - (This.Void_Ptr, - Interfaces.C.To_C (Str), - Str'Length) /= 0; - end Insert; - - - procedure Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String) is - begin - This.Was_Changed := fl_input_replace - (This.Void_Ptr, - Interfaces.C.int (From), - Interfaces.C.int (To), - Interfaces.C.To_C (New_Text), - New_Text'Length) /= 0; - end Replace; - - - function Get_Value - (This : in Input) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_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_input_set_value (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); - end Set_Value; - - - - - function Get_Maximum_Size - (This : in Input) - return Natural is - begin - return Natural (fl_input_get_maximum_size (This.Void_Ptr)); - end Get_Maximum_Size; - - - procedure Set_Maximum_Size - (This : in out Input; - To : in Natural) is - begin - fl_input_set_maximum_size (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Maximum_Size; - - - function Size - (This : in Input) - return Natural is - begin - return Natural (fl_input_get_size (This.Void_Ptr)); - end Size; - - - - - function Get_Cursor_Color - (This : in Input) - return Color is - begin - return Color (fl_input_get_cursor_color (This.Void_Ptr)); - end Get_Cursor_Color; - - - procedure Set_Cursor_Color - (This : in out Input; - To : in Color) is - begin - fl_input_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Cursor_Color; - - - function Get_Text_Color - (This : in Input) - return Color is - begin - return Color (fl_input_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Input; - To : in Color) is - begin - fl_input_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Input) - return Font_Kind is - begin - return Font_Kind'Val (fl_input_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Input; - To : in Font_Kind) is - begin - fl_input_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Input) - return Font_Size is - begin - return Font_Size (fl_input_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Input; - To : in Font_Size) is - begin - fl_input_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - procedure Resize - (This : in out Input; - W, H : in Integer) is - begin - fl_input_set_size (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)); - 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 - begin - return Event_Outcome'Val - (fl_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - - - - package body Extra is - - procedure Set_Input_Type - (This : in out Input; - To : in Input_Kind) is - begin - fl_input_set_input_type (This.Void_Ptr, Input_Kind_Values (To)); - end Set_Input_Type; - - pragma Inline (Set_Input_Type); - - end Extra; - - -end FLTK.Widgets.Inputs; - diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads deleted file mode 100644 index 46767cd..0000000 --- a/src/fltk-widgets-inputs.ads +++ /dev/null @@ -1,315 +0,0 @@ - - -private with - - Interfaces.C.Strings, - System; - - -package FLTK.Widgets.Inputs is - - - type Input is new Widget with private; - - type Input_Reference (Data : not null access Input'Class) is limited null record - with Implicit_Dereference => Data; - - type Input_Kind is - (Normal_Kind, Float_Kind, Integer_Kind, Multiline_Kind, - Secret_Kind, Readonly_Kind, Wrap_Kind); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Input; - - end Forge; - - - - - procedure Copy - (This : in out Input); - - procedure Cut - (This : in out Input); - - procedure Cut - (This : in out Input; - Num_Bytes : in Integer); - - procedure Cut - (This : in out Input; - Start, Finish : in Integer); - - procedure Copy_Cuts - (This : in out Input); - - procedure Undo - (This : in out Input); - - - - - function Has_Changed - (This : in Input) - return Boolean; - - procedure Clear_Changed - (This : in out Input); - - function Is_Readonly - (This : in Input) - return Boolean; - - procedure Set_Readonly - (This : in out Input; - To : in Boolean); - - function Is_Tab_Nav - (This : in Input) - return Boolean; - - procedure Set_Tab_Nav - (This : in out Input; - To : in Boolean); - - function Is_Wrap - (This : in Input) - return Boolean; - - procedure Set_Wrap - (This : in out Input; - To : in Boolean); - - - - - function Get_Input_Type - (This : in Input) - return Input_Kind; - - function Get_Shortcut_Key - (This : in Input) - return Key_Combo; - - procedure Set_Shortcut_Key - (This : in out Input; - To : in Key_Combo); - - function Get_Mark - (This : in Input) - return Natural; - - procedure Set_Mark - (This : in out Input; - To : in Natural); - - function Get_Position - (This : in Input) - return Natural; - - procedure Set_Position - (This : in out Input; - To : in Natural); - - - - - function Index - (This : in Input; - Place : in Integer) - return Character; - - procedure Insert - (This : in out Input; - Str : in String); - - procedure Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String); - - function Get_Value - (This : in Input) - return String; - - procedure Set_Value - (This : in out Input; - To : in String); - - - - - function Get_Maximum_Size - (This : in Input) - return Natural; - - procedure Set_Maximum_Size - (This : in out Input; - To : in Natural); - - function Size - (This : in Input) - return Natural; - - - - - function Get_Cursor_Color - (This : in Input) - return Color; - - procedure Set_Cursor_Color - (This : in out Input; - To : in Color); - - function Get_Text_Color - (This : in Input) - return Color; - - procedure Set_Text_Color - (This : in out Input; - To : in Color); - - function Get_Text_Font - (This : in Input) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Input; - To : in Font_Kind); - - function Get_Text_Size - (This : in Input) - return Font_Size; - - procedure Set_Text_Size - (This : in out Input; - To : in Font_Size); - - - - - procedure Resize - (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; - - - - - package Extra is - - procedure Set_Input_Type - (This : in out Input; - To : in Input_Kind); - - end Extra; - - -private - - - type Input is new Widget with record - Was_Changed : Boolean := False; - end record; - - overriding procedure Finalize - (This : in out Input); - - - - - pragma Inline (Copy); - pragma Inline (Cut); - 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); - pragma Inline (Set_Tab_Nav); - pragma Inline (Is_Wrap); - pragma Inline (Set_Wrap); - - - pragma Inline (Get_Input_Type); - pragma Inline (Get_Shortcut_Key); - pragma Inline (Set_Shortcut_Key); - pragma Inline (Get_Mark); - pragma Inline (Set_Mark); - pragma Inline (Get_Position); - pragma Inline (Set_Position); - - - pragma Inline (Index); - pragma Inline (Insert); - pragma Inline (Replace); - pragma Inline (Get_Value); - pragma Inline (Set_Value); - - - pragma Inline (Get_Maximum_Size); - pragma Inline (Set_Maximum_Size); - pragma Inline (Size); - - - pragma Inline (Get_Cursor_Color); - pragma Inline (Set_Cursor_Color); - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Resize); - - - pragma Inline (Draw); - pragma Inline (Handle); - - - - - Input_Kind_Values : array (Input_Kind) of Interfaces.C.int := - (Normal_Kind => 0, - Float_Kind => 1, - Integer_Kind => 2, - Multiline_Kind => 4, - Secret_Kind => 5, - Readonly_Kind => 8, - Wrap_Kind => 16); - - - - - function fl_input_get_value - (F : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_input_get_value, "fl_input_get_value"); - pragma Inline (fl_input_get_value); - - -end FLTK.Widgets.Inputs; - diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb deleted file mode 100644 index 836f80f..0000000 --- a/src/fltk-widgets-menus-choices.adb +++ /dev/null @@ -1,183 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Menus.Choices is - - - procedure choice_set_draw_hook - (W, D : in System.Address); - pragma Import (C, choice_set_draw_hook, "choice_set_draw_hook"); - pragma Inline (choice_set_draw_hook); - - procedure choice_set_handle_hook - (W, H : in System.Address); - pragma Import (C, choice_set_handle_hook, "choice_set_handle_hook"); - pragma Inline (choice_set_handle_hook); - - - - - function new_fl_choice - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_choice, "new_fl_choice"); - pragma Inline (new_fl_choice); - - procedure free_fl_choice - (B : in System.Address); - pragma Import (C, free_fl_choice, "free_fl_choice"); - pragma Inline (free_fl_choice); - - - - - function fl_choice_value - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_choice_value, "fl_choice_value"); - pragma Inline (fl_choice_value); - - function fl_choice_set_value - (M : in System.Address; - I : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_choice_set_value, "fl_choice_set_value"); - pragma Inline (fl_choice_set_value); - - function fl_choice_set_value2 - (M, I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_choice_set_value2, "fl_choice_set_value2"); - pragma Inline (fl_choice_set_value2); - - - - - procedure fl_choice_draw - (W : in System.Address); - pragma Import (C, fl_choice_draw, "fl_choice_draw"); - pragma Inline (fl_choice_draw); - - function fl_choice_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_choice_handle, "fl_choice_handle"); - pragma Inline (fl_choice_handle); - - - - - procedure Finalize - (This : in out Choice) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Choice'Class - then - if This.Needs_Dealloc then - free_fl_choice (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Choice is - begin - return This : Choice do - This.Void_Ptr := new_fl_choice - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - choice_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - choice_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Chosen - (This : in Choice) - return FLTK.Menu_Items.Menu_Item_Reference is - begin - return (Data => This.My_Items.Element (This.Chosen_Index)); - end Chosen; - - - function Chosen_Index - (This : in Choice) - return Extended_Index is - begin - return Extended_Index (fl_choice_value (This.Void_Ptr) + 1); - end Chosen_Index; - - - procedure Set_Chosen - (This : in out Choice; - Place : in Index) - is - Ignore_Ret : Interfaces.C.int; - begin - Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1); - end Set_Chosen; - - - procedure Set_Chosen - (This : in out Choice; - Item : in FLTK.Menu_Items.Menu_Item) - is - Ignore_Ret : Interfaces.C.int; - begin - Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); - end Set_Chosen; - - - - - procedure Draw - (This : in out Choice) is - begin - fl_choice_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Choice; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_choice_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Menus.Choices; - diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads deleted file mode 100644 index 37ce4fc..0000000 --- a/src/fltk-widgets-menus-choices.ads +++ /dev/null @@ -1,75 +0,0 @@ - - -package FLTK.Widgets.Menus.Choices is - - - type Choice is new Menu with private; - - type Choice_Reference (Data : not null access Choice'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Choice; - - end Forge; - - - - - function Chosen - (This : in Choice) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Chosen_Index - (This : in Choice) - return Extended_Index; - - procedure Set_Chosen - (This : in out Choice; - Place : in Index); - - procedure Set_Chosen - (This : in out Choice; - Item : in FLTK.Menu_Items.Menu_Item); - - - - - procedure Draw - (This : in out Choice); - - function Handle - (This : in out Choice; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Choice is new Menu with null record; - - overriding procedure Finalize - (This : in out Choice); - - - - - pragma Inline (Chosen); - pragma Inline (Chosen_Index); - pragma Inline (Set_Chosen); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Menus.Choices; - diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb deleted file mode 100644 index 428d439..0000000 --- a/src/fltk-widgets-menus-menu_bars.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Menus.Menu_Bars is - - - procedure menu_bar_set_draw_hook - (W, D : in System.Address); - pragma Import (C, menu_bar_set_draw_hook, "menu_bar_set_draw_hook"); - pragma Inline (menu_bar_set_draw_hook); - - procedure menu_bar_set_handle_hook - (W, H : in System.Address); - pragma Import (C, menu_bar_set_handle_hook, "menu_bar_set_handle_hook"); - pragma Inline (menu_bar_set_handle_hook); - - - - - function new_fl_menu_bar - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar"); - pragma Inline (new_fl_menu_bar); - - procedure free_fl_menu_bar - (M : in System.Address); - pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); - pragma Inline (free_fl_menu_bar); - - - - - procedure fl_menu_bar_draw - (W : in System.Address); - pragma Import (C, fl_menu_bar_draw, "fl_menu_bar_draw"); - pragma Inline (fl_menu_bar_draw); - - function fl_menu_bar_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_bar_handle, "fl_menu_bar_handle"); - pragma Inline (fl_menu_bar_handle); - - - - - procedure Finalize - (This : in out Menu_Bar) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Menu_Bar'Class - then - free_fl_menu_bar (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Menu (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Bar is - begin - return This : Menu_Bar do - This.Void_Ptr := new_fl_menu_bar - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_bar_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_bar_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Menu_Bar) is - begin - fl_menu_bar_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Menu_Bar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_bar_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Menus.Menu_Bars; - diff --git a/src/fltk-widgets-menus-menu_bars.ads b/src/fltk-widgets-menus-menu_bars.ads deleted file mode 100644 index b4487e3..0000000 --- a/src/fltk-widgets-menus-menu_bars.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Menus.Menu_Bars is - - - type Menu_Bar is new Menu with private; - - type Menu_Bar_Reference (Data : not null access Menu_Bar'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Bar; - - end Forge; - - - - - procedure Draw - (This : in out Menu_Bar); - - function Handle - (This : in out Menu_Bar; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Menu_Bar is new Menu with null record; - - overriding procedure Finalize - (This : in out Menu_Bar); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Menus.Menu_Bars; - diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb deleted file mode 100644 index 890d847..0000000 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ /dev/null @@ -1,164 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Menus.Menu_Buttons is - - - procedure menu_button_set_draw_hook - (W, D : in System.Address); - pragma Import (C, menu_button_set_draw_hook, "menu_button_set_draw_hook"); - pragma Inline (menu_button_set_draw_hook); - - procedure menu_button_set_handle_hook - (W, H : in System.Address); - pragma Import (C, menu_button_set_handle_hook, "menu_button_set_handle_hook"); - pragma Inline (menu_button_set_handle_hook); - - - - - function new_fl_menu_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_button, "new_fl_menu_button"); - pragma Inline (new_fl_menu_button); - - procedure free_fl_menu_button - (M : in System.Address); - pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); - pragma Inline (free_fl_menu_button); - - - - - procedure fl_menu_button_type - (M : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); - pragma Inline (fl_menu_button_type); - - function fl_menu_button_popup - (M : in System.Address) - return System.Address; - pragma Import (C, fl_menu_button_popup, "fl_menu_button_popup"); - pragma Inline (fl_menu_button_popup); - - function fl_menu_find_index2 - (M, I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2"); - pragma Inline (fl_menu_find_index2); - - - - - procedure fl_menu_button_draw - (W : in System.Address); - pragma Import (C, fl_menu_button_draw, "fl_menu_button_draw"); - pragma Inline (fl_menu_button_draw); - - function fl_menu_button_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_button_handle, "fl_menu_button_handle"); - pragma Inline (fl_menu_button_handle); - - - - - procedure Finalize - (This : in out Menu_Button) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Menu_Button'Class - then - if This.Needs_Dealloc then - free_fl_menu_button (This.Void_Ptr); - end if; - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Menu (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Button is - begin - return This : Menu_Button do - This.Void_Ptr := new_fl_menu_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Set_Popup_Kind - (This : in out Menu_Button; - Pop : in Popup_Buttons) is - begin - fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop)); - end Set_Popup_Kind; - - - function Popup - (This : in out Menu_Button) - return Extended_Index - is - use type Interfaces.C.int; - Ptr : System.Address := fl_menu_button_popup (This.Void_Ptr); - begin - return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); - end Popup; - - - - - procedure Draw - (This : in out Menu_Button) is - begin - fl_menu_button_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Menu_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_menu_button_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Menus.Menu_Buttons; - diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads deleted file mode 100644 index bccb8f7..0000000 --- a/src/fltk-widgets-menus-menu_buttons.ads +++ /dev/null @@ -1,74 +0,0 @@ - - -with - - FLTK.Menu_Items; - - -package FLTK.Widgets.Menus.Menu_Buttons is - - - type Menu_Button is new Menu with private; - - type Menu_Button_Reference (Data : access Menu_Button'Class) is limited null record - with Implicit_Dereference => Data; - - -- signifies which mouse buttons cause the menu to appear - type Popup_Buttons is (No_Popup, Popup1, Popup2, Popup12, Popup3, Popup13, Popup23, Popup123); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu_Button; - - end Forge; - - - - - procedure Set_Popup_Kind - (This : in out Menu_Button; - Pop : in Popup_Buttons); - - function Popup - (This : in out Menu_Button) - return Extended_Index; - - - - - procedure Draw - (This : in out Menu_Button); - - function Handle - (This : in out Menu_Button; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Menu_Button is new Menu with null record; - - overriding procedure Finalize - (This : in out Menu_Button); - - - - - pragma Inline (Set_Popup_Kind); - pragma Inline (Popup); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Menus.Menu_Buttons; - diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb deleted file mode 100644 index d2bf2ff..0000000 --- a/src/fltk-widgets-menus.adb +++ /dev/null @@ -1,802 +0,0 @@ - - -with - - Interfaces.C.Strings, - Ada.Unchecked_Deallocation, - System; - -use type - - System.Address, - Interfaces.C.int, - Interfaces.C.unsigned_long, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Menus is - - - procedure menu_set_draw_hook - (W, D : in System.Address); - pragma Import (C, menu_set_draw_hook, "menu_set_draw_hook"); - pragma Inline (menu_set_draw_hook); - - procedure menu_set_handle_hook - (W, H : in System.Address); - pragma Import (C, menu_set_handle_hook, "menu_set_handle_hook"); - pragma Inline (menu_set_handle_hook); - - - - - function new_fl_menu - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu, "new_fl_menu"); - pragma Inline (new_fl_menu); - - procedure free_fl_menu - (F : in System.Address); - pragma Import (C, free_fl_menu, "free_fl_menu"); - pragma Inline (free_fl_menu); - - - - - function fl_menu_add - (M : in System.Address; - T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; - C, U : in System.Address; - F : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_menu_add, "fl_menu_add"); - pragma Inline (fl_menu_add); - - function fl_menu_insert - (M : in System.Address; - P : in Interfaces.C.int; - T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; - C, U : in System.Address; - F : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_menu_insert, "fl_menu_insert"); - pragma Inline (fl_menu_insert); - - procedure fl_menu_remove - (M : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_menu_remove, "fl_menu_remove"); - pragma Inline (fl_menu_remove); - - procedure fl_menu_clear - (M : in System.Address); - pragma Import (C, fl_menu_clear, "fl_menu_clear"); - pragma Inline (fl_menu_clear); - - - - - function fl_menu_get_item - (M : in System.Address; - I : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_menu_get_item, "fl_menu_get_item"); - pragma Inline (fl_menu_get_item); - - function fl_menu_find_item - (M : in System.Address; - T : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); - pragma Inline (fl_menu_find_item); - - function fl_menu_find_item2 - (M, C : in System.Address) - return System.Address; - pragma Import (C, fl_menu_find_item2, "fl_menu_find_item2"); - pragma Inline (fl_menu_find_item2); - - function fl_menu_find_index - (M : in System.Address; - T : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_menu_find_index, "fl_menu_find_index"); - pragma Inline (fl_menu_find_index); - - function fl_menu_find_index2 - (M, I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2"); - pragma Inline (fl_menu_find_index2); - - function fl_menu_find_index3 - (M, C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_find_index3, "fl_menu_find_index3"); - pragma Inline (fl_menu_find_index3); - - function fl_menu_size - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_size, "fl_menu_size"); - pragma Inline (fl_menu_size); - - - - - function fl_menu_mvalue - (M : in System.Address) - return System.Address; - pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); - pragma Inline (fl_menu_mvalue); - - function fl_menu_text - (M : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_menu_text, "fl_menu_text"); - pragma Inline (fl_menu_text); - - function fl_menu_value - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_value, "fl_menu_value"); - pragma Inline (fl_menu_value); - - function fl_menu_set_value - (M : in System.Address; - I : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_set_value, "fl_menu_set_value"); - pragma Inline (fl_menu_set_value); - - function fl_menu_set_value2 - (M, I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2"); - pragma Inline (fl_menu_set_value2); - - - - - function fl_menu_get_textcolor - (M : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_menu_get_textcolor, "fl_menu_get_textcolor"); - pragma Inline (fl_menu_get_textcolor); - - procedure fl_menu_set_textcolor - (M : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_menu_set_textcolor, "fl_menu_set_textcolor"); - pragma Inline (fl_menu_set_textcolor); - - function fl_menu_get_textfont - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_get_textfont, "fl_menu_get_textfont"); - pragma Inline (fl_menu_get_textfont); - - procedure fl_menu_set_textfont - (M : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_menu_set_textfont, "fl_menu_set_textfont"); - pragma Inline (fl_menu_set_textfont); - - function fl_menu_get_textsize - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_get_textsize, "fl_menu_get_textsize"); - pragma Inline (fl_menu_get_textsize); - - procedure fl_menu_set_textsize - (M : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_menu_set_textsize, "fl_menu_set_textsize"); - pragma Inline (fl_menu_set_textsize); - - - - - function fl_menu_get_down_box - (M : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menu_get_down_box, "fl_menu_get_down_box"); - pragma Inline (fl_menu_get_down_box); - - procedure fl_menu_set_down_box - (M : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_menu_set_down_box, "fl_menu_set_down_box"); - pragma Inline (fl_menu_set_down_box); - - procedure fl_menu_global - (M : in System.Address); - pragma Import (C, fl_menu_global, "fl_menu_global"); - pragma Inline (fl_menu_global); - - function fl_menu_measure - (M : in System.Address; - I : in Interfaces.C.int; - H : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_measure, "fl_menu_measure"); - pragma Inline (fl_menu_measure); - - - - - function fl_menu_popup - (M : in System.Address; - X, Y : in Interfaces.C.int; - T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_menu_popup, "fl_menu_popup"); - pragma Inline (fl_menu_popup); - - function fl_menu_pulldown - (M : in System.Address; - X, Y, W, H : in Interfaces.C.int; - N : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_menu_pulldown, "fl_menu_pulldown"); - pragma Inline (fl_menu_pulldown); - - - - - procedure fl_menu_draw_item - (M : in System.Address; - I : in Interfaces.C.int; - X, Y, W, H : in Interfaces.C.int; - S : in Interfaces.C.int); - pragma Import (C, fl_menu_draw_item, "fl_menu_draw_item"); - pragma Inline (fl_menu_draw_item); - - - - - procedure Item_Hook - (M, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); - Action : Widget_Callback := Callback_Convert.To_Pointer (U); - begin - Action.all (Ada_Widget.all); - end Item_Hook; - - - - - procedure Free_Item is new Ada.Unchecked_Deallocation - (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access); - - - - - procedure Finalize - (This : in out Menu) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Menu'Class - then - for Item of This.My_Items loop - Free_Item (Item); - end loop; - free_fl_menu (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu is - begin - return This : Menu do - This.Void_Ptr := new_fl_menu - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - This.My_Items := Item_Vectors.Empty_Vector; - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Add - (This : in out Menu; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal) - is - Ret_Place : Interfaces.C.int; - Callback, User_Data : System.Address := System.Null_Address; - begin - if Action /= null then - Callback := Item_Hook'Address; - User_Data := Callback_Convert.To_Address (Action); - end if; - Ret_Place := fl_menu_add - (This.Void_Ptr, - Interfaces.C.To_C (Text), - To_C (Shortcut), - Callback, - User_Data, - Interfaces.C.unsigned_long (Flags)); - This.My_Items.Append (new FLTK.Menu_Items.Menu_Item); - Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False; - if Flags + Flag_Submenu = Flags then - This.My_Items.Append (new FLTK.Menu_Items.Menu_Item); - Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False; - end if; - end Add; - - - procedure Insert - (This : in out Menu; - Place : in Index; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal) - is - Ret_Place : Interfaces.C.int; - Callback, User_Data : System.Address := System.Null_Address; - begin - if Action /= null then - Callback := Item_Hook'Address; - User_Data := Callback_Convert.To_Address (Action); - end if; - Ret_Place := fl_menu_insert - (This.Void_Ptr, - Interfaces.C.int (Place) - 1, - Interfaces.C.To_C (Text), - To_C (Shortcut), - Callback, - User_Data, - Interfaces.C.unsigned_long (Flags)); - This.My_Items.Append (new FLTK.Menu_Items.Menu_Item); - Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False; - if Flags + Flag_Submenu = Flags then - This.My_Items.Append (new FLTK.Menu_Items.Menu_Item); - Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False; - end if; - end Insert; - - - procedure Remove - (This : in out Menu; - Place : in Index) is - begin - Free_Item (This.My_Items.Reference (Place)); - This.My_Items.Delete (Place); - fl_menu_remove (This.Void_Ptr, Interfaces.C.int (Place) - 1); - end Remove; - - - procedure Clear - (This : in out Menu) is - begin - for Item of This.My_Items loop - Free_Item (Item); - end loop; - This.My_Items.Clear; - fl_menu_clear (This.Void_Ptr); - end Clear; - - - - - function Has_Item - (This : in Menu; - Place : in Index) - return Boolean is - begin - return Place in 1 .. This.Number_Of_Items; - end Has_Item; - - - function Has_Item - (Place : in Cursor) - return Boolean is - begin - return Place.My_Container.Has_Item (Place.My_Index); - end Has_Item; - - - function Item - (This : in Menu; - Place : in Index) - return FLTK.Menu_Items.Menu_Item_Reference is - begin - Wrapper (This.My_Items (Place).all).Void_Ptr := - fl_menu_get_item (This.Void_Ptr, Interfaces.C.int (Place) - 1); - return R : FLTK.Menu_Items.Menu_Item_Reference := (Data => This.My_Items (Place)) do - null; - end return; - end Item; - - - function Item - (This : in Menu; - Place : in Cursor) - return FLTK.Menu_Items.Menu_Item_Reference is - begin - return This.Item (Place.My_Index); - end Item; - - - function Find_Item - (This : in Menu; - Name : in String) - return FLTK.Menu_Items.Menu_Item_Reference - is - Place : Extended_Index := This.Find_Index (Name); - begin - if Place = No_Index then - raise No_Reference; - end if; - Wrapper (This.My_Items (Place).all).Void_Ptr := - fl_menu_find_item (This.Void_Ptr, Interfaces.C.To_C (Name)); - return R : FLTK.Menu_Items.Menu_Item_Reference := (Data => This.My_Items (Place)) do - null; - end return; - end Find_Item; - - - function Find_Item - (This : in Menu; - Action : in Widget_Callback) - return FLTK.Menu_Items.Menu_Item_Reference - is - Place : Extended_Index := This.Find_Index (Action); - begin - if Place = No_Index then - raise No_Reference; - end if; - Wrapper (This.My_Items (Place).all).Void_Ptr := - fl_menu_find_item2 (This.Void_Ptr, Callback_Convert.To_Address (Action)); - return R : FLTK.Menu_Items.Menu_Item_Reference := (Data => This.My_Items (Place)) do - null; - end return; - end Find_Item; - - - function Find_Index - (This : in Menu; - Name : in String) - return Extended_Index - is - Ret : Interfaces.C.int; - begin - Ret := fl_menu_find_index (This.Void_Ptr, Interfaces.C.To_C (Name)); - return Extended_Index (Ret + 1); - end Find_Index; - - - function Find_Index - (This : in Menu; - Item : in FLTK.Menu_Items.Menu_Item) - return Extended_Index - is - Ret : Interfaces.C.int; - begin - Ret := fl_menu_find_index2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); - return Extended_Index (Ret + 1); - end Find_Index; - - - function Find_Index - (This : in Menu; - Action : in Widget_Callback) - return Extended_Index - is - Ret : Interfaces.C.int; - begin - Ret := fl_menu_find_index3 - (This.Void_Ptr, - Callback_Convert.To_Address (Action)); - return Extended_Index (Ret + 1); - end Find_Index; - - - function Number_Of_Items - (This : in Menu) - return Natural is - begin - return Natural (fl_menu_size (This.Void_Ptr)); - end Number_Of_Items; - - - - - function Iterate - (This : in Menu) - return Menu_Iterators.Reversible_Iterator'Class is - begin - return It : Iterator := (My_Container => This'Unrestricted_Access); - end Iterate; - - - function First - (Object : in Iterator) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Object.My_Container, - My_Index => 1); - end First; - - - function Next - (Object : in Iterator; - Place : in Cursor) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Place.My_Container, - My_Index => Place.My_Index + 1); - end Next; - - - function Last - (Object : in Iterator) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Object.My_Container, - My_Index => Object.My_Container.Number_Of_Items); - end Last; - - - function Previous - (Object : in Iterator; - Place : in Cursor) - return Cursor is - begin - return Cu : Cursor := - (My_Container => Place.My_Container, - My_Index => Place.My_Index - 1); - end Previous; - - - - - function Chosen - (This : in Menu) - return FLTK.Menu_Items.Menu_Item_Reference - is - Place : Extended_Index := This.Chosen_Index; - begin - if Place = No_Index then - raise No_Reference; - end if; - Wrapper (This.My_Items (Place).all).Void_Ptr := fl_menu_mvalue (This.Void_Ptr); - return R : FLTK.Menu_Items.Menu_Item_Reference := (Data => This.My_Items (Place)) do - null; - end return; - end Chosen; - - - function Chosen_Label - (This : in Menu) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_text (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - -- no dealloc required? - return Interfaces.C.Strings.Value (Ptr); - end if; - end Chosen_Label; - - - function Chosen_Index - (This : in Menu) - return Extended_Index is - begin - return Extended_Index (fl_menu_value (This.Void_Ptr) + 1); - end Chosen_Index; - - - procedure Set_Chosen - (This : in out Menu; - Place : in Index) - is - Ignore_Ret : Interfaces.C.int; - begin - Ignore_Ret := fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1); - end Set_Chosen; - - - procedure Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item) - is - Ignore_Ret : Interfaces.C.int; - begin - Ignore_Ret := fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); - end Set_Chosen; - - - - - function Get_Text_Color - (This : in Menu) - return Color is - begin - return Color (fl_menu_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Menu; - To : in Color) is - begin - fl_menu_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Menu) - return Font_Kind is - begin - return Font_Kind'Val (fl_menu_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Menu; - To : in Font_Kind) is - begin - fl_menu_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Menu) - return Font_Size is - begin - return Font_Size (fl_menu_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Menu; - To : in Font_Size) is - begin - fl_menu_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - function Get_Down_Box - (This : in Menu) - return Box_Kind is - begin - return Box_Kind'Val (fl_menu_get_down_box (This.Void_Ptr)); - end Get_Down_Box; - - - procedure Set_Down_Box - (This : in out Menu; - To : in Box_Kind) is - begin - fl_menu_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Down_Box; - - - procedure Make_Global - (This : in out Menu) is - begin - fl_menu_global (This.Void_Ptr); - end Make_Global; - - - procedure Measure_Item - (This : in Menu; - Item : in Index; - W, H : out Integer) is - begin - W := Integer (fl_menu_measure - (This.Void_Ptr, - Interfaces.C.int (Item) - 1, - Interfaces.C.int (H))); - end Measure_Item; - - - - - function Popup - (This : in Menu; - X, Y : in Integer; - Title : in String := ""; - Initial : in Extended_Index := No_Index) - return Extended_Index - is - Ptr : System.Address := fl_menu_popup - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.To_C (Title), - Interfaces.C.int (Initial) - 1); - begin - return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); - end Popup; - - - function Pulldown - (This : in Menu; - X, Y, W, H : in Integer; - Initial : in Extended_Index := No_Index) - return Extended_Index - is - Ptr : System.Address := fl_menu_pulldown - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Initial) - 1); - begin - return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); - end Pulldown; - - - - - procedure Draw_Item - (This : in out Menu; - Item : in Index; - X, Y, W, H : in Integer; - Selected : in Boolean := False) is - begin - fl_menu_draw_item - (This.Void_Ptr, - Interfaces.C.int (Item) - 1, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Boolean'Pos (Selected)); - end Draw_Item; - - - function Handle - (This : in out Menu; - Event : in Event_Kind) - return Event_Outcome is - begin - return Not_Handled; - end Handle; - - -end FLTK.Widgets.Menus; - diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads deleted file mode 100644 index 7eb56d2..0000000 --- a/src/fltk-widgets-menus.ads +++ /dev/null @@ -1,335 +0,0 @@ - - -with - - FLTK.Menu_Items, - Ada.Iterator_Interfaces; - -private with - - Ada.Containers.Vectors, - Interfaces, - System; - - -package FLTK.Widgets.Menus is - - - type Menu is new Widget with private - with Default_Iterator => Iterate, - Iterator_Element => FLTK.Menu_Items.Menu_Item_Reference, - Variable_Indexing => Item; - - type Menu_Reference (Data : not null access Menu'Class) is limited null record - with Implicit_Dereference => Data; - - subtype Index is Positive; - subtype Extended_Index is Natural; - - No_Index : constant Extended_Index := Extended_Index'First; - No_Reference : exception; - - type Cursor is private; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Menu; - - end Forge; - - - - - procedure Add - (This : in out Menu; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal); - - procedure Insert - (This : in out Menu; - Place : in Index; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Key_Combo := No_Key; - Flags : in Menu_Flag := Flag_Normal); - - procedure Remove - (This : in out Menu; - Place : in Index); - - procedure Clear - (This : in out Menu); - - - - - function Has_Item - (This : in Menu; - Place : in Index) - return Boolean; - - function Has_Item - (Place : in Cursor) - return Boolean; - - function Item - (This : in Menu; - Place : in Index) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Item - (This : in Menu; - Place : in Cursor) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Find_Item - (This : in Menu; - Name : in String) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Find_Item - (This : in Menu; - Action : in Widget_Callback) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Find_Index - (This : in Menu; - Name : in String) - return Extended_Index; - - function Find_Index - (This : in Menu; - Item : in FLTK.Menu_Items.Menu_Item) - return Extended_Index; - - function Find_Index - (This : in Menu; - Action : in Widget_Callback) - return Extended_Index; - - function Number_Of_Items - (This : in Menu) - return Natural; - - - - - package Menu_Iterators is - new Ada.Iterator_Interfaces (Cursor, Has_Item); - - function Iterate - (This : in Menu) - return Menu_Iterators.Reversible_Iterator'Class; - - - - - function Chosen - (This : in Menu) - return FLTK.Menu_Items.Menu_Item_Reference; - - function Chosen_Label - (This : in Menu) - return String; - - function Chosen_Index - (This : in Menu) - return Extended_Index; - - procedure Set_Chosen - (This : in out Menu; - Place : in Index); - - procedure Set_Chosen - (This : in out Menu; - Item : in FLTK.Menu_Items.Menu_Item); - - - - - function Get_Text_Color - (This : in Menu) - return Color; - - procedure Set_Text_Color - (This : in out Menu; - To : in Color); - - function Get_Text_Font - (This : in Menu) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Menu; - To : in Font_Kind); - - function Get_Text_Size - (This : in Menu) - return Font_Size; - - procedure Set_Text_Size - (This : in out Menu; - To : in Font_Size); - - - - - function Get_Down_Box - (This : in Menu) - return Box_Kind; - - procedure Set_Down_Box - (This : in out Menu; - To : in Box_Kind); - - procedure Make_Global - (This : in out Menu); - - procedure Measure_Item - (This : in Menu; - Item : in Index; - W, H : out Integer); - - - - - function Popup - (This : in Menu; - X, Y : in Integer; - Title : in String := ""; - Initial : in Extended_Index := No_Index) - return Extended_Index; - - function Pulldown - (This : in Menu; - X, Y, W, H : in Integer; - Initial : in Extended_Index := No_Index) - return Extended_Index; - - - - - procedure Draw - (This : in out Menu) is null; - - procedure Draw_Item - (This : in out Menu; - Item : in Index; - X, Y, W, H : in Integer; - Selected : in Boolean := False); - - function Handle - (This : in out Menu; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - -- I'm not very happy with using a Vector of dynamically allocated - -- Menu_Item wrappers like this, but I kinda painted myself into a - -- corner with use of Limited_Controlled and the way the Add method - -- works for Menus. - - type Item_Access is access FLTK.Menu_Items.Menu_Item; - - package Item_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Item_Access); - - type Menu is new Widget with record - My_Items : Item_Vectors.Vector; - end record; - - overriding procedure Finalize - (This : in out Menu); - - - - - procedure Item_Hook (M, U : in System.Address); - pragma Convention (C, Item_Hook); - - - - - type Cursor is record - My_Container : access Menu; - My_Index : Index'Base := Index'First; - end record; - - type Iterator is new Menu_Iterators.Reversible_Iterator with record - My_Container : access Menu; - end record; - - overriding function First - (Object : in Iterator) - return Cursor; - - overriding function Next - (Object : in Iterator; - Place : in Cursor) - return Cursor; - - overriding function Last - (Object : in Iterator) - return Cursor; - - overriding function Previous - (Object : in Iterator; - Place : in Cursor) - return Cursor; - - - - - pragma Inline (Has_Item); - pragma Inline (Item); - pragma Inline (Find_Item); - pragma Inline (Find_Index); - pragma Inline (Number_Of_Items); - - - pragma Inline (Iterate); - - - pragma Inline (Chosen); - pragma Inline (Chosen_Label); - pragma Inline (Chosen_Index); - pragma Inline (Set_Chosen); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Get_Down_Box); - pragma Inline (Set_Down_Box); - pragma Inline (Make_Global); - pragma Inline (Measure_Item); - - - pragma Inline (Popup); - pragma Inline (Pulldown); - - - pragma Inline (Draw); - pragma Inline (Draw_Item); - pragma Inline (Handle); - - -end FLTK.Widgets.Menus; - diff --git a/src/fltk-widgets-progress_bars.adb b/src/fltk-widgets-progress_bars.adb deleted file mode 100644 index 387ff36..0000000 --- a/src/fltk-widgets-progress_bars.adb +++ /dev/null @@ -1,210 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Progress_Bars is - - - procedure progress_set_draw_hook - (W, D : in System.Address); - pragma Import (C, progress_set_draw_hook, "progress_set_draw_hook"); - pragma Inline (progress_set_draw_hook); - - procedure progress_set_handle_hook - (W, H : in System.Address); - pragma Import (C, progress_set_handle_hook, "progress_set_handle_hook"); - pragma Inline (progress_set_handle_hook); - - - - - function new_fl_progress - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_progress, "new_fl_progress"); - pragma Inline (new_fl_progress); - - procedure free_fl_progress - (P : in System.Address); - pragma Import (C, free_fl_progress, "free_fl_progress"); - pragma Inline (free_fl_progress); - - - - - function fl_progress_get_minimum - (P : in System.Address) - return Interfaces.C.C_float; - pragma Import (C, fl_progress_get_minimum, "fl_progress_get_minimum"); - pragma Inline (fl_progress_get_minimum); - - procedure fl_progress_set_minimum - (P : in System.Address; - T : in Interfaces.C.C_float); - pragma Import (C, fl_progress_set_minimum, "fl_progress_set_minimum"); - pragma Inline (fl_progress_set_minimum); - - function fl_progress_get_maximum - (P : in System.Address) - return Interfaces.C.C_float; - pragma Import (C, fl_progress_get_maximum, "fl_progress_get_maximum"); - pragma Inline (fl_progress_get_maximum); - - procedure fl_progress_set_maximum - (P : in System.Address; - T : in Interfaces.C.C_float); - pragma Import (C, fl_progress_set_maximum, "fl_progress_set_maximum"); - pragma Inline (fl_progress_set_maximum); - - function fl_progress_get_value - (P : in System.Address) - return Interfaces.C.C_float; - pragma Import (C, fl_progress_get_value, "fl_progress_get_value"); - pragma Inline (fl_progress_get_value); - - procedure fl_progress_set_value - (P : in System.Address; - T : in Interfaces.C.C_float); - pragma Import (C, fl_progress_set_value, "fl_progress_set_value"); - pragma Inline (fl_progress_set_value); - - - - - procedure fl_progress_draw - (P : in System.Address); - pragma Import (C, fl_progress_draw, "fl_progress_draw"); - pragma Inline (fl_progress_draw); - - function fl_progress_handle - (P : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_progress_handle, "fl_progress_handle"); - pragma Inline (fl_progress_handle); - - - - - procedure Finalize - (This : in out Progress_Bar) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Progress_Bar'Class - then - free_fl_progress (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Progress_Bar is - begin - return This : Progress_Bar do - This.Void_Ptr := new_fl_progress - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - progress_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - progress_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - - function Get_Minimum - (This : in Progress_Bar) - return Float is - begin - return Float (fl_progress_get_minimum (This.Void_Ptr)); - end Get_Minimum; - - - procedure Set_Minimum - (This : in out Progress_Bar; - To : in Float) is - begin - fl_progress_set_minimum (This.Void_Ptr, Interfaces.C.C_float (To)); - end Set_Minimum; - - - function Get_Maximum - (This : in Progress_Bar) - return Float is - begin - return Float (fl_progress_get_maximum (This.Void_Ptr)); - end Get_Maximum; - - - procedure Set_Maximum - (This : in out Progress_Bar; - To : in Float) is - begin - fl_progress_set_maximum (This.Void_Ptr, Interfaces.C.C_float (To)); - end Set_Maximum; - - - function Get_Value - (This : in Progress_Bar) - return Float is - begin - return Float (fl_progress_get_value (This.Void_Ptr)); - end Get_Value; - - - procedure Set_Value - (This : in out Progress_Bar; - To : in Float) is - begin - fl_progress_set_value (This.Void_Ptr, Interfaces.C.C_float (To)); - end Set_Value; - - - - - procedure Draw - (This : in out Progress_Bar) is - begin - fl_progress_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Progress_Bar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_progress_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Progress_Bars; - diff --git a/src/fltk-widgets-progress_bars.ads b/src/fltk-widgets-progress_bars.ads deleted file mode 100644 index 6aaf6e9..0000000 --- a/src/fltk-widgets-progress_bars.ads +++ /dev/null @@ -1,86 +0,0 @@ - - -package FLTK.Widgets.Progress_Bars is - - - type Progress_Bar is new Widget with private; - - type Progress_Bar_Reference (Data : not null access Progress_Bar'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Progress_Bar; - - end Forge; - - - - - function Get_Minimum - (This : in Progress_Bar) - return Float; - - procedure Set_Minimum - (This : in out Progress_Bar; - To : in Float); - - function Get_Maximum - (This : in Progress_Bar) - return Float; - - procedure Set_Maximum - (This : in out Progress_Bar; - To : in Float); - - function Get_Value - (This : in Progress_Bar) - return Float; - - procedure Set_Value - (This : in out Progress_Bar; - To : in Float); - - - - - procedure Draw - (This : in out Progress_Bar); - - function Handle - (This : in out Progress_Bar; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Progress_Bar is new Widget with null record; - - overriding procedure Finalize - (This : in out Progress_Bar); - - - - - pragma Inline (Get_Minimum); - pragma Inline (Set_Minimum); - pragma Inline (Get_Maximum); - pragma Inline (Set_Maximum); - pragma Inline (Get_Value); - pragma Inline (Set_Value); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Progress_Bars; - diff --git a/src/fltk-widgets-valuators-adjusters.adb b/src/fltk-widgets-valuators-adjusters.adb deleted file mode 100644 index 078a840..0000000 --- a/src/fltk-widgets-valuators-adjusters.adb +++ /dev/null @@ -1,154 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Valuators.Adjusters is - - - procedure adjuster_set_draw_hook - (W, D : in System.Address); - pragma Import (C, adjuster_set_draw_hook, "adjuster_set_draw_hook"); - pragma Inline (adjuster_set_draw_hook); - - procedure adjuster_set_handle_hook - (W, H : in System.Address); - pragma Import (C, adjuster_set_handle_hook, "adjuster_set_handle_hook"); - pragma Inline (adjuster_set_handle_hook); - - - - - function new_fl_adjuster - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_adjuster, "new_fl_adjuster"); - pragma Inline (new_fl_adjuster); - - procedure free_fl_adjuster - (A : in System.Address); - pragma Import (C, free_fl_adjuster, "free_fl_adjuster"); - pragma Inline (free_fl_adjuster); - - - - - function fl_adjuster_is_soft - (A : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_adjuster_is_soft, "fl_adjuster_is_soft"); - pragma Inline (fl_adjuster_is_soft); - - procedure fl_adjuster_set_soft - (A : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_adjuster_set_soft, "fl_adjuster_set_soft"); - pragma Inline (fl_adjuster_set_soft); - - - - - procedure fl_adjuster_draw - (W : in System.Address); - pragma Import (C, fl_adjuster_draw, "fl_adjuster_draw"); - pragma Inline (fl_adjuster_draw); - - function fl_adjuster_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_adjuster_handle, "fl_adjuster_handle"); - pragma Inline (fl_adjuster_handle); - - - - - procedure Finalize - (This : in out Adjuster) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Adjuster'Class - then - free_fl_adjuster (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Adjuster is - begin - return This : Adjuster do - This.Void_Ptr := new_fl_adjuster - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - adjuster_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - adjuster_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Is_Soft - (This : in Adjuster) - return Boolean is - begin - return fl_adjuster_is_soft (This.Void_Ptr) /= 0; - end Is_Soft; - - - procedure Set_Soft - (This : in out Adjuster; - To : in Boolean) is - begin - fl_adjuster_set_soft (This.Void_Ptr, Boolean'Pos (To)); - end Set_Soft; - - - - - procedure Draw - (This : in out Adjuster) is - begin - fl_adjuster_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Adjuster; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_adjuster_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Adjusters; - diff --git a/src/fltk-widgets-valuators-adjusters.ads b/src/fltk-widgets-valuators-adjusters.ads deleted file mode 100644 index bb17571..0000000 --- a/src/fltk-widgets-valuators-adjusters.ads +++ /dev/null @@ -1,66 +0,0 @@ - - -package FLTK.Widgets.Valuators.Adjusters is - - - type Adjuster is new Valuator with private; - - type Adjuster_Reference (Data : not null access Adjuster'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Adjuster; - - end Forge; - - - - - function Is_Soft - (This : in Adjuster) - return Boolean; - - procedure Set_Soft - (This : in out Adjuster; - To : in Boolean); - - - - - procedure Draw - (This : in out Adjuster); - - function Handle - (This : in out Adjuster; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Adjuster is new Valuator with null record; - - overriding procedure Finalize - (This : in out Adjuster); - - - - - pragma Inline (Is_Soft); - pragma Inline (Set_Soft); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Adjusters; - diff --git a/src/fltk-widgets-valuators-counters-simple.adb b/src/fltk-widgets-valuators-counters-simple.adb deleted file mode 100644 index b0c3741..0000000 --- a/src/fltk-widgets-valuators-counters-simple.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Counters.Simple is - - - procedure simple_counter_set_draw_hook - (W, D : in System.Address); - pragma Import (C, simple_counter_set_draw_hook, "simple_counter_set_draw_hook"); - pragma Inline (simple_counter_set_draw_hook); - - procedure simple_counter_set_handle_hook - (W, H : in System.Address); - pragma Import (C, simple_counter_set_handle_hook, "simple_counter_set_handle_hook"); - pragma Inline (simple_counter_set_handle_hook); - - - - - function new_fl_simple_counter - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_simple_counter, "new_fl_simple_counter"); - pragma Inline (new_fl_simple_counter); - - procedure free_fl_simple_counter - (A : in System.Address); - pragma Import (C, free_fl_simple_counter, "free_fl_simple_counter"); - pragma Inline (free_fl_simple_counter); - - - - - procedure fl_simple_counter_draw - (W : in System.Address); - pragma Import (C, fl_simple_counter_draw, "fl_simple_counter_draw"); - pragma Inline (fl_simple_counter_draw); - - function fl_simple_counter_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_simple_counter_handle, "fl_simple_counter_handle"); - pragma Inline (fl_simple_counter_handle); - - - - - procedure Finalize - (This : in out Simple_Counter) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Simple_Counter'Class - then - free_fl_simple_counter (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Counter (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Simple_Counter is - begin - return This : Simple_Counter do - This.Void_Ptr := new_fl_simple_counter - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - simple_counter_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - simple_counter_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Simple_Counter) is - begin - fl_simple_counter_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Simple_Counter; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_simple_counter_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Counters.Simple; - diff --git a/src/fltk-widgets-valuators-counters-simple.ads b/src/fltk-widgets-valuators-counters-simple.ads deleted file mode 100644 index ca82a99..0000000 --- a/src/fltk-widgets-valuators-counters-simple.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Counters.Simple is - - - type Simple_Counter is new Counter with private; - - type Simple_Counter_Reference (Data : not null access Simple_Counter'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Simple_Counter; - - end Forge; - - - - - procedure Draw - (This : in out Simple_Counter); - - function Handle - (This : in out Simple_Counter; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Simple_Counter is new Counter with null record; - - overriding procedure Finalize - (This : in out Simple_Counter); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Counters.Simple; - diff --git a/src/fltk-widgets-valuators-counters.adb b/src/fltk-widgets-valuators-counters.adb deleted file mode 100644 index 6cda6d1..0000000 --- a/src/fltk-widgets-valuators-counters.adb +++ /dev/null @@ -1,265 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Counters is - - - procedure counter_set_draw_hook - (W, D : in System.Address); - pragma Import (C, counter_set_draw_hook, "counter_set_draw_hook"); - pragma Inline (counter_set_draw_hook); - - procedure counter_set_handle_hook - (W, H : in System.Address); - pragma Import (C, counter_set_handle_hook, "counter_set_handle_hook"); - pragma Inline (counter_set_handle_hook); - - - - - function new_fl_counter - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_counter, "new_fl_counter"); - pragma Inline (new_fl_counter); - - procedure free_fl_counter - (A : in System.Address); - pragma Import (C, free_fl_counter, "free_fl_counter"); - pragma Inline (free_fl_counter); - - - - - function fl_counter_get_step - (C : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_counter_get_step, "fl_counter_get_step"); - pragma Inline (fl_counter_get_step); - - procedure fl_counter_set_step - (C : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_counter_set_step, "fl_counter_set_step"); - pragma Inline (fl_counter_set_step); - - procedure fl_counter_set_lstep - (C : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_counter_set_lstep, "fl_counter_set_lstep"); - pragma Inline (fl_counter_set_lstep); - - - - - function fl_counter_get_textcolor - (C : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_counter_get_textcolor, "fl_counter_get_textcolor"); - pragma Inline (fl_counter_get_textcolor); - - procedure fl_counter_set_textcolor - (C : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_counter_set_textcolor, "fl_counter_set_textcolor"); - pragma Inline (fl_counter_set_textcolor); - - function fl_counter_get_textfont - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_counter_get_textfont, "fl_counter_get_textfont"); - pragma Inline (fl_counter_get_textfont); - - procedure fl_counter_set_textfont - (C : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_counter_set_textfont, "fl_counter_set_textfont"); - pragma Inline (fl_counter_set_textfont); - - function fl_counter_get_textsize - (C : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_counter_get_textsize, "fl_counter_get_textsize"); - pragma Inline (fl_counter_get_textsize); - - procedure fl_counter_set_textsize - (C : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_counter_set_textsize, "fl_counter_set_textsize"); - pragma Inline (fl_counter_set_textsize); - - - - - procedure fl_counter_draw - (W : in System.Address); - pragma Import (C, fl_counter_draw, "fl_counter_draw"); - pragma Inline (fl_counter_draw); - - function fl_counter_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_counter_handle, "fl_counter_handle"); - pragma Inline (fl_counter_handle); - - - - - procedure Finalize - (This : in out Counter) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Counter'Class - then - free_fl_counter (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Counter is - begin - return This : Counter do - This.Void_Ptr := new_fl_counter - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - counter_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - counter_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Step - (This : in Counter) - return Long_Float is - begin - return Long_Float (fl_counter_get_step (This.Void_Ptr)); - end Get_Step; - - - procedure Set_Step - (This : in out Counter; - To : in Long_Float) is - begin - fl_counter_set_step (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Step; - - - function Get_Long_Step - (This : in Counter) - return Long_Float is - begin - return This.Long_Step; - end Get_Long_Step; - - - procedure Set_Long_Step - (This : in out Counter; - To : in Long_Float) is - begin - This.Long_Step := To; - fl_counter_set_lstep (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Long_Step; - - - - - function Get_Text_Color - (This : in Counter) - return Color is - begin - return Color (fl_counter_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Counter; - To : in Color) is - begin - fl_counter_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Counter) - return Font_Kind is - begin - return Font_Kind'Val (fl_counter_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Counter; - To : in Font_Kind) is - begin - fl_counter_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Counter) - return Font_Size is - begin - return Font_Size (fl_counter_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Counter; - To : in Font_Size) is - begin - fl_counter_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - procedure Draw - (This : in out Counter) is - begin - fl_counter_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Counter; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_counter_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Counters; - diff --git a/src/fltk-widgets-valuators-counters.ads b/src/fltk-widgets-valuators-counters.ads deleted file mode 100644 index 0bd52b5..0000000 --- a/src/fltk-widgets-valuators-counters.ads +++ /dev/null @@ -1,115 +0,0 @@ - - -package FLTK.Widgets.Valuators.Counters is - - - type Counter is new Valuator with private; - - type Counter_Reference (Data : not null access Counter'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Counter; - - end Forge; - - - - - function Get_Step - (This : in Counter) - return Long_Float; - - procedure Set_Step - (This : in out Counter; - To : in Long_Float); - - function Get_Long_Step - (This : in Counter) - return Long_Float; - - procedure Set_Long_Step - (This : in out Counter; - To : in Long_Float); - - - - - function Get_Text_Color - (This : in Counter) - return Color; - - procedure Set_Text_Color - (This : in out Counter; - To : in Color); - - function Get_Text_Font - (This : in Counter) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Counter; - To : in Font_Kind); - - function Get_Text_Size - (This : in Counter) - return Font_Size; - - procedure Set_Text_Size - (This : in out Counter; - To : in Font_Size); - - - - - procedure Draw - (This : in out Counter); - - function Handle - (This : in out Counter; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Counter is new Valuator with record - -- Needed because Fl_Counter doesn't have - -- a way to retrieve this value otherwise. - Long_Step : Long_Float := 1.0; - end record; - - overriding procedure Finalize - (This : in out Counter); - - - - - pragma Inline (Get_Step); - pragma Inline (Set_Step); - pragma Inline (Get_Long_Step); - pragma Inline (Set_Long_Step); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Counters; - diff --git a/src/fltk-widgets-valuators-dials-fill.adb b/src/fltk-widgets-valuators-dials-fill.adb deleted file mode 100644 index 40460f4..0000000 --- a/src/fltk-widgets-valuators-dials-fill.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Dials.Fill is - - - procedure fill_dial_set_draw_hook - (W, D : in System.Address); - pragma Import (C, fill_dial_set_draw_hook, "fill_dial_set_draw_hook"); - pragma Inline (fill_dial_set_draw_hook); - - procedure fill_dial_set_handle_hook - (W, H : in System.Address); - pragma Import (C, fill_dial_set_handle_hook, "fill_dial_set_handle_hook"); - pragma Inline (fill_dial_set_handle_hook); - - - - - function new_fl_fill_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_fill_dial, "new_fl_fill_dial"); - pragma Inline (new_fl_fill_dial); - - procedure free_fl_fill_dial - (D : in System.Address); - pragma Import (C, free_fl_fill_dial, "free_fl_fill_dial"); - pragma Inline (free_fl_fill_dial); - - - - - procedure fl_fill_dial_draw - (W : in System.Address); - pragma Import (C, fl_fill_dial_draw, "fl_fill_dial_draw"); - pragma Inline (fl_fill_dial_draw); - - function fl_fill_dial_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_fill_dial_handle, "fl_fill_dial_handle"); - pragma Inline (fl_fill_dial_handle); - - - - - procedure Finalize - (This : in out Fill_Dial) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Fill_Dial'Class - then - free_fl_fill_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Dial (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Fill_Dial is - begin - return This : Fill_Dial do - This.Void_Ptr := new_fl_fill_dial - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - fill_dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - fill_dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Fill_Dial) is - begin - fl_fill_dial_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Fill_Dial; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_fill_dial_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Dials.Fill; - diff --git a/src/fltk-widgets-valuators-dials-fill.ads b/src/fltk-widgets-valuators-dials-fill.ads deleted file mode 100644 index a54f1a7..0000000 --- a/src/fltk-widgets-valuators-dials-fill.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Dials.Fill is - - - type Fill_Dial is new Dial with private; - - type Fill_Dial_Reference (Data : not null access Fill_Dial'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Fill_Dial; - - end Forge; - - - - - procedure Draw - (This : in out Fill_Dial); - - function Handle - (This : in out Fill_Dial; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Fill_Dial is new Dial with null record; - - overriding procedure Finalize - (This : in out Fill_Dial); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Dials.Fill; - diff --git a/src/fltk-widgets-valuators-dials-line.adb b/src/fltk-widgets-valuators-dials-line.adb deleted file mode 100644 index 15565c3..0000000 --- a/src/fltk-widgets-valuators-dials-line.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Dials.Line is - - - procedure line_dial_set_draw_hook - (W, D : in System.Address); - pragma Import (C, line_dial_set_draw_hook, "line_dial_set_draw_hook"); - pragma Inline (line_dial_set_draw_hook); - - procedure line_dial_set_handle_hook - (W, H : in System.Address); - pragma Import (C, line_dial_set_handle_hook, "line_dial_set_handle_hook"); - pragma Inline (line_dial_set_handle_hook); - - - - - function new_fl_line_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_line_dial, "new_fl_line_dial"); - pragma Inline (new_fl_line_dial); - - procedure free_fl_line_dial - (D : in System.Address); - pragma Import (C, free_fl_line_dial, "free_fl_line_dial"); - pragma Inline (free_fl_line_dial); - - - - - procedure fl_line_dial_draw - (W : in System.Address); - pragma Import (C, fl_line_dial_draw, "fl_line_dial_draw"); - pragma Inline (fl_line_dial_draw); - - function fl_line_dial_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_line_dial_handle, "fl_line_dial_handle"); - pragma Inline (fl_line_dial_handle); - - - - - procedure Finalize - (This : in out Line_Dial) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Line_Dial'Class - then - free_fl_line_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Dial (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Line_Dial is - begin - return This : Line_Dial do - This.Void_Ptr := new_fl_line_dial - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - line_dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - line_dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Line_Dial) is - begin - fl_line_dial_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Line_Dial; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_line_dial_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Dials.Line; - diff --git a/src/fltk-widgets-valuators-dials-line.ads b/src/fltk-widgets-valuators-dials-line.ads deleted file mode 100644 index 7752f68..0000000 --- a/src/fltk-widgets-valuators-dials-line.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Dials.Line is - - - type Line_Dial is new Dial with private; - - type Line_Dial_Reference (Data : not null access Line_Dial'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Line_Dial; - - end Forge; - - - - - procedure Draw - (This : in out Line_Dial); - - function Handle - (This : in out Line_Dial; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Line_Dial is new Dial with null record; - - overriding procedure Finalize - (This : in out Line_Dial); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Dials.Line; - diff --git a/src/fltk-widgets-valuators-dials.adb b/src/fltk-widgets-valuators-dials.adb deleted file mode 100644 index 31ce0ed..0000000 --- a/src/fltk-widgets-valuators-dials.adb +++ /dev/null @@ -1,234 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Dials is - - - procedure dial_set_draw_hook - (W, D : in System.Address); - pragma Import (C, dial_set_draw_hook, "dial_set_draw_hook"); - pragma Inline (dial_set_draw_hook); - - procedure dial_set_handle_hook - (W, H : in System.Address); - pragma Import (C, dial_set_handle_hook, "dial_set_handle_hook"); - pragma Inline (dial_set_handle_hook); - - - - - function new_fl_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_dial, "new_fl_dial"); - pragma Inline (new_fl_dial); - - procedure free_fl_dial - (D : in System.Address); - pragma Import (C, free_fl_dial, "free_fl_dial"); - pragma Inline (free_fl_dial); - - - - - function fl_dial_get_type - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_dial_get_type, "fl_dial_get_type"); - pragma Inline (fl_dial_get_type); - - procedure fl_dial_set_type - (D : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_dial_set_type, "fl_dial_set_type"); - pragma Inline (fl_dial_set_type); - - - - - function fl_dial_get_angle1 - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_dial_get_angle1, "fl_dial_get_angle1"); - pragma Inline (fl_dial_get_angle1); - - procedure fl_dial_set_angle1 - (D : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_dial_set_angle1, "fl_dial_set_angle1"); - pragma Inline (fl_dial_set_angle1); - - function fl_dial_get_angle2 - (D : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_dial_get_angle2, "fl_dial_get_angle2"); - pragma Inline (fl_dial_get_angle2); - - procedure fl_dial_set_angle2 - (D : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_dial_set_angle2, "fl_dial_set_angle2"); - pragma Inline (fl_dial_set_angle2); - - procedure fl_dial_set_angles - (D : in System.Address; - A, B : in Interfaces.C.int); - pragma Import (C, fl_dial_set_angles, "fl_dial_set_angles"); - pragma Inline (fl_dial_set_angles); - - - - - procedure fl_dial_draw - (W : in System.Address); - pragma Import (C, fl_dial_draw, "fl_dial_draw"); - pragma Inline (fl_dial_draw); - - function fl_dial_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_dial_handle, "fl_dial_handle"); - pragma Inline (fl_dial_handle); - - - - - procedure Finalize - (This : in out Dial) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Dial'Class - then - free_fl_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Dial is - begin - return This : Dial do - This.Void_Ptr := new_fl_dial - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Dial_Type - (This : in Dial) - return Dial_Kind is - begin - return Dial_Kind'Val (fl_dial_get_type (This.Void_Ptr)); - end Get_Dial_Type; - - - function Get_First_Angle - (This : in Dial) - return Integer is - begin - return Integer (fl_dial_get_angle1 (This.Void_Ptr)); - end Get_First_Angle; - - - procedure Set_First_Angle - (This : in out Dial; - To : in Integer) is - begin - fl_dial_set_angle1 (This.Void_Ptr, Interfaces.C.int (To)); - end Set_First_Angle; - - - function Get_Second_Angle - (This : in Dial) - return Integer is - begin - return Integer (fl_dial_get_angle2 (This.Void_Ptr)); - end Get_Second_Angle; - - - procedure Set_Second_Angle - (This : in out Dial; - To : in Integer) is - begin - fl_dial_set_angle2 (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Second_Angle; - - - procedure Set_Angles - (This : in out Dial; - One, Two : in Integer) is - begin - fl_dial_set_angles (This.Void_Ptr, Interfaces.C.int (One), Interfaces.C.int (Two)); - end Set_Angles; - - - - - procedure Draw - (This : in out Dial) is - begin - fl_dial_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Dial; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_dial_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - - - - package body Extra is - - procedure Set_Dial_Type - (This : in out Dial; - To : in Dial_Kind) is - begin - fl_dial_set_type (This.Void_Ptr, Dial_Kind'Pos (To)); - end Set_Dial_Type; - - pragma Inline (Set_Dial_Type); - - end Extra; - - -end FLTK.Widgets.Valuators.Dials; - diff --git a/src/fltk-widgets-valuators-dials.ads b/src/fltk-widgets-valuators-dials.ads deleted file mode 100644 index 418ce31..0000000 --- a/src/fltk-widgets-valuators-dials.ads +++ /dev/null @@ -1,101 +0,0 @@ - - -package FLTK.Widgets.Valuators.Dials is - - - type Dial is new Valuator with private; - - type Dial_Reference (Data : not null access Dial'Class) is limited null record - with Implicit_Dereference => Data; - - type Dial_Kind is (Normal_Kind, Line_Kind, Fill_Kind); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Dial; - - end Forge; - - - - - function Get_Dial_Type - (This : in Dial) - return Dial_Kind; - - function Get_First_Angle - (This : in Dial) - return Integer; - - procedure Set_First_Angle - (This : in out Dial; - To : in Integer); - - function Get_Second_Angle - (This : in Dial) - return Integer; - - procedure Set_Second_Angle - (This : in out Dial; - To : in Integer); - - procedure Set_Angles - (This : in out Dial; - One, Two : in Integer); - - - - - procedure Draw - (This : in out Dial); - - function Handle - (This : in out Dial; - Event : in Event_Kind) - return Event_Outcome; - - - - - package Extra is - - procedure Set_Dial_Type - (This : in out Dial; - To : in Dial_Kind); - - end Extra; - - -private - - - type Dial is new Valuator with null record; - - overriding procedure Finalize - (This : in out Dial); - - - - - pragma Inline (Get_Dial_Type); - - - pragma Inline (Get_First_Angle); - pragma Inline (Set_First_Angle); - pragma Inline (Get_Second_Angle); - pragma Inline (Set_Second_Angle); - pragma Inline (Set_Angles); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Dials; - diff --git a/src/fltk-widgets-valuators-rollers.adb b/src/fltk-widgets-valuators-rollers.adb deleted file mode 100644 index 2a50f1b..0000000 --- a/src/fltk-widgets-valuators-rollers.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Rollers is - - - procedure roller_set_draw_hook - (W, D : in System.Address); - pragma Import (C, roller_set_draw_hook, "roller_set_draw_hook"); - pragma Inline (roller_set_draw_hook); - - procedure roller_set_handle_hook - (W, H : in System.Address); - pragma Import (C, roller_set_handle_hook, "roller_set_handle_hook"); - pragma Inline (roller_set_handle_hook); - - - - - function new_fl_roller - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_roller, "new_fl_roller"); - pragma Inline (new_fl_roller); - - procedure free_fl_roller - (D : in System.Address); - pragma Import (C, free_fl_roller, "free_fl_roller"); - pragma Inline (free_fl_roller); - - - - - procedure fl_roller_draw - (W : in System.Address); - pragma Import (C, fl_roller_draw, "fl_roller_draw"); - pragma Inline (fl_roller_draw); - - function fl_roller_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_roller_handle, "fl_roller_handle"); - pragma Inline (fl_roller_handle); - - - - - procedure Finalize - (This : in out Roller) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Roller'Class - then - free_fl_roller (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Roller is - begin - return This : Roller do - This.Void_Ptr := new_fl_roller - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - roller_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - roller_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Roller) is - begin - fl_roller_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Roller; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_roller_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Rollers; - diff --git a/src/fltk-widgets-valuators-rollers.ads b/src/fltk-widgets-valuators-rollers.ads deleted file mode 100644 index 41bb864..0000000 --- a/src/fltk-widgets-valuators-rollers.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Rollers is - - - type Roller is new Valuator with private; - - type Roller_Reference (Data : not null access Roller'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Roller; - - end Forge; - - - - - procedure Draw - (This : in out Roller); - - function Handle - (This : in out Roller; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Roller is new Valuator with null record; - - overriding procedure Finalize - (This : in out Roller); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Rollers; - diff --git a/src/fltk-widgets-valuators-sliders-fill.adb b/src/fltk-widgets-valuators-sliders-fill.adb deleted file mode 100644 index 83f1ffb..0000000 --- a/src/fltk-widgets-valuators-sliders-fill.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Fill is - - - procedure fill_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, fill_slider_set_draw_hook, "fill_slider_set_draw_hook"); - pragma Inline (fill_slider_set_draw_hook); - - procedure fill_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, fill_slider_set_handle_hook, "fill_slider_set_handle_hook"); - pragma Inline (fill_slider_set_handle_hook); - - - - - function new_fl_fill_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_fill_slider, "new_fl_fill_slider"); - pragma Inline (new_fl_fill_slider); - - procedure free_fl_fill_slider - (D : in System.Address); - pragma Import (C, free_fl_fill_slider, "free_fl_fill_slider"); - pragma Inline (free_fl_fill_slider); - - - - - procedure fl_fill_slider_draw - (W : in System.Address); - pragma Import (C, fl_fill_slider_draw, "fl_fill_slider_draw"); - pragma Inline (fl_fill_slider_draw); - - function fl_fill_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_fill_slider_handle, "fl_fill_slider_handle"); - pragma Inline (fl_fill_slider_handle); - - - - - procedure Finalize - (This : in out Fill_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Fill_Slider'Class - then - free_fl_fill_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Fill_Slider is - begin - return This : Fill_Slider do - This.Void_Ptr := new_fl_fill_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - fill_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - fill_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Fill_Slider) is - begin - fl_fill_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Fill_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_fill_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Fill; - diff --git a/src/fltk-widgets-valuators-sliders-fill.ads b/src/fltk-widgets-valuators-sliders-fill.ads deleted file mode 100644 index 3a91bec..0000000 --- a/src/fltk-widgets-valuators-sliders-fill.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Fill is - - - type Fill_Slider is new Slider with private; - - type Fill_Slider_Reference (Data : not null access Fill_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Fill_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Fill_Slider); - - function Handle - (This : in out Fill_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Fill_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Fill_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Fill; - diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.adb b/src/fltk-widgets-valuators-sliders-hor_fill.adb deleted file mode 100644 index 3cb4f20..0000000 --- a/src/fltk-widgets-valuators-sliders-hor_fill.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is - - - procedure hor_fill_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, hor_fill_slider_set_draw_hook, "hor_fill_slider_set_draw_hook"); - pragma Inline (hor_fill_slider_set_draw_hook); - - procedure hor_fill_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, hor_fill_slider_set_handle_hook, "hor_fill_slider_set_handle_hook"); - pragma Inline (hor_fill_slider_set_handle_hook); - - - - - function new_fl_hor_fill_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_hor_fill_slider, "new_fl_hor_fill_slider"); - pragma Inline (new_fl_hor_fill_slider); - - procedure free_fl_hor_fill_slider - (D : in System.Address); - pragma Import (C, free_fl_hor_fill_slider, "free_fl_hor_fill_slider"); - pragma Inline (free_fl_hor_fill_slider); - - - - - procedure fl_hor_fill_slider_draw - (W : in System.Address); - pragma Import (C, fl_hor_fill_slider_draw, "fl_hor_fill_slider_draw"); - pragma Inline (fl_hor_fill_slider_draw); - - function fl_hor_fill_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_hor_fill_slider_handle, "fl_hor_fill_slider_handle"); - pragma Inline (fl_hor_fill_slider_handle); - - - - - procedure Finalize - (This : in out Hor_Fill_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Hor_Fill_Slider'Class - then - free_fl_hor_fill_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Fill_Slider is - begin - return This : Hor_Fill_Slider do - This.Void_Ptr := new_fl_hor_fill_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_fill_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_fill_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Fill_Slider) is - begin - fl_hor_fill_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Hor_Fill_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_hor_fill_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Hor_Fill; - diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.ads b/src/fltk-widgets-valuators-sliders-hor_fill.ads deleted file mode 100644 index b54c388..0000000 --- a/src/fltk-widgets-valuators-sliders-hor_fill.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Hor_Fill is - - - type Hor_Fill_Slider is new Slider with private; - - type Hor_Fill_Slider_Reference (Data : not null access Hor_Fill_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Fill_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Fill_Slider); - - function Handle - (This : in out Hor_Fill_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Hor_Fill_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Hor_Fill_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Hor_Fill; - diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.adb b/src/fltk-widgets-valuators-sliders-hor_nice.adb deleted file mode 100644 index 4f3db15..0000000 --- a/src/fltk-widgets-valuators-sliders-hor_nice.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is - - - procedure hor_nice_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, hor_nice_slider_set_draw_hook, "hor_nice_slider_set_draw_hook"); - pragma Inline (hor_nice_slider_set_draw_hook); - - procedure hor_nice_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, hor_nice_slider_set_handle_hook, "hor_nice_slider_set_handle_hook"); - pragma Inline (hor_nice_slider_set_handle_hook); - - - - - function new_fl_hor_nice_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_hor_nice_slider, "new_fl_hor_nice_slider"); - pragma Inline (new_fl_hor_nice_slider); - - procedure free_fl_hor_nice_slider - (D : in System.Address); - pragma Import (C, free_fl_hor_nice_slider, "free_fl_hor_nice_slider"); - pragma Inline (free_fl_hor_nice_slider); - - - - - procedure fl_hor_nice_slider_draw - (W : in System.Address); - pragma Import (C, fl_hor_nice_slider_draw, "fl_hor_nice_slider_draw"); - pragma Inline (fl_hor_nice_slider_draw); - - function fl_hor_nice_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_hor_nice_slider_handle, "fl_hor_nice_slider_handle"); - pragma Inline (fl_hor_nice_slider_handle); - - - - - procedure Finalize - (This : in out Hor_Nice_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Hor_Nice_Slider'Class - then - free_fl_hor_nice_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Nice_Slider is - begin - return This : Hor_Nice_Slider do - This.Void_Ptr := new_fl_hor_nice_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_nice_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_nice_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Nice_Slider) is - begin - fl_hor_nice_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Hor_Nice_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_hor_nice_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Hor_Nice; - diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.ads b/src/fltk-widgets-valuators-sliders-hor_nice.ads deleted file mode 100644 index e8bae70..0000000 --- a/src/fltk-widgets-valuators-sliders-hor_nice.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Hor_Nice is - - - type Hor_Nice_Slider is new Slider with private; - - type Hor_Nice_Slider_Reference (Data : not null access Hor_Nice_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Nice_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Nice_Slider); - - function Handle - (This : in out Hor_Nice_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Hor_Nice_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Hor_Nice_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Hor_Nice; - diff --git a/src/fltk-widgets-valuators-sliders-horizontal.adb b/src/fltk-widgets-valuators-sliders-horizontal.adb deleted file mode 100644 index 4675e23..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Horizontal is - - - procedure horizontal_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, horizontal_slider_set_draw_hook, "horizontal_slider_set_draw_hook"); - pragma Inline (horizontal_slider_set_draw_hook); - - procedure horizontal_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, horizontal_slider_set_handle_hook, "horizontal_slider_set_handle_hook"); - pragma Inline (horizontal_slider_set_handle_hook); - - - - - function new_fl_horizontal_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_horizontal_slider, "new_fl_horizontal_slider"); - pragma Inline (new_fl_horizontal_slider); - - procedure free_fl_horizontal_slider - (D : in System.Address); - pragma Import (C, free_fl_horizontal_slider, "free_fl_horizontal_slider"); - pragma Inline (free_fl_horizontal_slider); - - - - - procedure fl_horizontal_slider_draw - (W : in System.Address); - pragma Import (C, fl_horizontal_slider_draw, "fl_horizontal_slider_draw"); - pragma Inline (fl_horizontal_slider_draw); - - function fl_horizontal_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_horizontal_slider_handle, "fl_horizontal_slider_handle"); - pragma Inline (fl_horizontal_slider_handle); - - - - - procedure Finalize - (This : in out Horizontal_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Horizontal_Slider'Class - then - free_fl_horizontal_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Horizontal_Slider is - begin - return This : Horizontal_Slider do - This.Void_Ptr := new_fl_horizontal_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - horizontal_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - horizontal_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Horizontal_Slider) is - begin - fl_horizontal_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Horizontal_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_horizontal_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal; - diff --git a/src/fltk-widgets-valuators-sliders-horizontal.ads b/src/fltk-widgets-valuators-sliders-horizontal.ads deleted file mode 100644 index 130a9fd..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Horizontal is - - - type Horizontal_Slider is new Slider with private; - - type Horizontal_Slider_Reference (Data : not null access Horizontal_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Horizontal_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Horizontal_Slider); - - function Handle - (This : in out Horizontal_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Horizontal_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Horizontal_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Horizontal; - diff --git a/src/fltk-widgets-valuators-sliders-nice.adb b/src/fltk-widgets-valuators-sliders-nice.adb deleted file mode 100644 index 3820c5f..0000000 --- a/src/fltk-widgets-valuators-sliders-nice.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Nice is - - - procedure nice_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, nice_slider_set_draw_hook, "nice_slider_set_draw_hook"); - pragma Inline (nice_slider_set_draw_hook); - - procedure nice_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, nice_slider_set_handle_hook, "nice_slider_set_handle_hook"); - pragma Inline (nice_slider_set_handle_hook); - - - - - function new_fl_nice_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_nice_slider, "new_fl_nice_slider"); - pragma Inline (new_fl_nice_slider); - - procedure free_fl_nice_slider - (D : in System.Address); - pragma Import (C, free_fl_nice_slider, "free_fl_nice_slider"); - pragma Inline (free_fl_nice_slider); - - - - - procedure fl_nice_slider_draw - (W : in System.Address); - pragma Import (C, fl_nice_slider_draw, "fl_nice_slider_draw"); - pragma Inline (fl_nice_slider_draw); - - function fl_nice_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_nice_slider_handle, "fl_nice_slider_handle"); - pragma Inline (fl_nice_slider_handle); - - - - - procedure Finalize - (This : in out Nice_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Nice_Slider'Class - then - free_fl_nice_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Nice_Slider is - begin - return This : Nice_Slider do - This.Void_Ptr := new_fl_nice_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - nice_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - nice_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Nice_Slider) is - begin - fl_nice_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Nice_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_nice_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Nice; - diff --git a/src/fltk-widgets-valuators-sliders-nice.ads b/src/fltk-widgets-valuators-sliders-nice.ads deleted file mode 100644 index 32dcec1..0000000 --- a/src/fltk-widgets-valuators-sliders-nice.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Nice is - - - type Nice_Slider is new Slider with private; - - type Nice_Slider_Reference (Data : not null access Nice_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Nice_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Nice_Slider); - - function Handle - (This : in out Nice_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Nice_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Nice_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Nice; - diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb deleted file mode 100644 index e40ec1f..0000000 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ /dev/null @@ -1,203 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Scrollbars is - - - procedure scrollbar_set_draw_hook - (W, D : in System.Address); - pragma Import (C, scrollbar_set_draw_hook, "scrollbar_set_draw_hook"); - pragma Inline (scrollbar_set_draw_hook); - - procedure scrollbar_set_handle_hook - (W, H : in System.Address); - pragma Import (C, scrollbar_set_handle_hook, "scrollbar_set_handle_hook"); - pragma Inline (scrollbar_set_handle_hook); - - - - - function new_fl_scrollbar - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_scrollbar, "new_fl_scrollbar"); - pragma Inline (new_fl_scrollbar); - - procedure free_fl_scrollbar - (D : in System.Address); - pragma Import (C, free_fl_scrollbar, "free_fl_scrollbar"); - pragma Inline (free_fl_scrollbar); - - - - - function fl_scrollbar_get_linesize - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_scrollbar_get_linesize, "fl_scrollbar_get_linesize"); - pragma Inline (fl_scrollbar_get_linesize); - - procedure fl_scrollbar_set_linesize - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_scrollbar_set_linesize, "fl_scrollbar_set_linesize"); - pragma Inline (fl_scrollbar_set_linesize); - - function fl_scrollbar_get_value - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_scrollbar_get_value, "fl_scrollbar_get_value"); - pragma Inline (fl_scrollbar_get_value); - - procedure fl_scrollbar_set_value - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_scrollbar_set_value, "fl_scrollbar_set_value"); - pragma Inline (fl_scrollbar_set_value); - - procedure fl_scrollbar_set_value2 - (S : in System.Address; - P, W, F, T : in Interfaces.C.int); - pragma Import (C, fl_scrollbar_set_value2, "fl_scrollbar_set_value2"); - pragma Inline (fl_scrollbar_set_value2); - - - - - procedure fl_scrollbar_draw - (W : in System.Address); - pragma Import (C, fl_scrollbar_draw, "fl_scrollbar_draw"); - pragma Inline (fl_scrollbar_draw); - - function fl_scrollbar_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_scrollbar_handle, "fl_scrollbar_handle"); - pragma Inline (fl_scrollbar_handle); - - - - - procedure Finalize - (This : in out Scrollbar) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Scrollbar'Class - then - free_fl_scrollbar (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Scrollbar is - begin - return This : Scrollbar do - This.Void_Ptr := new_fl_scrollbar - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - scrollbar_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - scrollbar_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Line_Size - (This : in Scrollbar) - return Natural is - begin - return Natural (fl_scrollbar_get_linesize (This.Void_Ptr)); - end Get_Line_Size; - - - procedure Set_Line_Size - (This : in out Scrollbar; - To : in Natural) is - begin - fl_scrollbar_set_linesize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Line_Size; - - - function Get_Position - (This : in Scrollbar) - return Natural is - begin - return Natural (fl_scrollbar_get_value (This.Void_Ptr)); - end Get_Position; - - - procedure Set_Position - (This : in out Scrollbar; - To : in Natural) is - begin - fl_scrollbar_set_value (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Position; - - - procedure Set_All - (This : in out Scrollbar; - Position : in Natural; - Win_Size : in Natural; - First_Line : in Natural; - Total_Lines : in Natural) is - begin - fl_scrollbar_set_value2 - (This.Void_Ptr, - Interfaces.C.int (Position), - Interfaces.C.int (Win_Size), - Interfaces.C.int (First_Line), - Interfaces.C.int (Total_Lines)); - end Set_All; - - - - - procedure Draw - (This : in out Scrollbar) is - begin - fl_scrollbar_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Scrollbar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_scrollbar_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Scrollbars; - diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.ads b/src/fltk-widgets-valuators-sliders-scrollbars.ads deleted file mode 100644 index 6a921bb..0000000 --- a/src/fltk-widgets-valuators-sliders-scrollbars.ads +++ /dev/null @@ -1,84 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Scrollbars is - - - type Scrollbar is new Slider with private; - - type Scrollbar_Reference (Data : not null access Scrollbar'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Scrollbar; - - end Forge; - - - - - function Get_Line_Size - (This : in Scrollbar) - return Natural; - - procedure Set_Line_Size - (This : in out Scrollbar; - To : in Natural); - - function Get_Position - (This : in Scrollbar) - return Natural; - - procedure Set_Position - (This : in out Scrollbar; - To : in Natural); - - procedure Set_All - (This : in out Scrollbar; - Position : in Natural; - Win_Size : in Natural; - First_Line : in Natural; - Total_Lines : in Natural); - - - - - procedure Draw - (This : in out Scrollbar); - - function Handle - (This : in out Scrollbar; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Scrollbar is new Slider with null record; - - overriding procedure Finalize - (This : in out Scrollbar); - - - - - pragma Inline (Get_Line_Size); - pragma Inline (Set_Line_Size); - pragma Inline (Get_Position); - pragma Inline (Set_Position); - pragma Inline (Set_All); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Scrollbars; - diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.adb b/src/fltk-widgets-valuators-sliders-value-horizontal.adb deleted file mode 100644 index d3c0c06..0000000 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.adb +++ /dev/null @@ -1,120 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is - - - procedure hor_value_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, hor_value_slider_set_draw_hook, "hor_value_slider_set_draw_hook"); - pragma Inline (hor_value_slider_set_draw_hook); - - procedure hor_value_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, hor_value_slider_set_handle_hook, "hor_value_slider_set_handle_hook"); - pragma Inline (hor_value_slider_set_handle_hook); - - - - - function new_fl_hor_value_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_hor_value_slider, "new_fl_hor_value_slider"); - pragma Inline (new_fl_hor_value_slider); - - procedure free_fl_hor_value_slider - (D : in System.Address); - pragma Import (C, free_fl_hor_value_slider, "free_fl_hor_value_slider"); - pragma Inline (free_fl_hor_value_slider); - - - - - procedure fl_hor_value_slider_draw - (W : in System.Address); - pragma Import (C, fl_hor_value_slider_draw, "fl_hor_value_slider_draw"); - pragma Inline (fl_hor_value_slider_draw); - - function fl_hor_value_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_hor_value_slider_handle, "fl_hor_value_slider_handle"); - pragma Inline (fl_hor_value_slider_handle); - - - - - procedure Finalize - (This : in out Hor_Value_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Hor_Value_Slider'Class - then - free_fl_hor_value_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Value_Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Value_Slider is - begin - return This : Hor_Value_Slider do - This.Void_Ptr := new_fl_hor_value_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_value_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_value_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Value_Slider) is - begin - fl_hor_value_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Hor_Value_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_hor_value_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Value.Horizontal; - diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.ads b/src/fltk-widgets-valuators-sliders-value-horizontal.ads deleted file mode 100644 index d92465e..0000000 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.ads +++ /dev/null @@ -1,51 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Value.Horizontal is - - - type Hor_Value_Slider is new Value_Slider with private; - - type Hor_Value_Slider_Reference (Data : not null access Hor_Value_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hor_Value_Slider; - - end Forge; - - - - - procedure Draw - (This : in out Hor_Value_Slider); - - function Handle - (This : in out Hor_Value_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Hor_Value_Slider is new Value_Slider with null record; - - overriding procedure Finalize - (This : in out Hor_Value_Slider); - - - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Value.Horizontal; - diff --git a/src/fltk-widgets-valuators-sliders-value.adb b/src/fltk-widgets-valuators-sliders-value.adb deleted file mode 100644 index 48cd603..0000000 --- a/src/fltk-widgets-valuators-sliders-value.adb +++ /dev/null @@ -1,209 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders.Value is - - - procedure value_slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, value_slider_set_draw_hook, "value_slider_set_draw_hook"); - pragma Inline (value_slider_set_draw_hook); - - procedure value_slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, value_slider_set_handle_hook, "value_slider_set_handle_hook"); - pragma Inline (value_slider_set_handle_hook); - - - - - function new_fl_value_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_value_slider, "new_fl_value_slider"); - pragma Inline (new_fl_value_slider); - - procedure free_fl_value_slider - (D : in System.Address); - pragma Import (C, free_fl_value_slider, "free_fl_value_slider"); - pragma Inline (free_fl_value_slider); - - - - - function fl_value_slider_get_textcolor - (S : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_value_slider_get_textcolor, "fl_value_slider_get_textcolor"); - pragma Inline (fl_value_slider_get_textcolor); - - procedure fl_value_slider_set_textcolor - (S : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_value_slider_set_textcolor, "fl_value_slider_set_textcolor"); - pragma Inline (fl_value_slider_set_textcolor); - - function fl_value_slider_get_textfont - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_slider_get_textfont, "fl_value_slider_get_textfont"); - pragma Inline (fl_value_slider_get_textfont); - - procedure fl_value_slider_set_textfont - (S : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_value_slider_set_textfont, "fl_value_slider_set_textfont"); - pragma Inline (fl_value_slider_set_textfont); - - function fl_value_slider_get_textsize - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_slider_get_textsize, "fl_value_slider_get_textsize"); - pragma Inline (fl_value_slider_get_textsize); - - procedure fl_value_slider_set_textsize - (S : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_value_slider_set_textsize, "fl_value_slider_set_textsize"); - pragma Inline (fl_value_slider_set_textsize); - - - - - procedure fl_value_slider_draw - (W : in System.Address); - pragma Import (C, fl_value_slider_draw, "fl_value_slider_draw"); - pragma Inline (fl_value_slider_draw); - - function fl_value_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_value_slider_handle, "fl_value_slider_handle"); - pragma Inline (fl_value_slider_handle); - - - - - procedure Finalize - (This : in out Value_Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Value_Slider'Class - then - free_fl_value_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Slider (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Value_Slider is - begin - return This : Value_Slider do - This.Void_Ptr := new_fl_value_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Text_Color - (This : in Value_Slider) - return Color is - begin - return Color (fl_value_slider_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Value_Slider; - To : in Color) is - begin - fl_value_slider_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Value_Slider) - return Font_Kind is - begin - return Font_Kind'Val (fl_value_slider_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Value_Slider; - To : in Font_Kind) is - begin - fl_value_slider_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Value_Slider) - return Font_Size is - begin - return Font_Size (fl_value_slider_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Value_Slider; - To : in Font_Size) is - begin - fl_value_slider_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Text_Size; - - - - - procedure Draw - (This : in out Value_Slider) is - begin - fl_value_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Value_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_value_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Sliders.Value; - diff --git a/src/fltk-widgets-valuators-sliders-value.ads b/src/fltk-widgets-valuators-sliders-value.ads deleted file mode 100644 index 02edc47..0000000 --- a/src/fltk-widgets-valuators-sliders-value.ads +++ /dev/null @@ -1,86 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders.Value is - - - type Value_Slider is new Slider with private; - - type Value_Slider_Reference (Data : not null access Value_Slider'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Value_Slider; - - end Forge; - - - - - function Get_Text_Color - (This : in Value_Slider) - return Color; - - procedure Set_Text_Color - (This : in out Value_Slider; - To : in Color); - - function Get_Text_Font - (This : in Value_Slider) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Value_Slider; - To : in Font_Kind); - - function Get_Text_Size - (This : in Value_Slider) - return Font_Size; - - procedure Set_Text_Size - (This : in out Value_Slider; - To : in Font_Size); - - - - - procedure Draw - (This : in out Value_Slider); - - function Handle - (This : in out Value_Slider; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Value_Slider is new Slider with null record; - - overriding procedure Finalize - (This : in out Value_Slider); - - - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders.Value; - diff --git a/src/fltk-widgets-valuators-sliders.adb b/src/fltk-widgets-valuators-sliders.adb deleted file mode 100644 index 5511695..0000000 --- a/src/fltk-widgets-valuators-sliders.adb +++ /dev/null @@ -1,262 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators.Sliders is - - - procedure slider_set_draw_hook - (W, D : in System.Address); - pragma Import (C, slider_set_draw_hook, "slider_set_draw_hook"); - pragma Inline (slider_set_draw_hook); - - procedure slider_set_handle_hook - (W, H : in System.Address); - pragma Import (C, slider_set_handle_hook, "slider_set_handle_hook"); - pragma Inline (slider_set_handle_hook); - - - - - function new_fl_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_slider, "new_fl_slider"); - pragma Inline (new_fl_slider); - - procedure free_fl_slider - (D : in System.Address); - pragma Import (C, free_fl_slider, "free_fl_slider"); - pragma Inline (free_fl_slider); - - - - - function fl_slider_get_type - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_slider_get_type, "fl_slider_get_type"); - pragma Inline (fl_slider_get_type); - - procedure fl_slider_set_type - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_slider_set_type, "fl_slider_set_type"); - pragma Inline (fl_slider_set_type); - - - - - procedure fl_slider_set_bounds - (S : in System.Address; - A, B : in Interfaces.C.double); - pragma Import (C, fl_slider_set_bounds, "fl_slider_set_bounds"); - pragma Inline (fl_slider_set_bounds); - - function fl_slider_get_slider - (S : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_slider_get_slider, "fl_slider_get_slider"); - pragma Inline (fl_slider_get_slider); - - procedure fl_slider_set_slider - (S : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_slider_set_slider, "fl_slider_set_slider"); - pragma Inline (fl_slider_set_slider); - - function fl_slider_get_slider_size - (S : in System.Address) - return Interfaces.C.C_float; - pragma Import (C, fl_slider_get_slider_size, "fl_slider_get_slider_size"); - pragma Inline (fl_slider_get_slider_size); - - procedure fl_slider_set_slider_size - (S : in System.Address; - T : in Interfaces.C.C_float); - pragma Import (C, fl_slider_set_slider_size, "fl_slider_set_slider_size"); - pragma Inline (fl_slider_set_slider_size); - - function fl_slider_scrollvalue - (S : in System.Address; - P, Z, F, T : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_slider_scrollvalue, "fl_slider_scrollvalue"); - pragma Inline (fl_slider_scrollvalue); - - - - - procedure fl_slider_draw - (W : in System.Address); - pragma Import (C, fl_slider_draw, "fl_slider_draw"); - pragma Inline (fl_slider_draw); - - function fl_slider_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_slider_handle, "fl_slider_handle"); - pragma Inline (fl_slider_handle); - - - - - procedure Finalize - (This : in out Slider) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Slider'Class - then - free_fl_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Slider is - begin - return This : Slider do - This.Void_Ptr := new_fl_slider - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Get_Slider_Type - (This : in Slider) - return Slider_Kind is - begin - return Slider_Kind'Val (fl_slider_get_type (This.Void_Ptr)); - end Get_Slider_Type; - - - procedure Set_Bounds - (This : in out Slider; - Min, Max : in Long_Float) is - begin - fl_slider_set_bounds - (This.Void_Ptr, - Interfaces.C.double (Min), - Interfaces.C.double (Max)); - end Set_Bounds; - - - function Get_Box - (This : in Slider) - return Box_Kind is - begin - return Box_Kind'Val (fl_slider_get_slider (This.Void_Ptr)); - end Get_Box; - - - procedure Set_Box - (This : in out Slider; - To : in Box_Kind) is - begin - fl_slider_set_slider (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Box; - - - function Get_Slide_Size - (This : in Slider) - return Float is - begin - return Float (fl_slider_get_slider_size (This.Void_Ptr)); - end Get_Slide_Size; - - - procedure Set_Slide_Size - (This : in out Slider; - To : in Float) is - begin - fl_slider_set_slider_size (This.Void_Ptr, Interfaces.C.C_float (To)); - end Set_Slide_Size; - - - procedure Set_Scrollvalue - (This : in out Slider; - Pos_First_Line : in Natural; - Lines_In_Window : in Natural; - First_Line_Num : in Natural; - Total_Lines : in Natural) - is - Ignore_Me : Interfaces.C.int; - begin - Ignore_Me := fl_slider_scrollvalue - (This.Void_Ptr, - Interfaces.C.int (Pos_First_Line), - Interfaces.C.int (Lines_In_Window), - Interfaces.C.int (First_Line_Num), - Interfaces.C.int (Total_Lines)); - end Set_Scrollvalue; - - - - - procedure Draw - (This : in out Slider) is - begin - fl_slider_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_slider_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - - - - package body Extra is - - procedure Set_Slider_Type - (This : in out Slider; - To : in Slider_Kind) is - begin - fl_slider_set_type (This.Void_Ptr, Slider_Kind'Pos (To)); - end Set_Slider_Type; - - pragma Inline (Set_Slider_Type); - - end Extra; - - -end FLTK.Widgets.Valuators.Sliders; - diff --git a/src/fltk-widgets-valuators-sliders.ads b/src/fltk-widgets-valuators-sliders.ads deleted file mode 100644 index e53dbd2..0000000 --- a/src/fltk-widgets-valuators-sliders.ads +++ /dev/null @@ -1,110 +0,0 @@ - - -package FLTK.Widgets.Valuators.Sliders is - - - type Slider is new Valuator with private; - - type Slider_Reference (Data : not null access Slider'Class) is limited null record - with Implicit_Dereference => Data; - - type Slider_Kind is - (Vertical_Kind, Horizontal_Kind, - Vert_Fill_Kind, Hor_Fill_Kind, - Vert_Nice_Kind, Hor_Nice_Kind); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Slider; - - end Forge; - - - - - function Get_Slider_Type - (This : in Slider) - return Slider_Kind; - - procedure Set_Bounds - (This : in out Slider; - Min, Max : in Long_Float); - - function Get_Box - (This : in Slider) - return Box_Kind; - - procedure Set_Box - (This : in out Slider; - To : in Box_Kind); - - function Get_Slide_Size - (This : in Slider) - return Float; - - procedure Set_Slide_Size - (This : in out Slider; - To : in Float); - - procedure Set_Scrollvalue - (This : in out Slider; - Pos_First_Line : in Natural; - Lines_In_Window : in Natural; - First_Line_Num : in Natural; - Total_Lines : in Natural); - - - - - procedure Draw - (This : in out Slider); - - function Handle - (This : in out Slider; - Event : in Event_Kind) - return Event_Outcome; - - - - - package Extra is - - procedure Set_Slider_Type - (This : in out Slider; - To : in Slider_Kind); - - end Extra; - - -private - - - type Slider is new Valuator with null record; - - overriding procedure Finalize - (This : in out Slider); - - - - - pragma Inline (Get_Slider_Type); - pragma Inline (Set_Bounds); - pragma Inline (Get_Box); - pragma Inline (Set_Box); - pragma Inline (Get_Slide_Size); - pragma Inline (Set_Slide_Size); - pragma Inline (Set_Scrollvalue); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Sliders; - diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb deleted file mode 100644 index fbba892..0000000 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ /dev/null @@ -1,341 +0,0 @@ - - -with - - Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Valuators.Value_Inputs is - - - procedure value_input_set_draw_hook - (W, D : in System.Address); - pragma Import (C, value_input_set_draw_hook, "value_input_set_draw_hook"); - pragma Inline (value_input_set_draw_hook); - - procedure value_input_set_handle_hook - (W, H : in System.Address); - pragma Import (C, value_input_set_handle_hook, "value_input_set_handle_hook"); - pragma Inline (value_input_set_handle_hook); - - - - - function new_fl_value_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_value_input, "new_fl_value_input"); - pragma Inline (new_fl_value_input); - - procedure free_fl_value_input - (A : in System.Address); - pragma Import (C, free_fl_value_input, "free_fl_value_input"); - pragma Inline (free_fl_value_input); - - - - - function fl_value_input_get_input - (V : in System.Address) - return System.Address; - pragma Import (C, fl_value_input_get_input, "fl_value_input_get_input"); - pragma Inline (fl_value_input_get_input); - - - - - function fl_value_input_get_cursor_color - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_value_input_get_cursor_color, "fl_value_input_get_cursor_color"); - pragma Inline (fl_value_input_get_cursor_color); - - procedure fl_value_input_set_cursor_color - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_value_input_set_cursor_color, "fl_value_input_set_cursor_color"); - pragma Inline (fl_value_input_set_cursor_color); - - - - - function fl_value_input_get_shortcut - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_input_get_shortcut, "fl_value_input_get_shortcut"); - pragma Inline (fl_value_input_get_shortcut); - - procedure fl_value_input_set_shortcut - (B : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_value_input_set_shortcut, "fl_value_input_set_shortcut"); - pragma Inline (fl_value_input_set_shortcut); - - - - - function fl_value_input_is_soft - (A : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_input_is_soft, "fl_value_input_is_soft"); - pragma Inline (fl_value_input_is_soft); - - procedure fl_value_input_set_soft - (A : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_value_input_set_soft, "fl_value_input_set_soft"); - pragma Inline (fl_value_input_set_soft); - - - - - function fl_value_input_get_text_color - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_value_input_get_text_color, "fl_value_input_get_text_color"); - pragma Inline (fl_value_input_get_text_color); - - procedure fl_value_input_set_text_color - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_value_input_set_text_color, "fl_value_input_set_text_color"); - pragma Inline (fl_value_input_set_text_color); - - function fl_value_input_get_text_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_input_get_text_font, "fl_value_input_get_text_font"); - pragma Inline (fl_value_input_get_text_font); - - procedure fl_value_input_set_text_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_value_input_set_text_font, "fl_value_input_set_text_font"); - pragma Inline (fl_value_input_set_text_font); - - function fl_value_input_get_text_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_input_get_text_size, "fl_value_input_get_text_size"); - pragma Inline (fl_value_input_get_text_size); - - procedure fl_value_input_set_text_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_value_input_set_text_size, "fl_value_input_set_text_size"); - pragma Inline (fl_value_input_set_text_size); - - - - - procedure fl_value_input_draw - (W : in System.Address); - pragma Import (C, fl_value_input_draw, "fl_value_input_draw"); - pragma Inline (fl_value_input_draw); - - function fl_value_input_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_value_input_handle, "fl_value_input_handle"); - pragma Inline (fl_value_input_handle); - - - - - procedure Free is new Ada.Unchecked_Deallocation - (INP.Input, Input_Access); - - - - - procedure Finalize - (This : in out Value_Input) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Value_Input'Class - then - free_fl_value_input (This.Void_Ptr); - Free (This.My_Input); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Value_Input is - begin - return This : Value_Input do - This.Void_Ptr := new_fl_value_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - - This.My_Input := new INP.Input; - Wrapper (This.My_Input.all).Void_Ptr := - fl_value_input_get_input (This.Void_Ptr); - Wrapper (This.My_Input.all).Needs_Dealloc := False; - end return; - end Create; - - end Forge; - - - - - function Input - (This : in Value_Input) - return FLTK.Widgets.Inputs.Input_Reference is - begin - return (Data => This.My_Input); - end Input; - - - - - function Get_Cursor_Color - (This : in Value_Input) - return Color is - begin - return Color (fl_value_input_get_cursor_color (This.Void_Ptr)); - end Get_Cursor_Color; - - - procedure Set_Cursor_Color - (This : in out Value_Input; - Col : in Color) is - begin - fl_value_input_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); - end Set_Cursor_Color; - - - - - function Get_Shortcut - (This : in Value_Input) - return Key_Combo is - begin - return To_Ada (Interfaces.C.unsigned_long (fl_value_input_get_shortcut (This.Void_Ptr))); - end Get_Shortcut; - - - procedure Set_Shortcut - (This : in out Value_Input; - Key : in Key_Combo) is - begin - fl_value_input_set_shortcut (This.Void_Ptr, Interfaces.C.int (To_C (Key))); - end Set_Shortcut; - - - - - function Is_Soft - (This : in Value_Input) - return Boolean is - begin - return fl_value_input_is_soft (This.Void_Ptr) /= 0; - end Is_Soft; - - - procedure Set_Soft - (This : in out Value_Input; - To : in Boolean) is - begin - fl_value_input_set_soft (This.Void_Ptr, Boolean'Pos (To)); - end Set_Soft; - - - - - function Get_Text_Color - (This : in Value_Input) - return Color is - begin - return Color (fl_value_input_get_text_color (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Value_Input; - Col : in Color) is - begin - fl_value_input_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Value_Input) - return Font_Kind is - begin - return Font_Kind'Val (fl_value_input_get_text_font (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Value_Input; - Font : in Font_Kind) is - begin - fl_value_input_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Value_Input) - return Font_Size is - begin - return Font_Size (fl_value_input_get_text_size (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Value_Input; - Size : in Font_Size) is - begin - fl_value_input_set_text_size (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - procedure Draw - (This : in out Value_Input) is - begin - fl_value_input_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Value_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_value_input_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Value_Inputs; - diff --git a/src/fltk-widgets-valuators-value_inputs.ads b/src/fltk-widgets-valuators-value_inputs.ads deleted file mode 100644 index fbf0fdf..0000000 --- a/src/fltk-widgets-valuators-value_inputs.ads +++ /dev/null @@ -1,154 +0,0 @@ - - -with - - FLTK.Widgets.Inputs; - - -package FLTK.Widgets.Valuators.Value_Inputs is - - - type Value_Input is new Valuator with private; - - type Value_Input_Reference (Data : not null access Value_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 Value_Input; - - end Forge; - - - - - function Input - (This : in Value_Input) - return FLTK.Widgets.Inputs.Input_Reference; - - - - - function Get_Cursor_Color - (This : in Value_Input) - return Color; - - procedure Set_Cursor_Color - (This : in out Value_Input; - Col : in Color); - - - - - function Get_Shortcut - (This : in Value_Input) - return Key_Combo; - - procedure Set_Shortcut - (This : in out Value_Input; - Key : in Key_Combo); - - - - - function Is_Soft - (This : in Value_Input) - return Boolean; - - procedure Set_Soft - (This : in out Value_Input; - To : in Boolean); - - - - - function Get_Text_Color - (This : in Value_Input) - return Color; - - procedure Set_Text_Color - (This : in out Value_Input; - Col : in Color); - - function Get_Text_Font - (This : in Value_Input) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Value_Input; - Font : in Font_Kind); - - function Get_Text_Size - (This : in Value_Input) - return Font_Size; - - procedure Set_Text_Size - (This : in out Value_Input; - Size : in Font_Size); - - - - - procedure Draw - (This : in out Value_Input); - - function Handle - (This : in out Value_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - package INP renames FLTK.Widgets.Inputs; - - - type Input_Access is access INP.Input; - - - type Value_Input is new Valuator with record - My_Input : Input_Access; - end record; - - overriding procedure Finalize - (This : in out Value_Input); - - - - - pragma Inline (Input); - - - pragma Inline (Get_Cursor_Color); - pragma Inline (Set_Cursor_Color); - - - pragma Inline (Get_Shortcut); - pragma Inline (Set_Shortcut); - - - pragma Inline (Is_Soft); - pragma Inline (Set_Soft); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Value_Inputs; - diff --git a/src/fltk-widgets-valuators-value_outputs.adb b/src/fltk-widgets-valuators-value_outputs.adb deleted file mode 100644 index 0c99ace..0000000 --- a/src/fltk-widgets-valuators-value_outputs.adb +++ /dev/null @@ -1,243 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - Interfaces.C.int, - System.Address; - - -package body FLTK.Widgets.Valuators.Value_Outputs is - - - procedure value_output_set_draw_hook - (W, D : in System.Address); - pragma Import (C, value_output_set_draw_hook, "value_output_set_draw_hook"); - pragma Inline (value_output_set_draw_hook); - - procedure value_output_set_handle_hook - (W, H : in System.Address); - pragma Import (C, value_output_set_handle_hook, "value_output_set_handle_hook"); - pragma Inline (value_output_set_handle_hook); - - - - - function new_fl_value_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_value_output, "new_fl_value_output"); - pragma Inline (new_fl_value_output); - - procedure free_fl_value_output - (A : in System.Address); - pragma Import (C, free_fl_value_output, "free_fl_value_output"); - pragma Inline (free_fl_value_output); - - - - - function fl_value_output_is_soft - (A : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_output_is_soft, "fl_value_output_is_soft"); - pragma Inline (fl_value_output_is_soft); - - procedure fl_value_output_set_soft - (A : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_value_output_set_soft, "fl_value_output_set_soft"); - pragma Inline (fl_value_output_set_soft); - - - - - function fl_value_output_get_text_color - (TD : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_value_output_get_text_color, "fl_value_output_get_text_color"); - pragma Inline (fl_value_output_get_text_color); - - procedure fl_value_output_set_text_color - (TD : in System.Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_value_output_set_text_color, "fl_value_output_set_text_color"); - pragma Inline (fl_value_output_set_text_color); - - function fl_value_output_get_text_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_output_get_text_font, "fl_value_output_get_text_font"); - pragma Inline (fl_value_output_get_text_font); - - procedure fl_value_output_set_text_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_value_output_set_text_font, "fl_value_output_set_text_font"); - pragma Inline (fl_value_output_set_text_font); - - function fl_value_output_get_text_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_value_output_get_text_size, "fl_value_output_get_text_size"); - pragma Inline (fl_value_output_get_text_size); - - procedure fl_value_output_set_text_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_value_output_set_text_size, "fl_value_output_set_text_size"); - pragma Inline (fl_value_output_set_text_size); - - - - - procedure fl_value_output_draw - (W : in System.Address); - pragma Import (C, fl_value_output_draw, "fl_value_output_draw"); - pragma Inline (fl_value_output_draw); - - function fl_value_output_handle - (W : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_value_output_handle, "fl_value_output_handle"); - pragma Inline (fl_value_output_handle); - - - - - procedure Finalize - (This : in out Value_Output) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Value_Output'Class - then - free_fl_value_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Valuator (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Value_Output is - begin - return This : Value_Output do - This.Void_Ptr := new_fl_value_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Is_Soft - (This : in Value_Output) - return Boolean is - begin - return fl_value_output_is_soft (This.Void_Ptr) /= 0; - end Is_Soft; - - - procedure Set_Soft - (This : in out Value_Output; - To : in Boolean) is - begin - fl_value_output_set_soft (This.Void_Ptr, Boolean'Pos (To)); - end Set_Soft; - - - - - function Get_Text_Color - (This : in Value_Output) - return Color is - begin - return Color (fl_value_output_get_text_color (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Value_Output; - Col : in Color) is - begin - fl_value_output_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Value_Output) - return Font_Kind is - begin - return Font_Kind'Val (fl_value_output_get_text_font (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Value_Output; - Font : in Font_Kind) is - begin - fl_value_output_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Value_Output) - return Font_Size is - begin - return Font_Size (fl_value_output_get_text_size (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Value_Output; - Size : in Font_Size) is - begin - fl_value_output_set_text_size (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - procedure Draw - (This : in out Value_Output) is - begin - fl_value_output_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Value_Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_value_output_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators.Value_Outputs; - diff --git a/src/fltk-widgets-valuators-value_outputs.ads b/src/fltk-widgets-valuators-value_outputs.ads deleted file mode 100644 index 5cc5fc4..0000000 --- a/src/fltk-widgets-valuators-value_outputs.ads +++ /dev/null @@ -1,101 +0,0 @@ - - -package FLTK.Widgets.Valuators.Value_Outputs is - - - type Value_Output is new Valuator with private; - - type Value_Output_Reference (Data : not null access Value_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 Value_Output; - - end Forge; - - - - - function Is_Soft - (This : in Value_Output) - return Boolean; - - procedure Set_Soft - (This : in out Value_Output; - To : in Boolean); - - - - - function Get_Text_Color - (This : in Value_Output) - return Color; - - procedure Set_Text_Color - (This : in out Value_Output; - Col : in Color); - - function Get_Text_Font - (This : in Value_Output) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Value_Output; - Font : in Font_Kind); - - function Get_Text_Size - (This : in Value_Output) - return Font_Size; - - procedure Set_Text_Size - (This : in out Value_Output; - Size : in Font_Size); - - - - - procedure Draw - (This : in out Value_Output); - - function Handle - (This : in out Value_Output; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Value_Output is new Valuator with null record; - - overriding procedure Finalize - (This : in out Value_Output); - - - - - pragma Inline (Is_Soft); - pragma Inline (Set_Soft); - - - pragma Inline (Get_Text_Color); - pragma Inline (Set_Text_Color); - pragma Inline (Get_Text_Font); - pragma Inline (Set_Text_Font); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators.Value_Outputs; - diff --git a/src/fltk-widgets-valuators.adb b/src/fltk-widgets-valuators.adb deleted file mode 100644 index f7515d2..0000000 --- a/src/fltk-widgets-valuators.adb +++ /dev/null @@ -1,331 +0,0 @@ - - -with - - Interfaces.C.Strings, - System; - -use type - - System.Address; - - -package body FLTK.Widgets.Valuators is - - - procedure valuator_set_draw_hook - (W, D : in System.Address); - pragma Import (C, valuator_set_draw_hook, "valuator_set_draw_hook"); - pragma Inline (valuator_set_draw_hook); - - procedure valuator_set_handle_hook - (W, H : in System.Address); - pragma Import (C, valuator_set_handle_hook, "valuator_set_handle_hook"); - pragma Inline (valuator_set_handle_hook); - - - - - function new_fl_valuator - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_valuator, "new_fl_valuator"); - pragma Inline (new_fl_valuator); - - procedure free_fl_valuator - (V : in System.Address); - pragma Import (C, free_fl_valuator, "free_fl_valuator"); - pragma Inline (free_fl_valuator); - - - - - function fl_valuator_clamp - (V : in System.Address; - D : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_valuator_clamp, "fl_valuator_clamp"); - pragma Inline (fl_valuator_clamp); - - function fl_valuator_round - (V : in System.Address; - D : in Interfaces.C.double) - return Interfaces.C.double; - pragma Import (C, fl_valuator_round, "fl_valuator_round"); - pragma Inline (fl_valuator_round); - - function fl_valuator_increment - (V : in System.Address; - D : in Interfaces.C.double; - S : in Interfaces.C.int) - return Interfaces.C.double; - pragma Import (C, fl_valuator_increment, "fl_valuator_increment"); - pragma Inline (fl_valuator_increment); - - - - - function fl_valuator_get_minimum - (V : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_valuator_get_minimum, "fl_valuator_get_minimum"); - pragma Inline (fl_valuator_get_minimum); - - procedure fl_valuator_set_minimum - (V : in System.Address; - D : in Interfaces.C.double); - pragma Import (C, fl_valuator_set_minimum, "fl_valuator_set_minimum"); - pragma Inline (fl_valuator_set_minimum); - - function fl_valuator_get_maximum - (V : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_valuator_get_maximum, "fl_valuator_get_maximum"); - pragma Inline (fl_valuator_get_maximum); - - procedure fl_valuator_set_maximum - (V : in System.Address; - D : in Interfaces.C.double); - pragma Import (C, fl_valuator_set_maximum, "fl_valuator_set_maximum"); - pragma Inline (fl_valuator_set_maximum); - - function fl_valuator_get_step - (V : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_valuator_get_step, "fl_valuator_get_step"); - pragma Inline (fl_valuator_get_step); - - procedure fl_valuator_set_step - (V : in System.Address; - T : in Interfaces.C.double); - pragma Import (C, fl_valuator_set_step, "fl_valuator_set_step"); - pragma Inline (fl_valuator_set_step); - - function fl_valuator_get_value - (V : in System.Address) - return Interfaces.C.double; - pragma Import (C, fl_valuator_get_value, "fl_valuator_get_value"); - pragma Inline (fl_valuator_get_value); - - procedure fl_valuator_set_value - (V : in System.Address; - D : in Interfaces.C.double); - pragma Import (C, fl_valuator_set_value, "fl_valuator_set_value"); - pragma Inline (fl_valuator_set_value); - - procedure fl_valuator_bounds - (V : in System.Address; - A, B : in Interfaces.C.double); - pragma Import (C, fl_valuator_bounds, "fl_valuator_bounds"); - pragma Inline (fl_valuator_bounds); - - procedure fl_valuator_precision - (V : in System.Address; - D : in Interfaces.C.int); - pragma Import (C, fl_valuator_precision, "fl_valuator_precision"); - pragma Inline (fl_valuator_precision); - - procedure fl_valuator_range - (V : in System.Address; - A, B : in Interfaces.C.double); - pragma Import (C, fl_valuator_range, "fl_valuator_range"); - pragma Inline (fl_valuator_range); - - - - - function fl_valuator_handle - (V : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_valuator_handle, "fl_valuator_handle"); - pragma Inline (fl_valuator_handle); - - - - - procedure Finalize - (This : in out Valuator) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Valuator'Class - then - free_fl_valuator (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - Finalize (Widget (This)); - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Valuator is - begin - return This : Valuator do - This.Void_Ptr := new_fl_valuator - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - valuator_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - valuator_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - function Clamp - (This : in Valuator; - Input : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_valuator_clamp (This.Void_Ptr, Interfaces.C.double (Input))); - end Clamp; - - - function Round - (This : in Valuator; - Input : in Long_Float) - return Long_Float is - begin - return Long_Float (fl_valuator_round (This.Void_Ptr, Interfaces.C.double (Input))); - end Round; - - - function Increment - (This : in Valuator; - Input : in Long_Float; - Step : in Integer) - return Long_Float is - begin - return Long_Float (fl_valuator_increment - (This.Void_Ptr, - Interfaces.C.double (Input), - Interfaces.C.int (Step))); - end Increment; - - - - - function Get_Minimum - (This : in Valuator) - return Long_Float is - begin - return Long_Float (fl_valuator_get_minimum (This.Void_Ptr)); - end Get_Minimum; - - - procedure Set_Minimum - (This : in out Valuator; - To : in Long_Float) is - begin - fl_valuator_set_minimum (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Minimum; - - - function Get_Maximum - (This : in Valuator) - return Long_Float is - begin - return Long_Float (fl_valuator_get_maximum (This.Void_Ptr)); - end Get_Maximum; - - - procedure Set_Maximum - (This : in out Valuator; - To : in Long_Float) is - begin - fl_valuator_set_maximum (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Maximum; - - - function Get_Step - (This : in Valuator) - return Long_Float is - begin - return Long_Float (fl_valuator_get_step (This.Void_Ptr)); - end Get_Step; - - - procedure Set_Step - (This : in out Valuator; - To : in Long_Float) is - begin - fl_valuator_set_step (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Step; - - - function Get_Value - (This : in Valuator) - return Long_Float is - begin - return Long_Float (fl_valuator_get_value (This.Void_Ptr)); - end Get_Value; - - - procedure Set_Value - (This : in out Valuator; - To : in Long_Float) is - begin - fl_valuator_set_value (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Value; - - - procedure Set_Bounds - (This : in out Valuator; - Min, Max : in Long_Float) is - begin - fl_valuator_bounds - (This.Void_Ptr, - Interfaces.C.double (Min), - Interfaces.C.double (Max)); - end Set_Bounds; - - - procedure Set_Precision - (This : in out Valuator; - To : in Integer) is - begin - fl_valuator_precision (This.Void_Ptr, Interfaces.C.int (To)); - end Set_Precision; - - - procedure Set_Range - (This : in out Valuator; - Min, Max : in Long_Float) is - begin - fl_valuator_range - (This.Void_Ptr, - Interfaces.C.double (Min), - Interfaces.C.double (Max)); - end Set_Range; - - - - - function Handle - (This : in out Valuator; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_valuator_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Valuators; - diff --git a/src/fltk-widgets-valuators.ads b/src/fltk-widgets-valuators.ads deleted file mode 100644 index 1f16b0c..0000000 --- a/src/fltk-widgets-valuators.ads +++ /dev/null @@ -1,131 +0,0 @@ - - -package FLTK.Widgets.Valuators is - - - type Valuator is new Widget with private; - - type Valuator_Reference (Data : not null access Valuator'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Valuator; - - end Forge; - - - - - function Clamp - (This : in Valuator; - Input : in Long_Float) - return Long_Float; - - function Round - (This : in Valuator; - Input : in Long_Float) - return Long_Float; - - function Increment - (This : in Valuator; - Input : in Long_Float; - Step : in Integer) - return Long_Float; - - - - - function Get_Minimum - (This : in Valuator) - return Long_Float; - - procedure Set_Minimum - (This : in out Valuator; - To : in Long_Float); - - function Get_Maximum - (This : in Valuator) - return Long_Float; - - procedure Set_Maximum - (This : in out Valuator; - To : in Long_Float); - - function Get_Step - (This : in Valuator) - return Long_Float; - - procedure Set_Step - (This : in out Valuator; - To : in Long_Float); - - function Get_Value - (This : in Valuator) - return Long_Float; - - procedure Set_Value - (This : in out Valuator; - To : in Long_Float); - - procedure Set_Bounds - (This : in out Valuator; - Min, Max : in Long_Float); - - procedure Set_Precision - (This : in out Valuator; - To : in Integer); - - procedure Set_Range - (This : in out Valuator; - Min, Max : in Long_Float); - - - - - function Handle - (This : in out Valuator; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Valuator is new Widget with null record; - - overriding procedure Finalize - (This : in out Valuator); - - - - - pragma Inline (Clamp); - pragma Inline (Round); - pragma Inline (Increment); - - - pragma Inline (Get_Minimum); - pragma Inline (Set_Minimum); - pragma Inline (Get_Maximum); - pragma Inline (Set_Maximum); - pragma Inline (Get_Step); - pragma Inline (Set_Step); - pragma Inline (Get_Value); - pragma Inline (Set_Value); - pragma Inline (Set_Bounds); - pragma Inline (Set_Precision); - pragma Inline (Set_Range); - - - pragma Inline (Handle); - - -end FLTK.Widgets.Valuators; - diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb deleted file mode 100644 index f08639b..0000000 --- a/src/fltk-widgets.adb +++ /dev/null @@ -1,1177 +0,0 @@ - - -with - - Interfaces.C.Strings, - System.Address_To_Access_Conversions, - FLTK.Widgets.Groups.Windows, - FLTK.Images; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned, - Interfaces.C.Strings.chars_ptr, - System.Address; - - -package body FLTK.Widgets is - - - function "+" - (Left, Right : in Callback_Flag) - return Callback_Flag is - begin - return Left or Right; - end "+"; - - - - - package Group_Convert is new - System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); - - package Window_Convert is new - System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Windows.Window'Class); - - - - - procedure widget_set_draw_hook - (W, D : in System.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 System.Address); - pragma Import (C, widget_set_handle_hook, "widget_set_handle_hook"); - pragma Inline (widget_set_handle_hook); - - - - - function new_fl_widget - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_widget, "new_fl_widget"); - pragma Inline (new_fl_widget); - - procedure free_fl_widget - (F : in System.Address); - pragma Import (C, free_fl_widget, "free_fl_widget"); - pragma Inline (free_fl_widget); - - - - - procedure fl_widget_activate - (W : in System.Address); - pragma Import (C, fl_widget_activate, "fl_widget_activate"); - pragma Inline (fl_widget_activate); - - procedure fl_widget_deactivate - (W : in System.Address); - pragma Import (C, fl_widget_deactivate, "fl_widget_deactivate"); - pragma Inline (fl_widget_deactivate); - - function fl_widget_active - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_active, "fl_widget_active"); - pragma Inline (fl_widget_active); - - function fl_widget_active_r - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_active_r, "fl_widget_active_r"); - pragma Inline (fl_widget_active_r); - - procedure fl_widget_set_active - (W : in System.Address); - pragma Import (C, fl_widget_set_active, "fl_widget_set_active"); - pragma Inline (fl_widget_set_active); - - procedure fl_widget_clear_active - (W : in System.Address); - pragma Import (C, fl_widget_clear_active, "fl_widget_clear_active"); - pragma Inline (fl_widget_clear_active); - - - - - function fl_widget_changed - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_changed, "fl_widget_changed"); - pragma Inline (fl_widget_changed); - - procedure fl_widget_set_changed - (W : in System.Address); - pragma Import (C, fl_widget_set_changed, "fl_widget_set_changed"); - pragma Inline (fl_widget_set_changed); - - procedure fl_widget_clear_changed - (W : in System.Address); - pragma Import (C, fl_widget_clear_changed, "fl_widget_clear_changed"); - pragma Inline (fl_widget_clear_changed); - - function fl_widget_output - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_output, "fl_widget_output"); - pragma Inline (fl_widget_output); - - procedure fl_widget_set_output - (W : in System.Address); - pragma Import (C, fl_widget_set_output, "fl_widget_set_output"); - pragma Inline (fl_widget_set_output); - - procedure fl_widget_clear_output - (W : in System.Address); - pragma Import (C, fl_widget_clear_output, "fl_widget_clear_output"); - pragma Inline (fl_widget_clear_output); - - function fl_widget_visible - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_visible, "fl_widget_visible"); - pragma Inline (fl_widget_visible); - - function fl_widget_visible_r - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_visible_r, "fl_widget_visible_r"); - pragma Inline (fl_widget_visible_r); - - procedure fl_widget_set_visible - (W : in System.Address); - pragma Import (C, fl_widget_set_visible, "fl_widget_set_visible"); - pragma Inline (fl_widget_set_visible); - - procedure fl_widget_clear_visible - (W : in System.Address); - pragma Import (C, fl_widget_clear_visible, "fl_widget_clear_visible"); - pragma Inline (fl_widget_clear_visible); - - - - - function fl_widget_get_visible_focus - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_visible_focus, "fl_widget_get_visible_focus"); - pragma Inline (fl_widget_get_visible_focus); - - procedure fl_widget_set_visible_focus - (W : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_widget_set_visible_focus, "fl_widget_set_visible_focus"); - pragma Inline (fl_widget_set_visible_focus); - - function fl_widget_take_focus - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_take_focus, "fl_widget_take_focus"); - pragma Inline (fl_widget_take_focus); - - function fl_widget_takesevents - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_takesevents, "fl_widget_takesevents"); - pragma Inline (fl_widget_takesevents); - - - - - function fl_widget_get_color - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_get_color, "fl_widget_get_color"); - pragma Inline (fl_widget_get_color); - - procedure fl_widget_set_color - (W : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_set_color, "fl_widget_set_color"); - pragma Inline (fl_widget_set_color); - - function fl_widget_get_selection_color - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_get_selection_color, "fl_widget_get_selection_color"); - pragma Inline (fl_widget_get_selection_color); - - procedure fl_widget_set_selection_color - (W : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_set_selection_color, "fl_widget_set_selection_color"); - pragma Inline (fl_widget_set_selection_color); - - - - - function fl_widget_get_parent - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); - pragma Inline (fl_widget_get_parent); - - function fl_widget_contains - (W, I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_contains, "fl_widget_contains"); - pragma Inline (fl_widget_contains); - - function fl_widget_inside - (W, P : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_inside, "fl_widget_inside"); - pragma Inline (fl_widget_inside); - - function fl_widget_window - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_window, "fl_widget_window"); - pragma Inline (fl_widget_window); - - function fl_widget_top_window - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_top_window, "fl_widget_top_window"); - pragma Inline (fl_widget_top_window); - - function fl_widget_top_window_offset - (W : in System.Address; - X, Y : out Interfaces.C.int) - return System.Address; - pragma Import (C, fl_widget_top_window_offset, "fl_widget_top_window_offset"); - pragma Inline (fl_widget_top_window_offset); - - - - - function fl_widget_get_align - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_get_align, "fl_widget_get_align"); - pragma Inline (fl_widget_get_align); - - procedure fl_widget_set_align - (W : in System.Address; - A : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_set_align, "fl_widget_set_align"); - pragma Inline (fl_widget_set_align); - - function fl_widget_get_box - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); - pragma Inline (fl_widget_get_box); - - procedure fl_widget_set_box - (W : in System.Address; - B : in Interfaces.C.int); - pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); - pragma Inline (fl_widget_set_box); - - function fl_widget_tooltip - (W : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_widget_tooltip, "fl_widget_tooltip"); - pragma Inline (fl_widget_tooltip); - - procedure fl_widget_copy_tooltip - (W : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_widget_copy_tooltip, "fl_widget_copy_tooltip"); - pragma Inline (fl_widget_copy_tooltip); - - - - - function fl_widget_get_label - (W : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); - pragma Inline (fl_widget_get_label); - - function fl_widget_get_labelcolor - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_get_labelcolor, "fl_widget_get_labelcolor"); - pragma Inline (fl_widget_get_labelcolor); - - procedure fl_widget_set_labelcolor - (W : in System.Address; - V : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_set_labelcolor, "fl_widget_set_labelcolor"); - pragma Inline (fl_widget_set_labelcolor); - - function fl_widget_get_labelfont - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_labelfont, "fl_widget_get_labelfont"); - pragma Inline (fl_widget_get_labelfont); - - procedure fl_widget_set_labelfont - (W : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_widget_set_labelfont, "fl_widget_set_labelfont"); - pragma Inline (fl_widget_set_labelfont); - - function fl_widget_get_labelsize - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_labelsize, "fl_widget_get_labelsize"); - pragma Inline (fl_widget_get_labelsize); - - procedure fl_widget_set_labelsize - (W : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_widget_set_labelsize, "fl_widget_set_labelsize"); - pragma Inline (fl_widget_set_labelsize); - - function fl_widget_get_labeltype - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_labeltype, "fl_widget_get_labeltype"); - pragma Inline (fl_widget_get_labeltype); - - procedure fl_widget_set_labeltype - (W : in System.Address; - L : in Interfaces.C.int); - pragma Import (C, fl_widget_set_labeltype, "fl_widget_set_labeltype"); - pragma Inline (fl_widget_set_labeltype); - - procedure fl_widget_measure_label - (W : in System.Address; - D, H : out Interfaces.C.int); - pragma Import (C, fl_widget_measure_label, "fl_widget_measure_label"); - pragma Inline (fl_widget_measure_label); - - - - - procedure fl_widget_set_callback - (W, C : in System.Address); - pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); - pragma Inline (fl_widget_set_callback); - - function fl_widget_get_when - (W : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_widget_get_when, "fl_widget_get_when"); - pragma Inline (fl_widget_get_when); - - procedure fl_widget_set_when - (W : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_set_when, "fl_widget_set_when"); - pragma Inline (fl_widget_set_when); - - - - - function fl_widget_get_x - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_x, "fl_widget_get_x"); - pragma Inline (fl_widget_get_x); - - function fl_widget_get_y - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_y, "fl_widget_get_y"); - pragma Inline (fl_widget_get_y); - - function fl_widget_get_w - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_w, "fl_widget_get_w"); - pragma Inline (fl_widget_get_w); - - function fl_widget_get_h - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_h, "fl_widget_get_h"); - pragma Inline (fl_widget_get_h); - - procedure fl_widget_size - (W : in System.Address; - D, H : in Interfaces.C.int); - pragma Import (C, fl_widget_size, "fl_widget_size"); - pragma Inline (fl_widget_size); - - procedure fl_widget_position - (W : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_widget_position, "fl_widget_position"); - pragma Inline (fl_widget_position); - - - - - procedure fl_widget_set_image - (W, I : in System.Address); - pragma Import (C, fl_widget_set_image, "fl_widget_set_image"); - pragma Inline (fl_widget_set_image); - - procedure fl_widget_set_deimage - (W, I : in System.Address); - pragma Import (C, fl_widget_set_deimage, "fl_widget_set_deimage"); - pragma Inline (fl_widget_set_deimage); - - - - - function fl_widget_damage - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_damage, "fl_widget_damage"); - pragma Inline (fl_widget_damage); - - procedure fl_widget_set_damage - (W : in System.Address; - T : in Interfaces.C.int); - pragma Import (C, fl_widget_set_damage, "fl_widget_set_damage"); - pragma Inline (fl_widget_set_damage); - - procedure fl_widget_set_damage2 - (W : in System.Address; - T : in Interfaces.C.int; - X, Y, D, H : in Interfaces.C.int); - pragma Import (C, fl_widget_set_damage2, "fl_widget_set_damage2"); - pragma Inline (fl_widget_set_damage2); - - procedure fl_widget_draw_label - (W : in System.Address; - X, Y, D, H : in Interfaces.C.int; - A : in Interfaces.C.unsigned); - pragma Import (C, fl_widget_draw_label, "fl_widget_draw_label"); - pragma Inline (fl_widget_draw_label); - - procedure fl_widget_redraw - (W : in System.Address); - pragma Import (C, fl_widget_redraw, "fl_widget_redraw"); - pragma Inline (fl_widget_redraw); - - procedure fl_widget_redraw_label - (W : in System.Address); - pragma Import (C, fl_widget_redraw_label, "fl_widget_redraw_label"); - pragma Inline (fl_widget_redraw_label); - - - - - procedure Callback_Hook - (W, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); - begin - Ada_Widget.Callback.all (Ada_Widget.all); - end Callback_Hook; - - - procedure Draw_Hook - (U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); - begin - Ada_Widget.Draw; - end Draw_Hook; - - - function Handle_Hook - (U : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); - begin - return Event_Outcome'Pos (Ada_Widget.Handle (Event_Kind'Val (E))); - end Handle_Hook; - - - - - procedure Finalize - (This : in out Widget) is - begin - if This.Void_Ptr /= System.Null_Address and then - This in Widget'Class - then - free_fl_widget (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; - end if; - end Finalize; - - - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Widget is - begin - return This : Widget do - This.Void_Ptr := new_fl_widget - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - widget_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - widget_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end return; - end Create; - - end Forge; - - - - - procedure Activate - (This : in out Widget) is - begin - fl_widget_activate (This.Void_Ptr); - end Activate; - - - procedure Deactivate - (This : in out Widget) is - begin - fl_widget_deactivate (This.Void_Ptr); - end Deactivate; - - - function Is_Active - (This : in Widget) - return Boolean is - begin - return fl_widget_active (This.Void_Ptr) /= 0; - end Is_Active; - - - function Is_Tree_Active - (This : in Widget) - return Boolean is - begin - return fl_widget_active_r (This.Void_Ptr) /= 0; - end Is_Tree_Active; - - - procedure Set_Active - (This : in out Widget; - To : in Boolean) is - begin - if To then - fl_widget_set_active (This.Void_Ptr); - else - fl_widget_clear_active (This.Void_Ptr); - end if; - end Set_Active; - - - - - function Has_Changed - (This : in Widget) - return Boolean is - begin - return fl_widget_changed (This.Void_Ptr) /= 0; - end Has_Changed; - - - procedure Set_Changed - (This : in out Widget; - To : in Boolean) is - begin - if To then - fl_widget_set_changed (This.Void_Ptr); - else - fl_widget_clear_changed (This.Void_Ptr); - end if; - end Set_Changed; - - - function Is_Output_Only - (This : in Widget) - return Boolean is - begin - return fl_widget_output (This.Void_Ptr) /= 0; - end Is_Output_Only; - - - procedure Set_Output_Only - (This : in out Widget; - To : in Boolean) is - begin - if To then - fl_widget_set_output (This.Void_Ptr); - else - fl_widget_clear_output (This.Void_Ptr); - end if; - end Set_Output_Only; - - - function Is_Visible - (This : in Widget) - return Boolean is - begin - return fl_widget_visible (This.Void_Ptr) /= 0; - end Is_Visible; - - - function Is_Tree_Visible - (This : in Widget) - return Boolean is - begin - return fl_widget_visible_r (This.Void_Ptr) /= 0; - end Is_Tree_Visible; - - - procedure Set_Visible - (This : in out Widget; - To : in Boolean) is - begin - if To then - fl_widget_set_visible (This.Void_Ptr); - else - fl_widget_clear_visible (This.Void_Ptr); - end if; - end Set_Visible; - - - - - function Has_Visible_Focus - (This : in Widget) - return Boolean is - begin - return fl_widget_get_visible_focus (This.Void_Ptr) /= 0; - end Has_Visible_Focus; - - - procedure Set_Visible_Focus - (This : in out Widget; - To : in Boolean) is - begin - fl_widget_set_visible_focus (This.Void_Ptr, Boolean'Pos (To)); - end Set_Visible_Focus; - - - function Take_Focus - (This : in out Widget) - return Boolean is - begin - return fl_widget_take_focus (This.Void_Ptr) /= 0; - end Take_Focus; - - - function Takes_Events - (This : in Widget) - return Boolean is - begin - return fl_widget_takesevents (This.Void_Ptr) /= 0; - end Takes_Events; - - - - - function Get_Background_Color - (This : in Widget) - return Color is - begin - return Color (fl_widget_get_color (This.Void_Ptr)); - end Get_Background_Color; - - - procedure Set_Background_Color - (This : in out Widget; - To : in Color) is - begin - fl_widget_set_color (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Background_Color; - - - function Get_Selection_Color - (This : in Widget) - return Color is - begin - return Color (fl_widget_get_selection_color (This.Void_Ptr)); - end Get_Selection_Color; - - - procedure Set_Selection_Color - (This : in out Widget; - To : in Color) is - begin - fl_widget_set_selection_color (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Selection_Color; - - - - - function Parent - (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class - is - Parent_Ptr : System.Address; - Actual_Parent : access FLTK.Widgets.Groups.Group'Class; - begin - Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); - if Parent_Ptr /= System.Null_Address then - Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); - end if; - return Actual_Parent; - end Parent; - - - function Contains - (This : in Widget; - Item : in Widget'Class) - return Boolean is - begin - return fl_widget_contains (This.Void_Ptr, Item.Void_Ptr) /= 0; - end Contains; - - - function Inside - (This : in Widget; - Parent : in Widget'Class) - return Boolean is - begin - return fl_widget_inside (This.Void_Ptr, Parent.Void_Ptr) /= 0; - end Inside; - - - function Nearest_Window - (This : in Widget) - return access FLTK.Widgets.Groups.Windows.Window'Class - is - Window_Ptr : System.Address; - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - Window_Ptr := fl_widget_window (This.Void_Ptr); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); - end if; - return Actual_Window; - end Nearest_Window; - - - function Top_Window - (This : in Widget) - return access FLTK.Widgets.Groups.Windows.Window'Class - is - Window_Ptr : System.Address; - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - Window_Ptr := fl_widget_top_window (This.Void_Ptr); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); - end if; - return Actual_Window; - end Top_Window; - - - function Top_Window_Offset - (This : in Widget; - Offset_X, Offset_Y : out Integer) - return access FLTK.Widgets.Groups.Windows.Window'Class - is - Window_Ptr : System.Address; - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - Window_Ptr := fl_widget_top_window_offset - (This.Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); - end if; - return Actual_Window; - end Top_Window_Offset; - - - - - function Get_Alignment - (This : in Widget) - return Alignment is - begin - return Alignment (fl_widget_get_align (This.Void_Ptr)); - end Get_Alignment; - - - procedure Set_Alignment - (This : in out Widget; - New_Align : in Alignment) is - begin - fl_widget_set_align (This.Void_Ptr, Interfaces.C.unsigned (New_Align)); - end Set_Alignment; - - - function Get_Box - (This : in Widget) - return Box_Kind is - begin - return Box_Kind'Val (fl_widget_get_box (This.Void_Ptr)); - end Get_Box; - - - procedure Set_Box - (This : in out Widget; - Box : in Box_Kind) is - begin - fl_widget_set_box (This.Void_Ptr, Box_Kind'Pos (Box)); - end Set_Box; - - - function Get_Tooltip - (This : in Widget) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_tooltip (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - -- no need for dealloc - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Tooltip; - - - procedure Set_Tooltip - (This : in out Widget; - Text : in String) is - begin - fl_widget_copy_tooltip (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Tooltip; - - - - - function Get_Label - (This : in Widget) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_get_label (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Label; - - - procedure Set_Label - (This : in out Widget; - Text : in String) is - begin - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Label; - - - function Get_Label_Color - (This : in Widget) - return Color is - begin - return Color (fl_widget_get_labelcolor (This.Void_Ptr)); - end Get_Label_Color; - - - procedure Set_Label_Color - (This : in out Widget; - Value : in Color) is - begin - fl_widget_set_labelcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); - end Set_Label_Color; - - - function Get_Label_Font - (This : in Widget) - return Font_Kind is - begin - return Font_Kind'Val (fl_widget_get_labelfont (This.Void_Ptr)); - end Get_Label_Font; - - - procedure Set_Label_Font - (This : in out Widget; - Font : in Font_Kind) is - begin - fl_widget_set_labelfont (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Label_Font; - - - function Get_Label_Size - (This : in Widget) - return Font_Size is - begin - return Font_Size (fl_widget_get_labelsize (This.Void_Ptr)); - end Get_Label_Size; - - - procedure Set_Label_Size - (This : in out Widget; - Size : in Font_Size) is - begin - fl_widget_set_labelsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Label_Size; - - - function Get_Label_Type - (This : in Widget) - return Label_Kind is - begin - return Label_Kind'Val (fl_widget_get_labeltype (This.Void_Ptr)); - end Get_Label_Type; - - - procedure Set_Label_Type - (This : in out Widget; - Label : in Label_Kind) is - begin - fl_widget_set_labeltype (This.Void_Ptr, Label_Kind'Pos (Label)); - end Set_Label_Type; - - - procedure Measure_Label - (This : in Widget; - W, H : out Integer) is - begin - fl_widget_measure_label - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Measure_Label; - - - - - function Get_Callback - (This : in Widget) - return Widget_Callback is - begin - return This.Callback; - end Get_Callback; - - - procedure Set_Callback - (This : in out Widget; - Func : in Widget_Callback) is - begin - if Func /= null then - This.Callback := Func; - fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); - end if; - end Set_Callback; - - - procedure Do_Callback - (This : in out Widget) is - begin - if This.Callback /= null then - This.Callback.all (This); - end if; - end Do_Callback; - - - function Get_When - (This : in Widget) - return Callback_Flag is - begin - return Callback_Flag (fl_widget_get_when (This.Void_Ptr)); - end Get_When; - - - procedure Set_When - (This : in out Widget; - To : in Callback_Flag) is - begin - fl_widget_set_when (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_When; - - - - - function Get_X - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_x (This.Void_Ptr)); - end Get_X; - - - function Get_Y - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_y (This.Void_Ptr)); - end Get_Y; - - - function Get_W - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_w (This.Void_Ptr)); - end Get_W; - - - function Get_H - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_h (This.Void_Ptr)); - end Get_H; - - - procedure Resize - (This : in out Widget; - W, H : in Integer) is - begin - fl_widget_size - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - procedure Reposition - (This : in out Widget; - X, Y : in Integer) is - begin - fl_widget_position - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Reposition; - - - - - function Get_Image - (This : in Widget) - return access FLTK.Images.Image'Class is - begin - return This.Current_Image; - end Get_Image; - - - procedure Set_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class) is - begin - This.Current_Image := Pic'Unchecked_Access; - fl_widget_set_image - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); - end Set_Image; - - - function Get_Inactive_Image - (This : in Widget) - return access FLTK.Images.Image'Class is - begin - return This.Inactive_Image; - end Get_Inactive_Image; - - - procedure Set_Inactive_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class) is - begin - This.Inactive_Image := Pic'Unchecked_Access; - fl_widget_set_deimage - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); - end Set_Inactive_Image; - - - - - function Is_Damaged - (This : in Widget) - return Boolean is - begin - return fl_widget_damage (This.Void_Ptr) /= 0; - end Is_Damaged; - - - procedure Set_Damaged - (This : in out Widget; - To : in Boolean) is - begin - fl_widget_set_damage (This.Void_Ptr, Boolean'Pos (To)); - end Set_Damaged; - - - procedure Set_Damaged - (This : in out Widget; - To : in Boolean; - X, Y, W, H : in Integer) is - begin - fl_widget_set_damage2 - (This.Void_Ptr, - Boolean'Pos (To), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Set_Damaged; - - - procedure Draw_Label - (This : in Widget; - X, Y, W, H : in Integer; - Align : in Alignment) is - begin - fl_widget_draw_label - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Align)); - end Draw_Label; - - - procedure Redraw - (This : in out Widget) is - begin - fl_widget_redraw (This.Void_Ptr); - end Redraw; - - - procedure Redraw_Label - (This : in out Widget) is - begin - fl_widget_redraw_label (This.Void_Ptr); - end Redraw_Label; - - - function Handle - (This : in out Widget; - Event : in Event_Kind) - return Event_Outcome is - begin - return Not_Handled; - end Handle; - - -end FLTK.Widgets; - diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads deleted file mode 100644 index 5ac6f49..0000000 --- a/src/fltk-widgets.ads +++ /dev/null @@ -1,511 +0,0 @@ - - -with - - FLTK.Images; - -limited with - - FLTK.Widgets.Groups.Windows; - -private with - - System.Address_To_Access_Conversions, - Ada.Unchecked_Conversion, - Interfaces.C; - - -package FLTK.Widgets is - - - type Widget is new Wrapper with private; - - type Widget_Reference (Data : not null access Widget'Class) is limited null record - with Implicit_Dereference => Data; - - type Widget_Callback is access procedure - (Item : in out Widget'Class); - - type Callback_Flag is private; - function "+" (Left, Right : in Callback_Flag) return Callback_Flag; - Call_Never : constant Callback_Flag; - When_Changed : constant Callback_Flag; - When_Interact : constant Callback_Flag; - When_Release : constant Callback_Flag; - When_Enter_Key : constant Callback_Flag; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Widget; - - end Forge; - - - - - procedure Activate - (This : in out Widget); - - procedure Deactivate - (This : in out Widget); - - function Is_Active - (This : in Widget) - return Boolean; - - function Is_Tree_Active - (This : in Widget) - return Boolean; - - procedure Set_Active - (This : in out Widget; - To : in Boolean); - - - - - function Has_Changed - (This : in Widget) - return Boolean; - - procedure Set_Changed - (This : in out Widget; - To : in Boolean); - - function Is_Output_Only - (This : in Widget) - return Boolean; - - procedure Set_Output_Only - (This : in out Widget; - To : in Boolean); - - function Is_Visible - (This : in Widget) - return Boolean; - - function Is_Tree_Visible - (This : in Widget) - return Boolean; - - procedure Set_Visible - (This : in out Widget; - To : in Boolean); - - - - - function Has_Visible_Focus - (This : in Widget) - return Boolean; - - procedure Set_Visible_Focus - (This : in out Widget; - To : in Boolean); - - function Take_Focus - (This : in out Widget) - return Boolean; - - function Takes_Events - (This : in Widget) - return Boolean; - - - - - function Get_Background_Color - (This : in Widget) - return Color; - - procedure Set_Background_Color - (This : in out Widget; - To : in Color); - - function Get_Selection_Color - (This : in Widget) - return Color; - - procedure Set_Selection_Color - (This : in out Widget; - To : in Color); - - - - - function Parent - (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class; - - function Contains - (This : in Widget; - Item : in Widget'Class) - return Boolean; - - function Inside - (This : in Widget; - Parent : in Widget'Class) - return Boolean; - - function Nearest_Window - (This : in Widget) - return access FLTK.Widgets.Groups.Windows.Window'Class; - - function Top_Window - (This : in Widget) - return access FLTK.Widgets.Groups.Windows.Window'Class; - - function Top_Window_Offset - (This : in Widget; - Offset_X, Offset_Y : out Integer) - return access FLTK.Widgets.Groups.Windows.Window'Class; - - - - - function Get_Alignment - (This : in Widget) - return Alignment; - - procedure Set_Alignment - (This : in out Widget; - New_Align : in Alignment); - - function Get_Box - (This : in Widget) - return Box_Kind; - - procedure Set_Box - (This : in out Widget; - Box : in Box_Kind); - - function Get_Tooltip - (This : in Widget) - return String; - - procedure Set_Tooltip - (This : in out Widget; - Text : in String); - - - - - function Get_Label - (This : in Widget) - return String; - - procedure Set_Label - (This : in out Widget; - Text : in String); - - function Get_Label_Color - (This : in Widget) - return Color; - - procedure Set_Label_Color - (This : in out Widget; - Value : in Color); - - function Get_Label_Font - (This : in Widget) - return Font_Kind; - - procedure Set_Label_Font - (This : in out Widget; - Font : in Font_Kind); - - function Get_Label_Size - (This : in Widget) - return Font_Size; - - procedure Set_Label_Size - (This : in out Widget; - Size : in Font_Size); - - function Get_Label_Type - (This : in Widget) - return Label_Kind; - - procedure Set_Label_Type - (This : in out Widget; - Label : in Label_Kind); - - procedure Measure_Label - (This : in Widget; - W, H : out Integer); - - - - - function Get_Callback - (This : in Widget) - return Widget_Callback; - - procedure Set_Callback - (This : in out Widget; - Func : in Widget_Callback); - - procedure Do_Callback - (This : in out Widget); - - function Get_When - (This : in Widget) - return Callback_Flag; - - procedure Set_When - (This : in out Widget; - To : in Callback_Flag); - - - - - function Get_X - (This : in Widget) - return Integer; - - function Get_Y - (This : in Widget) - return Integer; - - function Get_W - (This : in Widget) - return Integer; - - function Get_H - (This : in Widget) - return Integer; - - procedure Resize - (This : in out Widget; - W, H : in Integer); - - procedure Reposition - (This : in out Widget; - X, Y : in Integer); - - - - - function Get_Image - (This : in Widget) - return access FLTK.Images.Image'Class; - - procedure Set_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class); - - function Get_Inactive_Image - (This : in Widget) - return access FLTK.Images.Image'Class; - - procedure Set_Inactive_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class); - - - - - function Is_Damaged - (This : in Widget) - return Boolean; - - procedure Set_Damaged - (This : in out Widget; - To : in Boolean); - - procedure Set_Damaged - (This : in out Widget; - To : in Boolean; - X, Y, W, H : in Integer); - - procedure Draw - (This : in out Widget) is null; - - procedure Draw_Label - (This : in Widget; - X, Y, W, H : in Integer; - Align : in Alignment); - - procedure Redraw - (This : in out Widget); - - procedure Redraw_Label - (This : in out Widget); - - function Handle - (This : in out Widget; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Widget is new Wrapper with - record - Callback : Widget_Callback; - Current_Image : access FLTK.Images.Image'Class; - Inactive_Image : access FLTK.Images.Image'Class; - end record; - - overriding procedure Finalize - (This : in out Widget); - - - - - type Callback_Flag is new Interfaces.C.unsigned; - - Call_Never : constant Callback_Flag := 0; - When_Changed : constant Callback_Flag := 1; - When_Interact : constant Callback_Flag := 2; - When_Release : constant Callback_Flag := 4; - 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 System.Address); - pragma Convention (C, Callback_Hook); - - procedure Draw_Hook - (U : in System.Address); - pragma Convention (C, Draw_Hook); - - function Handle_Hook - (U : in System.Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Convention (C, Handle_Hook); - - - - - package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); - package Callback_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback); - function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address); - end Callback_Convert; - - - - - function fl_widget_get_user_data - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - pragma Inline (fl_widget_get_user_data); - - procedure fl_widget_set_user_data - (W, D : in System.Address); - pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); - pragma Inline (fl_widget_set_user_data); - - - - - procedure fl_widget_set_label - (W : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); - 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); - pragma Inline (Set_Output_Only); - 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); - pragma Inline (Nearest_Window); - pragma Inline (Top_Window); - pragma Inline (Top_Window_Offset); - - - pragma Inline (Get_Alignment); - pragma Inline (Set_Alignment); - pragma Inline (Get_Box); - pragma Inline (Set_Box); - pragma Inline (Get_Tooltip); - pragma Inline (Set_Tooltip); - - - pragma Inline (Get_Label); - pragma Inline (Set_Label); - pragma Inline (Get_Label_Color); - pragma Inline (Set_Label_Color); - pragma Inline (Get_Label_Font); - pragma Inline (Set_Label_Font); - pragma Inline (Get_Label_Size); - pragma Inline (Set_Label_Size); - pragma Inline (Get_Label_Type); - 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); - pragma Inline (Get_H); - 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); - pragma Inline (Draw_Label); - pragma Inline (Redraw); - pragma Inline (Redraw_Label); - pragma Inline (Handle); - - -end FLTK.Widgets; - diff --git a/src/fltk.adb b/src/fltk.adb deleted file mode 100644 index 34366eb..0000000 --- a/src/fltk.adb +++ /dev/null @@ -1,383 +0,0 @@ - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned_long, - System.Address; - - -package body FLTK is - - - function fl_abi_check - (V : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_abi_check, "fl_abi_check"); - pragma Inline (fl_abi_check); - - function fl_abi_version - return Interfaces.C.int; - pragma Import (C, fl_abi_version, "fl_abi_version"); - pragma Inline (fl_abi_version); - - function fl_api_version - return Interfaces.C.int; - pragma Import (C, fl_api_version, "fl_api_version"); - pragma Inline (fl_api_version); - - function fl_version - return Interfaces.C.double; - pragma Import (C, fl_version, "fl_version"); - pragma Inline (fl_version); - - - - - function fl_get_damage - return Interfaces.C.int; - pragma Import (C, fl_get_damage, "fl_get_damage"); - pragma Inline (fl_get_damage); - - procedure fl_set_damage - (V : in Interfaces.C.int); - pragma Import (C, fl_set_damage, "fl_set_damage"); - pragma Inline (fl_set_damage); - - - - - function fl_check - return Interfaces.C.int; - pragma Import (C, fl_check, "fl_check"); - pragma Inline (fl_check); - - function fl_ready - return Interfaces.C.int; - pragma Import (C, fl_ready, "fl_ready"); - pragma Inline (fl_ready); - - function fl_wait - return Interfaces.C.int; - pragma Import (C, fl_wait, "fl_wait"); - pragma Inline (fl_wait); - - function fl_wait2 - (S : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_wait2, "fl_wait2"); - pragma Inline (fl_wait2); - - function fl_run - return Interfaces.C.int; - pragma Import (C, fl_run, "fl_run"); - pragma Inline (fl_run); - - - - - function Is_Valid - (Object : in Wrapper) - return Boolean is - begin - return Object.Void_Ptr /= System.Null_Address; - end Is_Valid; - - - procedure Initialize - (This : in out Wrapper) is - begin - This.Void_Ptr := System.Null_Address; - end Initialize; - - - - - function Press - (Key : in Pressable_Key) - return Keypress is - begin - return Character'Pos (Key); - end Press; - - - function Press - (Key : Pressable_Key) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Mod_None; - This.Keycode := Character'Pos (Key); - This.Mousecode := No_Button; - end return; - end Press; - - - function Press - (Key : in Keypress) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Mod_None; - This.Keycode := Key; - This.Mousecode := No_Button; - end return; - end Press; - - - function Press - (Key : in Mouse_Button) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Mod_None; - This.Keycode := 0; - This.Mousecode := Key; - end return; - end Press; - - - - - function "+" - (Left, Right : in Modifier) - return Modifier is - begin - return Left or Right; - end "+"; - - - function "+" - (Left : in Modifier; - Right : in Pressable_Key) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Left; - This.Keycode := Character'Pos (Right); - This.Mousecode := No_Button; - end return; - end "+"; - - - function "+" - (Left : in Modifier; - Right : in Keypress) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Left; - This.Keycode := Right; - This.Mousecode := No_Button; - end return; - end "+"; - - - function "+" - (Left : in Modifier; - Right : in Mouse_Button) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Left; - This.Keycode := 0; - This.Mousecode := Right; - end return; - end "+"; - - - function "+" - (Left : in Modifier; - Right : in Key_Combo) - return Key_Combo is - begin - return This : Key_Combo do - This.Modcode := Left or Right.Modcode; - This.Keycode := Right.Keycode; - This.Mousecode := Right.Mousecode; - end return; - end "+"; - - - - - function To_C - (Key : in Key_Combo) - return Interfaces.C.unsigned_long is - begin - return To_C (Key.Modcode) + To_C (Key.Keycode) + To_C (Key.Mousecode); - end To_C; - - - function To_Ada - (Key : in Interfaces.C.unsigned_long) - return Key_Combo is - begin - return Result : Key_Combo do - Result.Modcode := To_Ada (Key); - Result.Keycode := To_Ada (Key); - Result.Mousecode := To_Ada (Key); - end return; - end To_Ada; - - - function To_C - (Key : in Keypress) - return Interfaces.C.unsigned_long is - begin - return Interfaces.C.unsigned_long (Key); - end To_C; - - - function To_Ada - (Key : in Interfaces.C.unsigned_long) - return Keypress is - begin - return Keypress (Key mod 65536); - end To_Ada; - - - function To_C - (Modi : in Modifier) - return Interfaces.C.unsigned_long is - begin - return Interfaces.C.unsigned_long (Modi) * 65536; - end To_C; - - - function To_Ada - (Modi : in Interfaces.C.unsigned_long) - return Modifier is - begin - return Modifier ((Modi / 65536) mod 256); - end To_Ada; - - - function To_C - (Button : in Mouse_Button) - return Interfaces.C.unsigned_long is - begin - case Button is - when Left_Button => return 1 * (256 ** 3); - when Middle_Button => return 2 * (256 ** 3); - when Right_Button => return 4 * (256 ** 3); - when others => return 0; - end case; - end To_C; - - - function To_Ada - (Button : in Interfaces.C.unsigned_long) - return Mouse_Button is - begin - case (Button / (256 ** 3)) is - when 1 => return Left_Button; - when 2 => return Middle_Button; - when 4 => return Right_Button; - when others => return No_Button; - end case; - end To_Ada; - - - - - function "+" - (Left, Right : in Menu_Flag) - return Menu_Flag is - begin - return Left or Right; - end "+"; - - - - - function ABI_Check - (ABI_Ver : in Version_Number) - return Boolean is - begin - return fl_abi_check (Interfaces.C.int (ABI_Ver)) /= 0; - end ABI_Check; - - - function ABI_Version - return Version_Number is - begin - return Version_Number (fl_abi_version); - end ABI_Version; - - - function API_Version - return Version_Number is - begin - return Version_Number (fl_api_version); - end API_Version; - - - function Version - return Version_Number is - begin - return Version_Number (fl_version); - end Version; - - - - - function Is_Damaged - return Boolean is - begin - return fl_get_damage /= 0; - end Is_Damaged; - - - procedure Set_Damaged - (To : in Boolean) is - begin - fl_set_damage (Boolean'Pos (To)); - end Set_Damaged; - - - - - function Check - return Boolean is - begin - return fl_check /= 0; - end Check; - - - function Ready - return Boolean is - begin - return fl_ready /= 0; - end Ready; - - - function Wait - return Integer is - begin - return Integer (fl_wait); - end Wait; - - - function Wait - (Seconds : in Long_Float) - return Integer is - begin - return Integer (fl_wait2 (Interfaces.C.double (Seconds))); - end Wait; - - - function Run - return Integer is - begin - return Integer (fl_run); - end Run; - - -end FLTK; - diff --git a/src/fltk.ads b/src/fltk.ads deleted file mode 100644 index 61775cb..0000000 --- a/src/fltk.ads +++ /dev/null @@ -1,547 +0,0 @@ - - -with - - Ada.Finalization; - -private with - - Interfaces.C, - System; - - -package FLTK is - - - -- Ugly implementation detail, never use this. - -- This is necessary so things like Text_Buffers and - -- Widgets can talk to each other behind the binding. - type Wrapper is new Ada.Finalization.Limited_Controlled with private; - -- with Type_Invariant => Is_Valid (Wrapper); - - function Is_Valid - (Object : in Wrapper) - return Boolean; - - - - - -- Values scale from A/Black to X/White - type Greyscale is new Character range 'A' .. 'X'; - - type Color is mod 2**32; - - type Color_Component is mod 256; - type Color_Component_Array is array (Positive range <>) of aliased Color_Component; - - -- Examples of RGB colors - -- The lowest byte has to be 00 for the color to be RGB - RGB_Red_Color : constant Color := 16#ff000000#; - RGB_Green_Color : constant Color := 16#00ff0000#; - RGB_Blue_Color : constant Color := 16#0000ff00#; - RGB_White_Color : constant Color := 16#ffffff00#; - - -- Standard colors used in widgets - Foreground_Color : constant Color := 0; - Background2_Color : constant Color := 7; - Inactive_Color : constant Color := 8; - Selection_Color : constant Color := 15; - - -- Standard boxtype colors - Grey0_Color : constant Color := 32; - Dark3_Color : constant Color := 39; - Dark2_Color : constant Color := 45; - Dark1_Color : constant Color := 47; - Background_Color : constant Color := 49; - Light1_Color : constant Color := 50; - Light2_Color : constant Color := 52; - Light3_Color : constant Color := 54; - - -- Color cube colors - Black_Color : constant Color := 56; - Red_Color : constant Color := 88; - Green_Color : constant Color := 63; - Yellow_Color : constant Color := 95; - Blue_Color : constant Color := 216; - Magenta_Color : constant Color := 248; - Cyan_Color : constant Color := 223; - Dark_Red_Color : constant Color := 72; - Dark_Green_Color : constant Color := 60; - Dark_Yellow_Color : constant Color := 76; - Dark_Blue_Color : constant Color := 136; - Dark_Magenta_Color : constant Color := 152; - Dark_Cyan_Color : constant Color := 140; - White_Color : constant Color := 255; - - - - - type Alignment is private; - Align_Center : constant Alignment; - Align_Top : constant Alignment; - Align_Bottom : constant Alignment; - Align_Left : constant Alignment; - Align_Right : constant Alignment; - - - - - type Mouse_Cursor_Kind is - (Default_Mouse, - Arrow_Mouse, - Crosshair_Mouse, - Wait_Mouse, - Insert_Mouse, - Hand_Mouse, - Help_Mouse, - Move_Mouse, - NS_Mouse, - WE_Mouse, - NWSE_Mouse, - NESW_Mouse, - N_Mouse, - NE_Mouse, - E_Mouse, - SE_Mouse, - S_Mouse, - SW_Mouse, - W_Mouse, - NW_Mouse, - None_Mouse); - - - - - type Keypress is private; - subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); - function Press (Key : in Pressable_Key) return Keypress; - Enter_Key : constant Keypress; - Keypad_Enter_Key : constant Keypress; - Backspace_Key : constant Keypress; - Insert_Key : constant Keypress; - Delete_Key : constant Keypress; - Home_Key : constant Keypress; - End_Key : constant Keypress; - Page_Down_Key : constant Keypress; - Page_Up_Key : constant Keypress; - Down_Key : constant Keypress; - Left_Key : constant Keypress; - Right_Key : constant Keypress; - Up_Key : constant Keypress; - Escape_Key : constant Keypress; - - type Mouse_Button is (No_Button, Left_Button, Middle_Button, Right_Button); - - type Key_Combo is private; - function Press (Key : in Pressable_Key) return Key_Combo; - function Press (Key : in Keypress) return Key_Combo; - function Press (Key : in Mouse_Button) return Key_Combo; - No_Key : constant Key_Combo; - - type Modifier is private; - function "+" (Left, Right : in Modifier) return Modifier; - function "+" (Left : in Modifier; Right : in Pressable_Key) return Key_Combo; - function "+" (Left : in Modifier; Right : in Keypress) return Key_Combo; - function "+" (Left : in Modifier; Right : in Mouse_Button) return Key_Combo; - function "+" (Left : in Modifier; Right : in Key_Combo) return Key_Combo; - Mod_None : constant Modifier; - Mod_Shift : constant Modifier; - Mod_Ctrl : constant Modifier; - Mod_Alt : constant Modifier; - - - - - type Box_Kind is - (No_Box, - Flat_Box, - Up_Box, - Down_Box, - Up_Frame, - Down_Frame, - Thin_Up_Box, - Thin_Down_Box, - Thin_Up_Frame, - Thin_Down_Frame, - Engraved_Box, - Embossed_Box, - Engraved_Frame, - Embossed_Frame, - Border_Box, - Shadow_Box, - Border_Frame, - Shadow_Frame, - Rounded_Box, - RShadow_Box, - Rounded_Frame, - RFlat_Box, - Round_Up_Box, - Round_Down_Box, - Diamond_Up_Box, - Diamond_Down_Box, - Oval_Box, - OShadow_Box, - Oval_Frame, - OFlat_Box, - Plastic_Up_Box, - Plastic_Down_Box, - Plastic_Up_Frame, - Plastic_Down_Frame, - Plastic_Thin_Up_Box, - Plastic_Thin_Down_Box, - Plastic_Round_Up_Box, - Plastic_Round_Down_Box, - Gtk_Up_Box, - Gtk_Down_Box, - Gtk_Up_Frame, - Gtk_Down_Frame, - Gtk_Thin_Up_Box, - Gtk_Thin_Down_Box, - Gtk_Thin_Up_Frame, - Gtk_Thin_Down_Frame, - Gtk_Round_Up_Box, - Gtk_Round_Down_Box, - Gleam_Up_Box, - Gleam_Down_Box, - Gleam_Up_Frame, - Gleam_Down_Frame, - Gleam_Thin_Up_Box, - Gleam_Thin_Down_Box, - Gleam_Round_Up_Box, - Gleam_Round_Down_Box, - Free_Box); - - - - - type Font_Kind is - (Helvetica, - Helvetica_Bold, - Helvetica_Italic, - Helvetica_Bold_Italic, - Courier, - Courier_Bold, - Courier_Italic, - Courier_Bold_Italic, - Times, - Times_Bold, - Times_Italic, - Times_Bold_Italic, - Symbol, - Monospace, - Monospace_Bold, - Zapf_Dingbats, - Free_Font); - - type Font_Size is new Natural; - Normal_Size : constant Font_Size := 14; - - type Font_Size_Array is array (Positive range <>) of Font_Size; - - - - - type Label_Kind is - (Normal_Label, - No_Label, - Shadow_Label, - Engraved_Label, - Embossed_Label, - Multi_Label, - Icon_Label, - Image_Label, - Free_Label); - - - - - type Event_Kind is - (No_Event, - Push, - Release, - Enter, - Leave, - Drag, - Focus, - Unfocus, - Keydown, - Keyup, - Close, - Move, - Shortcut, - Deactivate, - Activate, - Hide, - Show, - Paste, - Selection_Clear, - Mouse_Wheel, - DnD_Enter, - DnD_Drag, - DnD_Leave, - DnD_Release, - Screen_Config_Changed, - Fullscreen); - - type Event_Outcome is (Not_Handled, Handled); - - - - - type Menu_Flag is private; - function "+" (Left, Right : in Menu_Flag) return Menu_Flag; - Flag_Normal : constant Menu_Flag; - Flag_Inactive : constant Menu_Flag; - Flag_Toggle : constant Menu_Flag; - Flag_Value : constant Menu_Flag; - Flag_Radio : constant Menu_Flag; - Flag_Invisible : constant Menu_Flag; - Flag_Submenu : constant Menu_Flag; - Flag_Divider : constant Menu_Flag; - - - - - type Version_Number is new Natural; - - - - - function ABI_Check - (ABI_Ver : in Version_Number) - return Boolean; - - function ABI_Version - return Version_Number; - - function API_Version - return Version_Number; - - function Version - return Version_Number; - - - - - procedure Awake; - - procedure Lock; - - procedure Unlock; - - - - - function Is_Damaged - return Boolean; - - procedure Set_Damaged - (To : in Boolean); - - procedure Flush; - - procedure Redraw; - - - - - function Check - return Boolean; - - function Ready - return Boolean; - - function Wait - return Integer; - - function Wait - (Seconds : in Long_Float) - return Integer; - - function Run - return Integer; - - -private - - - pragma Linker_Options ("-lfltk"); - pragma Linker_Options ("-lfltk_images"); - - - - - type Wrapper is new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : System.Address; - Needs_Dealloc : Boolean := True; - end record; - - overriding procedure Initialize - (This : in out Wrapper); - - - - - for Color_Component_Array'Component_Size use Interfaces.C.CHAR_BIT; - pragma Convention (C, Color_Component_Array); - - - - - type Alignment is new Interfaces.Unsigned_16; - Align_Center : constant Alignment := 0; - Align_Top : constant Alignment := 1; - Align_Bottom : constant Alignment := 2; - Align_Left : constant Alignment := 4; - Align_Right : constant Alignment := 8; - - - - - -- What delightful magic numbers FLTK cursors are! - -- (These correspond to the enum found in Enumerations.H) - Cursor_Values : array (Mouse_Cursor_Kind) of Interfaces.C.int := - (Default_Mouse => 0, - Arrow_Mouse => 35, - Crosshair_Mouse => 66, - Wait_Mouse => 76, - Insert_Mouse => 77, - Hand_Mouse => 31, - Help_Mouse => 47, - Move_Mouse => 27, - NS_Mouse => 78, - WE_Mouse => 79, - NWSE_Mouse => 80, - NESW_Mouse => 81, - N_Mouse => 70, - NE_Mouse => 69, - E_Mouse => 49, - SE_Mouse => 8, - S_Mouse => 9, - SW_Mouse => 7, - W_Mouse => 36, - NW_Mouse => 68, - None_Mouse => 255); - - - - - type Keypress is new Interfaces.Unsigned_16; - type Modifier is new Interfaces.Unsigned_16; - type Key_Combo is - record - Modcode : Modifier; - Keycode : Keypress; - Mousecode : Mouse_Button; - end record; - - function To_C - (Key : in Key_Combo) - return Interfaces.C.unsigned_long; - - function To_Ada - (Key : in Interfaces.C.unsigned_long) - return Key_Combo; - - function To_C - (Key : in Keypress) - return Interfaces.C.unsigned_long; - - function To_Ada - (Key : in Interfaces.C.unsigned_long) - return Keypress; - - function To_C - (Modi : in Modifier) - return Interfaces.C.unsigned_long; - - function To_Ada - (Modi : in Interfaces.C.unsigned_long) - return Modifier; - - function To_C - (Button : in Mouse_Button) - return Interfaces.C.unsigned_long; - - function To_Ada - (Button : in Interfaces.C.unsigned_long) - return Mouse_Button; - - -- these values designed to align with FLTK enumeration types - Mod_None : constant Modifier := 2#00000000#; - Mod_Shift : constant Modifier := 2#00000001#; - Mod_Ctrl : constant Modifier := 2#00000100#; - Mod_Alt : constant Modifier := 2#00001000#; - - No_Key : constant Key_Combo := (Modcode => Mod_None, Keycode => 0, Mousecode => No_Button); - - -- these values correspond to constants defined in FLTK Enumerations.H - Enter_Key : constant Keypress := 16#ff0d#; - Keypad_Enter_Key : constant Keypress := 16#ff8d#; - Backspace_Key : constant Keypress := 16#ff08#; - Insert_Key : constant Keypress := 16#ff63#; - Delete_Key : constant Keypress := 16#ffff#; - Home_Key : constant Keypress := 16#ff50#; - End_Key : constant Keypress := 16#ff57#; - Page_Down_Key : constant Keypress := 16#ff56#; - Page_Up_Key : constant Keypress := 16#ff55#; - Down_Key : constant Keypress := 16#ff54#; - Left_Key : constant Keypress := 16#ff51#; - Right_Key : constant Keypress := 16#ff53#; - Up_Key : constant Keypress := 16#ff52#; - Escape_Key : constant Keypress := 16#ff1b#; - - - - - type Menu_Flag is new Interfaces.Unsigned_8; - Flag_Normal : constant Menu_Flag := 2#00000000#; - Flag_Inactive : constant Menu_Flag := 2#00000001#; - Flag_Toggle : constant Menu_Flag := 2#00000010#; - Flag_Value : constant Menu_Flag := 2#00000100#; - Flag_Radio : constant Menu_Flag := 2#00001000#; - Flag_Invisible : constant Menu_Flag := 2#00010000#; - -- Flag_Submenu_Pointer unlikely to be used - Flag_Submenu : constant Menu_Flag := 2#01000000#; - Flag_Divider : constant Menu_Flag := 2#10000000#; - - - - - pragma Import (C, Awake, "fl_awake"); - pragma Import (C, Lock, "fl_lock"); - pragma Import (C, Unlock, "fl_unlock"); - - - pragma Import (C, Flush, "fl_flush"); - pragma Import (C, Redraw, "fl_redraw"); - - - - - pragma Inline (ABI_Check); - pragma Inline (ABI_Version); - pragma Inline (API_Version); - pragma Inline (Version); - - - pragma Inline (Awake); - pragma Inline (Lock); - pragma Inline (Unlock); - - - pragma Inline (Is_Damaged); - pragma Inline (Set_Damaged); - pragma Inline (Flush); - pragma Inline (Redraw); - - - pragma Inline (Check); - pragma Inline (Ready); - pragma Inline (Wait); - pragma Inline (Run); - - -end FLTK; - |