diff options
Diffstat (limited to 'src')
455 files changed, 0 insertions, 76857 deletions
diff --git a/src/c_fl.cpp b/src/c_fl.cpp deleted file mode 100644 index acaae1a..0000000 --- a/src/c_fl.cpp +++ /dev/null @@ -1,93 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl.H> -#include "c_fl.h" - - - - -size_t c_pointer_size() { - return sizeof(void*); -} - - - - -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 eb2bb3c..0000000 --- a/src/c_fl.h +++ /dev/null @@ -1,41 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_GUARD -#define FL_GUARD - - - - -extern "C" size_t c_pointer_size(); - - -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 1b9db8e..0000000 --- a/src/c_fl_adjuster.cpp +++ /dev/null @@ -1,92 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Adjuster.H> -#include "c_fl_adjuster.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Adjuster : Fl_Adjuster { -public: - using Fl_Adjuster::value_damage; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Adjuster : public Fl_Adjuster { -public: - using Fl_Adjuster::Fl_Adjuster; - - friend void fl_adjuster_draw(ADJUSTER a); - friend int fl_adjuster_handle(ADJUSTER a, int e); - - void draw(); - int handle(int e); -}; - -void My_Adjuster::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Adjuster::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_adjuster_value_damage(ADJUSTER a) { - (reinterpret_cast<Fl_Adjuster*>(a)->*(&Friend_Adjuster::value_damage))(); -} - -void fl_adjuster_draw(ADJUSTER a) { - reinterpret_cast<My_Adjuster*>(a)->Fl_Adjuster::draw(); -} - -int fl_adjuster_handle(ADJUSTER a, int e) { - return reinterpret_cast<My_Adjuster*>(a)->Fl_Adjuster::handle(e); -} - - diff --git a/src/c_fl_adjuster.h b/src/c_fl_adjuster.h deleted file mode 100644 index fbaa5ec..0000000 --- a/src/c_fl_adjuster.h +++ /dev/null @@ -1,29 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ADJUSTER_GUARD -#define FL_ADJUSTER_GUARD - - -typedef void* ADJUSTER; - - -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); - - -extern "C" void fl_adjuster_value_damage(ADJUSTER a); -extern "C" void fl_adjuster_draw(ADJUSTER a); -extern "C" int fl_adjuster_handle(ADJUSTER a, int e); - - -#endif - - diff --git a/src/c_fl_ask.cpp b/src/c_fl_ask.cpp deleted file mode 100644 index 20af2e3..0000000 --- a/src/c_fl_ask.cpp +++ /dev/null @@ -1,140 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/fl_ask.H> -#include <FL/Fl_File_Chooser.H> -#include <FL/Fl_Color_Chooser.H> -#include "c_fl_ask.h" - - - - -const char * fl_ask_get_cancel() { - return fl_cancel; -} - -void fl_ask_set_cancel(const char * v) { - fl_cancel = v; -} - -const char * fl_ask_get_close() { - return fl_close; -} - -void fl_ask_set_close(const char * v) { - fl_close = v; -} - -const char * fl_ask_get_no() { - return fl_no; -} - -void fl_ask_set_no(const char * v) { - fl_no = v; -} - -const char * fl_ask_get_ok() { - return fl_ok; -} - -void fl_ask_set_ok(const char * v) { - fl_ok = v; -} - -const char * fl_ask_get_yes() { - return fl_yes; -} - -void fl_ask_set_yes(const char * v) { - fl_yes = v; -} - - - - -void fl_ask_alert(const char * m) { - fl_alert(m); -} - -void fl_ask_beep(int b) { - fl_beep(b); -} - -int fl_ask_choice(const char * m, const char * a, const char * b, const char * c) { - return fl_choice(m, a, b, c); -} - -int fl_ask_choice_n(const char * m, const char * a, const char * b, const char * c) { - return fl_choice_n(m, a, b, c); -} - -const char * fl_ask_input(const char * m, const char * d) { - return fl_input(m, d); -} - -void fl_ask_message(const char * m) { - fl_message(m); -} - -const char * fl_ask_password(const char * m, const char * d) { - return fl_password(m, d); -} - - - - -int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int m) { - return fl_color_chooser(n, r, g, b, m); -} - -int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m) { - return fl_color_chooser(n, r, g, b, m); -} - -char * fl_ask_dir_chooser(const char * m, const char * d, int r) { - return fl_dir_chooser(m, d, r); -} - -char * fl_ask_file_chooser(const char * m, const char * p, const char * d, int r) { - return fl_file_chooser(m, p, d, r); -} - -void fl_ask_file_chooser_callback(void(*cb)(const char *)) { - fl_file_chooser_callback(cb); -} - -void fl_ask_file_chooser_ok_label(const char *l) { - fl_file_chooser_ok_label(l); -} - - - - -int fl_ask_get_message_hotspot(void) { - return fl_message_hotspot(); -} - -void fl_ask_set_message_hotspot(int v) { - fl_message_hotspot(v); -} - -void fl_ask_message_font(int f, int s) { - fl_message_font(f, s); -} - -void * fl_ask_message_icon(void) { - return fl_message_icon(); -} - -void fl_ask_message_title(const char * t) { - fl_message_title(t); -} - -void fl_ask_message_title_default(const char * t) { - fl_message_title_default(t); -} - - diff --git a/src/c_fl_ask.h b/src/c_fl_ask.h deleted file mode 100644 index c1845b2..0000000 --- a/src/c_fl_ask.h +++ /dev/null @@ -1,49 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ASK_GUARD -#define FL_ASK_GUARD - - -extern "C" const char * fl_ask_get_cancel(); -extern "C" void fl_ask_set_cancel(const char * v); -extern "C" const char * fl_ask_get_close(); -extern "C" void fl_ask_set_close(const char * v); -extern "C" const char * fl_ask_get_no(); -extern "C" void fl_ask_set_no(const char * v); -extern "C" const char * fl_ask_get_ok(); -extern "C" void fl_ask_set_ok(const char * v); -extern "C" const char * fl_ask_get_yes(); -extern "C" void fl_ask_set_yes(const char * v); - - -extern "C" void fl_ask_alert(const char * m); -extern "C" void fl_ask_beep(int b); -extern "C" int fl_ask_choice(const char * m, const char * a, const char * b, const char * c); -extern "C" int fl_ask_choice_n(const char * m, const char * a, const char * b, const char * c); -extern "C" const char * fl_ask_input(const char * m, const char * d); -extern "C" void fl_ask_message(const char * m); -extern "C" const char * fl_ask_password(const char * m, const char * d); - - -extern "C" int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int m); -extern "C" int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m); -extern "C" char * fl_ask_dir_chooser(const char * m, const char * d, int r); -extern "C" char * fl_ask_file_chooser(const char * m, const char * p, const char * d, int r); -extern "C" void fl_ask_file_chooser_callback(void(*cb)(const char *)); -extern "C" void fl_ask_file_chooser_ok_label(const char *l); - - -extern "C" int fl_ask_get_message_hotspot(void); -extern "C" void fl_ask_set_message_hotspot(int v); -extern "C" void fl_ask_message_font(int f, int s); -extern "C" void * fl_ask_message_icon(void); -extern "C" void fl_ask_message_title(const char * t); -extern "C" void fl_ask_message_title_default(const char * t); - - -#endif - diff --git a/src/c_fl_bitmap.cpp b/src/c_fl_bitmap.cpp deleted file mode 100644 index 00cb665..0000000 --- a/src/c_fl_bitmap.cpp +++ /dev/null @@ -1,50 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 a7b7999..0000000 --- a/src/c_fl_bitmap.h +++ /dev/null @@ -1,32 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 ee39966..0000000 --- a/src/c_fl_bmp_image.cpp +++ /dev/null @@ -1,19 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 9dd48bd..0000000 --- a/src/c_fl_bmp_image.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 67b4e0b..0000000 --- a/src/c_fl_box.cpp +++ /dev/null @@ -1,72 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Box.H> -#include "c_fl_box.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Box : public Fl_Box { -public: - using Fl_Box::Fl_Box; - - friend void fl_box_draw(BOX n); - friend int fl_box_handle(BOX n, int e); - - void draw(); - int handle(int e); -}; - -void My_Box::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Box::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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; -} - -BOX new_fl_box2(int k, int x, int y, int w, int h, char * label) { - My_Box *b = new My_Box(static_cast<Fl_Boxtype>(k), x, y, w, h, label); - return b; -} - -void free_fl_box(BOX b) { - delete reinterpret_cast<My_Box*>(b); -} - - - - -void fl_box_draw(BOX n) { - reinterpret_cast<My_Box*>(n)->Fl_Box::draw(); -} - -int fl_box_handle(BOX n, int e) { - return reinterpret_cast<My_Box*>(n)->Fl_Box::handle(e); -} - - diff --git a/src/c_fl_box.h b/src/c_fl_box.h deleted file mode 100644 index 5143c3f..0000000 --- a/src/c_fl_box.h +++ /dev/null @@ -1,25 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_BOX_GUARD -#define FL_BOX_GUARD - - -typedef void* BOX; - - -extern "C" BOX new_fl_box(int x, int y, int w, int h, char * label); -extern "C" BOX new_fl_box2(int k, int x, int y, int w, int h, char * label); -extern "C" void free_fl_box(BOX b); - - -extern "C" void fl_box_draw(BOX n); -extern "C" int fl_box_handle(BOX n, int e); - - -#endif - - diff --git a/src/c_fl_browser.cpp b/src/c_fl_browser.cpp deleted file mode 100644 index 0a29e22..0000000 --- a/src/c_fl_browser.cpp +++ /dev/null @@ -1,448 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Browser.H> -#include <FL/Fl_Image.H> -#include "c_fl_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -extern "C" int browser_item_width_hook(void * b, void * i); -extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Browser : Fl_Browser { -public: - using Fl_Browser::lineno; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Browser : public Fl_Browser { -public: - using Fl_Browser::Fl_Browser; - - friend int fl_browser_item_width(BROWSER b, void * item); - friend int fl_browser_item_height(BROWSER b, void * item); - friend void * fl_browser_item_first(BROWSER b); - friend void * fl_browser_item_last(BROWSER b); - friend void * fl_browser_item_next(BROWSER b, void * item); - friend void * fl_browser_item_prev(BROWSER b, void * item); - friend void * fl_browser_item_at(BROWSER b, int index); - friend void fl_browser_item_select(BROWSER b, void * item, int val); - friend int fl_browser_item_selected(BROWSER b, void * item); - friend void fl_browser_item_swap(BROWSER b, void * x, void * y); - friend const char * fl_browser_item_text(BROWSER b, void * item); - friend void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h); - - friend int fl_browser_full_width(BROWSER c); - friend int fl_browser_full_height(BROWSER c); - friend int fl_browser_incr_height(BROWSER c); - friend int fl_browser_item_quick_height(BROWSER c, void * i); - - friend void fl_browser_draw(BROWSER b); - - int handle(int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - int item_width(void * item) const; - int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); -}; - - -int My_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Browser::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Browser::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -int My_Browser::item_width(void * item) const { - return browser_item_width_hook(this->user_data(), item); -} - -int My_Browser::item_height(void * item) const { - return browser_item_height_hook(this->user_data(), item); -} - -void * My_Browser::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_Browser::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_Browser::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_Browser::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_Browser::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_Browser::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_Browser::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_Browser::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_Browser::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -void My_Browser::item_draw(void * item, int x, int y, int w, int h) const { - browser_item_draw_hook(this->user_data(), item, x, y, w, h); -} - - -void My_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -BROWSER new_fl_browser(int x, int y, int w, int h, char * label) { - My_Browser *b = new My_Browser(x, y, w, h, label); - return b; -} - -void free_fl_browser(BROWSER b) { - delete reinterpret_cast<My_Browser*>(b); -} - - - - -void fl_browser_add(BROWSER b, const char * text, void * d) { - reinterpret_cast<Fl_Browser*>(b)->add(text, d); -} - -void fl_browser_insert(BROWSER b, int line, const char * text, void * d) { - reinterpret_cast<Fl_Browser*>(b)->insert(line, text, d); -} - -void fl_browser_move(BROWSER b, int to, int from) { - reinterpret_cast<Fl_Browser*>(b)->move(to, from); -} - -void fl_browser_swap(BROWSER b, int x, int y) { - reinterpret_cast<Fl_Browser*>(b)->swap(x, y); -} - -void fl_browser_remove(BROWSER b, int line) { - reinterpret_cast<Fl_Browser*>(b)->remove(line); -} - -void fl_browser_clear(BROWSER b) { - reinterpret_cast<Fl_Browser*>(b)->clear(); -} - -int fl_browser_size(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->size(); -} - - - - -int fl_browser_load(BROWSER b, const char * f) { - return reinterpret_cast<Fl_Browser*>(b)->load(f); -} - -const char * fl_browser_get_text(BROWSER b, int line) { - return reinterpret_cast<Fl_Browser*>(b)->text(line); -} - -void fl_browser_set_text(BROWSER b, int line, const char * text) { - reinterpret_cast<Fl_Browser*>(b)->text(line, text); -} - -int fl_browser_get_textsize(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->textsize(); -} - -void fl_browser_set_textsize(BROWSER b, int size) { - reinterpret_cast<Fl_Browser*>(b)->textsize(size); -} - - - - -char fl_browser_get_column_char(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->column_char(); -} - -void fl_browser_set_column_char(BROWSER b, char c) { - reinterpret_cast<Fl_Browser*>(b)->column_char(c); -} - -void fl_browser_set_column_widths(BROWSER b, void * w) { - reinterpret_cast<Fl_Browser*>(b)->column_widths(reinterpret_cast<const int *>(w)); -} - -char fl_browser_get_format_char(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->format_char(); -} - -void fl_browser_set_format_char(BROWSER b, char c) { - reinterpret_cast<Fl_Browser*>(b)->format_char(c); -} - - - - -int fl_browser_get_topline(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->topline(); -} - -void fl_browser_set_topline(BROWSER b, int line) { - reinterpret_cast<Fl_Browser*>(b)->topline(line); -} - -void fl_browser_middleline(BROWSER b, int line) { - reinterpret_cast<Fl_Browser*>(b)->middleline(line); -} - -void fl_browser_bottomline(BROWSER b, int line) { - reinterpret_cast<Fl_Browser*>(b)->bottomline(line); -} - -void fl_browser_lineposition(BROWSER b, int line, int p) { - reinterpret_cast<Fl_Browser*>(b)->lineposition - (line, static_cast<Fl_Browser::Fl_Line_Position>(p)); -} - - - - -int fl_browser_select(BROWSER b, int l, int v) { - return reinterpret_cast<Fl_Browser*>(b)->select(l, v); -} - -int fl_browser_selected(BROWSER b, int l) { - return reinterpret_cast<Fl_Browser*>(b)->selected(l); -} - -int fl_browser_value(BROWSER b) { - return reinterpret_cast<Fl_Browser*>(b)->value(); -} - - - - -int fl_browser_visible(BROWSER b, int l) { - return reinterpret_cast<Fl_Browser*>(b)->visible(l); -} - -void fl_browser_make_visible(BROWSER b, int l) { - reinterpret_cast<Fl_Browser*>(b)->make_visible(l); -} - -int fl_browser_displayed(BROWSER b, int l) { - return reinterpret_cast<Fl_Browser*>(b)->displayed(l); -} - -void fl_browser_show_line(BROWSER b, int l) { - reinterpret_cast<Fl_Browser*>(b)->show(l); -} - -void fl_browser_hide_line(BROWSER b, int l) { - reinterpret_cast<Fl_Browser*>(b)->hide(l); -} - -void fl_browser_show(BROWSER b) { - reinterpret_cast<Fl_Browser*>(b)->show(); -} - -void fl_browser_hide(BROWSER b) { - reinterpret_cast<Fl_Browser*>(b)->hide(); -} - - - - -void fl_browser_set_size(BROWSER b, int w, int h) { - reinterpret_cast<Fl_Browser*>(b)->size(w, h); -} - - - - -void fl_browser_set_icon(BROWSER b, int l, void * c) { - reinterpret_cast<Fl_Browser*>(b)->icon(l, reinterpret_cast<Fl_Image*>(c)); -} - -void fl_browser_remove_icon(BROWSER b, int l) { - reinterpret_cast<Fl_Browser*>(b)->remove_icon(l); -} - - - - -int fl_browser_full_height(BROWSER c) { - return reinterpret_cast<My_Browser*>(c)->Fl_Browser::full_height(); -} - -int fl_browser_incr_height(BROWSER c) { - return reinterpret_cast<My_Browser*>(c)->Fl_Browser::incr_height(); -} - - - - -int fl_browser_item_width(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_width(item); -} - -int fl_browser_item_height(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_height(item); -} - -void * fl_browser_item_first(BROWSER b) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_first(); -} - -void * fl_browser_item_last(BROWSER b) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_last(); -} - -void * fl_browser_item_next(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_next(item); -} - -void * fl_browser_item_prev(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_prev(item); -} - -void * fl_browser_item_at(BROWSER b, int index) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_at(index); -} - -void fl_browser_item_select(BROWSER b, void * item, int val) { - reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_select(item, val); -} - -int fl_browser_item_selected(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_selected(item); -} - -void fl_browser_item_swap(BROWSER b, void * x, void * y) { - reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_swap(x, y); -} - -const char * fl_browser_item_text(BROWSER b, void * item) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_text(item); -} - -void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h) { - reinterpret_cast<My_Browser*>(b)->Fl_Browser::item_draw(item, x, y, w, h); -} - - - - -int fl_browser_lineno(BROWSER b, void * item) { - return (reinterpret_cast<Fl_Browser*>(b)->*(&Friend_Browser::lineno))(item); -} - - - - -// These have to be reimplemented due to relying on custom class extensions - - -int fl_browser_full_width(BROWSER c) { - return reinterpret_cast<My_Browser*>(c)->Fl_Browser::full_width(); -} - -int fl_browser_item_quick_height(BROWSER c, void * i) { - return reinterpret_cast<My_Browser*>(c)->Fl_Browser::item_quick_height(i); -} - - - - -void fl_browser_draw(BROWSER b) { - reinterpret_cast<My_Browser*>(b)->Fl_Browser::draw(); -} - -int fl_browser_handle(BROWSER b, int e) { - return reinterpret_cast<My_Browser*>(b)->Fl_Browser::handle(e); -} - - diff --git a/src/c_fl_browser.h b/src/c_fl_browser.h deleted file mode 100644 index 2729303..0000000 --- a/src/c_fl_browser.h +++ /dev/null @@ -1,102 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_BROWSER_GUARD -#define FL_BROWSER_GUARD - - -typedef void* BROWSER; - - -extern "C" BROWSER new_fl_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_browser(BROWSER b); - - -extern "C" void fl_browser_add(BROWSER b, const char * text, void * d=0); -extern "C" void fl_browser_insert(BROWSER b, int line, const char * text, void * d=0); -extern "C" void fl_browser_move(BROWSER b, int to, int from); -extern "C" void fl_browser_swap(BROWSER b, int x, int y); -extern "C" void fl_browser_remove(BROWSER b, int line); -extern "C" void fl_browser_clear(BROWSER b); -extern "C" int fl_browser_size(BROWSER b); - - -extern "C" int fl_browser_load(BROWSER b, const char * f); -extern "C" const char * fl_browser_get_text(BROWSER b, int line); -extern "C" void fl_browser_set_text(BROWSER b, int line, const char * text); -extern "C" int fl_browser_get_textsize(BROWSER b); -extern "C" void fl_browser_set_textsize(BROWSER b, int size); - - -extern "C" char fl_browser_get_column_char(BROWSER b); -extern "C" void fl_browser_set_column_char(BROWSER b, char c); -extern "C" void fl_browser_set_column_widths(BROWSER b, void * w); -extern "C" char fl_browser_get_format_char(BROWSER b); -extern "C" void fl_browser_set_format_char(BROWSER b, char c); - - -extern "C" int fl_browser_get_topline(BROWSER b); -extern "C" void fl_browser_set_topline(BROWSER b, int line); -extern "C" void fl_browser_middleline(BROWSER b, int line); -extern "C" void fl_browser_bottomline(BROWSER b, int line); -extern "C" void fl_browser_lineposition(BROWSER b, int line, int p); - - -extern "C" int fl_browser_select(BROWSER b, int l, int v); -extern "C" int fl_browser_selected(BROWSER b, int l); -extern "C" int fl_browser_value(BROWSER b); - - -extern "C" int fl_browser_visible(BROWSER b, int l); -extern "C" void fl_browser_make_visible(BROWSER b, int l); -extern "C" int fl_browser_displayed(BROWSER b, int l); -extern "C" void fl_browser_show_line(BROWSER b, int l); -extern "C" void fl_browser_hide_line(BROWSER b, int l); -extern "C" void fl_browser_show(BROWSER b); -extern "C" void fl_browser_hide(BROWSER b); - - -extern "C" void fl_browser_set_size(BROWSER b, int w, int h); - - -extern "C" void fl_browser_set_icon(BROWSER b, int l, void * c); -extern "C" void fl_browser_remove_icon(BROWSER b, int l); - - -extern "C" int fl_browser_full_height(BROWSER c); -extern "C" int fl_browser_incr_height(BROWSER c); - - -extern "C" int fl_browser_item_width(BROWSER b, void * item); -extern "C" int fl_browser_item_height(BROWSER b, void * item); -extern "C" void * fl_browser_item_first(BROWSER b); -extern "C" void * fl_browser_item_last(BROWSER b); -extern "C" void * fl_browser_item_next(BROWSER b, void * item); -extern "C" void * fl_browser_item_prev(BROWSER b, void * item); -extern "C" void * fl_browser_item_at(BROWSER b, int index); -extern "C" void fl_browser_item_select(BROWSER b, void * item, int val=1); -extern "C" int fl_browser_item_selected(BROWSER b, void * item); -extern "C" void fl_browser_item_swap(BROWSER b, void * x, void * y); -extern "C" const char * fl_browser_item_text(BROWSER b, void * item); -extern "C" void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h); - - -extern "C" int fl_browser_lineno(BROWSER b, void * item); - - -// reimp below here - -extern "C" int fl_browser_full_width(BROWSER c); -extern "C" int fl_browser_item_quick_height(BROWSER c, void * i); - - -extern "C" void fl_browser_draw(BROWSER b); -extern "C" int fl_browser_handle(BROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_browser_.cpp b/src/c_fl_browser_.cpp deleted file mode 100644 index 3c0812c..0000000 --- a/src/c_fl_browser_.cpp +++ /dev/null @@ -1,392 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Browser_.H> -#include "c_fl_browser_.h" - - - - -const int fl_sort_ascending = FL_SORT_ASCENDING; -const int fl_sort_descending = FL_SORT_DESCENDING; - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -extern "C" int browser_item_width_hook(void * b, void * i); -extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Browser_ : Fl_Browser_ { -public: - using Fl_Browser_::selection; - using Fl_Browser_::displayed; - using Fl_Browser_::find_item; - using Fl_Browser_::top; - - using Fl_Browser_::bbox; - using Fl_Browser_::leftedge; - using Fl_Browser_::redraw_line; - using Fl_Browser_::redraw_lines; - - using Fl_Browser_::new_list; - using Fl_Browser_::inserting; - using Fl_Browser_::deleting; - using Fl_Browser_::replacing; - using Fl_Browser_::swapping; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Browser_ : public Fl_Browser_ { -public: - using Fl_Browser_::Fl_Browser_; - friend ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label); - - friend int fl_abstract_browser_full_width(ABSTRACTBROWSER b); - friend int fl_abstract_browser_full_height(ABSTRACTBROWSER b); - friend int fl_abstract_browser_incr_height(ABSTRACTBROWSER b); - friend int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i); - - friend void fl_abstract_browser_draw(ABSTRACTBROWSER b); - friend int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - int item_width(void * item) const; - int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); - int handle(int e); -}; - - -int My_Browser_::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Browser_::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Browser_::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Browser_::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -int My_Browser_::item_width(void * item) const { - return browser_item_width_hook(this->user_data(), item); -} - -int My_Browser_::item_height(void * item) const { - return browser_item_height_hook(this->user_data(), item); -} - -void * My_Browser_::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_Browser_::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_Browser_::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_Browser_::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_Browser_::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_Browser_::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_Browser_::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_Browser_::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_Browser_::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -void My_Browser_::item_draw(void * item, int x, int y, int w, int h) const { - browser_item_draw_hook(this->user_data(), item, x, y, w, h); -} - - -void My_Browser_::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Browser_::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label) { - My_Browser_ *b = new My_Browser_(x, y, w, h, label); - return b; -} - -void free_fl_abstract_browser(ABSTRACTBROWSER b) { - delete reinterpret_cast<My_Browser_*>(b); -} - - - - -void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b) { - return &reinterpret_cast<Fl_Browser_*>(b)->hscrollbar; -} - -void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b) { - return &reinterpret_cast<Fl_Browser_*>(b)->scrollbar; -} - - - - -int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c) { - return reinterpret_cast<Fl_Browser_*>(b)->select(i, v, c); -} - -int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c) { - return reinterpret_cast<Fl_Browser_*>(b)->select_only(i, c); -} - -void * fl_abstract_browser_selection(ABSTRACTBROWSER b) { - return (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::selection))(); -} - -int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c) { - return reinterpret_cast<Fl_Browser_*>(b)->deselect(c); -} - -void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i) { - reinterpret_cast<Fl_Browser_*>(b)->display(i); -} - -int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i) { - return (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::displayed))(i); -} - -void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y) { - return (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::find_item))(y); -} - -void * fl_abstract_browser_top(ABSTRACTBROWSER b) { - return (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::top))(); -} - -void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f) { - reinterpret_cast<Fl_Browser_*>(b)->sort(f); -} - - - - -unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->has_scrollbar(); -} - -void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m) { - reinterpret_cast<Fl_Browser_*>(b)->has_scrollbar(m); -} - -int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->hposition(); -} - -void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p) { - reinterpret_cast<Fl_Browser_*>(b)->hposition(p); -} - -int fl_abstract_browser_get_position(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->position(); -} - -void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p) { - reinterpret_cast<Fl_Browser_*>(b)->position(p); -} - -void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b) { - reinterpret_cast<Fl_Browser_*>(b)->scrollbar_left(); -} - -void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b) { - reinterpret_cast<Fl_Browser_*>(b)->scrollbar_right(); -} - -int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->scrollbar_size(); -} - -void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s) { - reinterpret_cast<Fl_Browser_*>(b)->scrollbar_size(s); -} - - - - -unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->textcolor(); -} - -void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c) { - reinterpret_cast<Fl_Browser_*>(b)->textcolor(c); -} - -int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->textfont(); -} - -void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f) { - reinterpret_cast<Fl_Browser_*>(b)->textfont(f); -} - -int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b) { - return reinterpret_cast<Fl_Browser_*>(b)->textsize(); -} - -void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s) { - reinterpret_cast<Fl_Browser_*>(b)->textsize(s); -} - - - - -void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h) { - reinterpret_cast<Fl_Browser_*>(b)->resize(x, y, w, h); -} - -void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::bbox))(x, y, w, h); -} - -int fl_abstract_browser_leftedge(ABSTRACTBROWSER b) { - return (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::leftedge))(); -} - -void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::redraw_line))(i); -} - -void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::redraw_lines))(); -} - - - - -int fl_abstract_browser_full_width(ABSTRACTBROWSER b) { - return reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::full_width(); -} - -int fl_abstract_browser_full_height(ABSTRACTBROWSER b) { - return reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::full_height(); -} - -int fl_abstract_browser_incr_height(ABSTRACTBROWSER b) { - return reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::incr_height(); -} - -int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i) { - return reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::item_quick_height(i); -} - - - - -void fl_abstract_browser_new_list(ABSTRACTBROWSER b) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::new_list))(); -} - -void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::inserting))(a1, a2); -} - -void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::deleting))(item); -} - -void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::replacing))(a1, a2); -} - -void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2) { - (reinterpret_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::swapping))(a1, a2); -} - - - - -void fl_abstract_browser_draw(ABSTRACTBROWSER b) { - reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::draw(); -} - -int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e) { - return reinterpret_cast<My_Browser_*>(b)->Fl_Browser_::handle(e); -} - - diff --git a/src/c_fl_browser_.h b/src/c_fl_browser_.h deleted file mode 100644 index ed1157e..0000000 --- a/src/c_fl_browser_.h +++ /dev/null @@ -1,83 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ABSTRACT_BROWSER_GUARD -#define FL_ABSTRACT_BROWSER_GUARD - - -extern "C" const int fl_sort_ascending; -extern "C" const int fl_sort_descending; - - -typedef void* ABSTRACTBROWSER; - - -extern "C" ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_abstract_browser(ABSTRACTBROWSER b); - - -extern "C" void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b); -extern "C" void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b); - - -extern "C" int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c); -extern "C" int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c); -extern "C" void * fl_abstract_browser_selection(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c); -extern "C" void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i); -extern "C" int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i); -extern "C" void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y); -extern "C" void * fl_abstract_browser_top(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f); - - -extern "C" unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m); -extern "C" int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p); -extern "C" int fl_abstract_browser_get_position(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p); -extern "C" void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s); - - -extern "C" unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c); -extern "C" int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f); -extern "C" int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s); - - -extern "C" void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h); -extern "C" void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h); -extern "C" int fl_abstract_browser_leftedge(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i); -extern "C" void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b); - - -extern "C" int fl_abstract_browser_full_width(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_full_height(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_incr_height(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i); - - -extern "C" void fl_abstract_browser_new_list(ABSTRACTBROWSER b); -extern "C" void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2); -extern "C" void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item); -extern "C" void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2); -extern "C" void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2); - - -extern "C" void fl_abstract_browser_draw(ABSTRACTBROWSER b); -extern "C" int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_button.cpp b/src/c_fl_button.cpp deleted file mode 100644 index 1cff342..0000000 --- a/src/c_fl_button.cpp +++ /dev/null @@ -1,133 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Button.H> -#include "c_fl_button.h" - - - - -// Telprot stopovers - -extern "C" void button_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); -void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { - button_extra_init_hook(adaobj, x, y, w, h, label); -} - -extern "C" void button_extra_final_hook(void * aobj); -void fl_button_extra_final(void * adaobj) { - button_extra_final_hook(adaobj); -} - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Button : Fl_Button { -public: - using Fl_Button::simulate_key_action; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Button : public Fl_Button { -public: - using Fl_Button::Fl_Button; - - friend void fl_button_draw(BUTTON b); - friend int fl_button_handle(BUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_button_draw(BUTTON b) { - reinterpret_cast<My_Button*>(b)->Fl_Button::draw(); -} - -int fl_button_handle(BUTTON b, int e) { - return reinterpret_cast<My_Button*>(b)->Fl_Button::handle(e); -} - - - - -void fl_button_simulate_key_action(BUTTON b) { - (reinterpret_cast<Fl_Button*>(b)->*(&Friend_Button::simulate_key_action))(); -} - - diff --git a/src/c_fl_button.h b/src/c_fl_button.h deleted file mode 100644 index f644a50..0000000 --- a/src/c_fl_button.h +++ /dev/null @@ -1,42 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_BUTTON_GUARD -#define FL_BUTTON_GUARD - - -extern "C" void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label); -extern "C" void fl_button_extra_final(void * adaobj); - - -typedef void* BUTTON; - - -extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_button(BUTTON b); - - -extern "C" int fl_button_get_state(BUTTON b); -extern "C" void fl_button_set_state(BUTTON b, int s); -extern "C" void fl_button_set_only(BUTTON b); - - -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); - - -extern "C" void fl_button_draw(BUTTON b); -extern "C" int fl_button_handle(BUTTON b, int e); - - -extern "C" void fl_button_simulate_key_action(BUTTON b); - - -#endif - - diff --git a/src/c_fl_cairo_window.cpp b/src/c_fl_cairo_window.cpp deleted file mode 100644 index c1a815e..0000000 --- a/src/c_fl_cairo_window.cpp +++ /dev/null @@ -1,98 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Cairo_Window.H> -#include <FL/Fl_Double_Window.H> -#include "c_fl_cairo_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Cairo_Window : -#ifdef FLTK_HAVE_CAIRO -public Fl_Cairo_Window -#else -public Fl_Double_Window -#endif -{ -public: -#ifdef FLTK_HAVE_CAIRO - using Fl_Cairo_Window::Fl_Cairo_Window; -#else - using Fl_Double_Window::Fl_Double_Window; -#endif - - friend void fl_cairo_window_draw(CAIROWINDOW w); - - int handle(int e); - void draw(); -}; - - -void My_Cairo_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Cairo_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -CAIROWINDOW new_fl_cairo_window(int w, int h) { - My_Cairo_Window *c = new My_Cairo_Window(w, h); - return c; -} - -void free_fl_cairo_window(CAIROWINDOW w) { - delete reinterpret_cast<My_Cairo_Window*>(w); -} - - - - -void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb) { - #ifdef FLTK_HAVE_CAIRO - reinterpret_cast<Fl_Cairo_Window*>(w)->set_draw_cb(reinterpret_cast<cairo_draw_cb>(cb)); - #else - (void)(w); - (void)(cb); - #endif -} - - - - -void fl_cairo_window_draw(CAIROWINDOW w) { - #ifdef FLTK_HAVE_CAIRO - reinterpret_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::draw(); - #else - reinterpret_cast<My_Cairo_Window*>(w)->Fl_Double_Window::draw(); - #endif -} - -int fl_cairo_window_handle(CAIROWINDOW w, int e) { - #ifdef FLTK_HAVE_CAIRO - return reinterpret_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::handle(e); - #else - return reinterpret_cast<My_Cairo_Window*>(w)->Fl_Double_Window::handle(e); - #endif -} - - diff --git a/src/c_fl_cairo_window.h b/src/c_fl_cairo_window.h deleted file mode 100644 index d004d16..0000000 --- a/src/c_fl_cairo_window.h +++ /dev/null @@ -1,27 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CAIRO_WINDOW_GUARD -#define FL_CAIRO_WINDOW_GUARD - - -typedef void* CAIROWINDOW; - - -extern "C" CAIROWINDOW new_fl_cairo_window(int w, int h); -extern "C" void free_fl_cairo_window(CAIROWINDOW w); - - -extern "C" void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb); - - -extern "C" void fl_cairo_window_draw(CAIROWINDOW w); -extern "C" int fl_cairo_window_handle(CAIROWINDOW w, int e); - - -#endif - - diff --git a/src/c_fl_chart.cpp b/src/c_fl_chart.cpp deleted file mode 100644 index 56bfb80..0000000 --- a/src/c_fl_chart.cpp +++ /dev/null @@ -1,151 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Chart.H> -#include "c_fl_chart.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Chart : public Fl_Chart { -public: - using Fl_Chart::Fl_Chart; - - friend void fl_chart_draw(CHART n); - friend int fl_chart_handle(CHART n, int e); - - void draw(); - int handle(int e); -}; - -void My_Chart::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Chart::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_chart_draw(CHART n) { - reinterpret_cast<My_Chart*>(n)->Fl_Chart::draw(); -} - -int fl_chart_handle(CHART n, int e) { - return reinterpret_cast<My_Chart*>(n)->Fl_Chart::handle(e); -} - - diff --git a/src/c_fl_chart.h b/src/c_fl_chart.h deleted file mode 100644 index bd524c3..0000000 --- a/src/c_fl_chart.h +++ /dev/null @@ -1,50 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CHART_GUARD -#define FL_CHART_GUARD - - -typedef void* CHART; - - -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); - - -extern "C" void fl_chart_draw(CHART n); -extern "C" int fl_chart_handle(CHART n, int e); - - -#endif - - diff --git a/src/c_fl_check_browser.cpp b/src/c_fl_check_browser.cpp deleted file mode 100644 index cfb5658..0000000 --- a/src/c_fl_check_browser.cpp +++ /dev/null @@ -1,336 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Check_Browser.H> -#include <FL/Fl_Browser_.H> -#include "c_fl_check_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -// These browser_item_* hooks are disabled since if they are used to hook -// into Ada using virtual dispatch then there will be no way to access the -// real Fl_Check_Browser versions once coming back into C++ via C since the -// versions we want to actually use here are private in FLTK because reasons. - -// Should be possible to re-enable in 1.4. - -// extern "C" int browser_item_width_hook(void * b, void * i); -// extern "C" int browser_item_height_hook(void * b, void * i); -// extern "C" void * browser_item_first_hook(void * b); -// extern "C" void * browser_item_last_hook(void * b); -// extern "C" void * browser_item_next_hook(void * b, void * i); -// extern "C" void * browser_item_prev_hook(void * b, void * i); -// extern "C" void * browser_item_at_hook(void * b, int n); -// extern "C" void browser_item_select_hook(void * b, void * i, int s); -// extern "C" int browser_item_selected_hook(void * b, void * i); -// extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -// extern "C" const char * browser_item_text_hook(void * b, void * i); -// extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected / private access - -class Friend_Browser : Fl_Browser_ { -public: - using Fl_Browser_::item_width; - using Fl_Browser_::item_height; - using Fl_Browser_::item_first; - using Fl_Browser_::item_next; - using Fl_Browser_::item_prev; - using Fl_Browser_::item_select; - using Fl_Browser_::item_selected; - using Fl_Browser_::item_draw; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Check_Browser : public Fl_Check_Browser { -public: - using Fl_Check_Browser::Fl_Check_Browser; - - friend int fl_check_browser_full_width(CHECKBROWSER c); - friend int fl_check_browser_full_height(CHECKBROWSER c); - friend int fl_check_browser_incr_height(CHECKBROWSER c); - friend int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i); - - friend int fl_check_browser_item_width(CHECKBROWSER c, void * i); - friend int fl_check_browser_item_height(CHECKBROWSER c, void * i); - friend void * fl_check_browser_item_first(CHECKBROWSER c); - // item_last goes here - friend void * fl_check_browser_item_next(CHECKBROWSER c, void * i); - friend void * fl_check_browser_item_prev(CHECKBROWSER c, void * i); - // item_at goes here - friend void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v); - friend int fl_check_browser_item_selected(CHECKBROWSER c, void * i); - // item_swap goes here - // item_text goes here - friend void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h); - - friend void fl_check_browser_draw(CHECKBROWSER c); - friend int fl_check_browser_handle(CHECKBROWSER c, int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - // int item_width(void * item) const; - // int item_height(void * item) const; - // void * item_first() const; - // void * item_last() const; - // void * item_next(void * item) const; - // void * item_prev(void * item) const; - // void * item_at(int index) const; - // void item_select(void * item, int val=1); - // int item_selected(void * item) const; - // void item_swap(void * a, void * b); - // const char * item_text(void * item) const; - // void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); - int handle(int e); -}; - - -int My_Check_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Check_Browser::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Check_Browser::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Check_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -// int My_Check_Browser::item_width(void * item) const { -// return browser_item_width_hook(this->user_data(), item); -// } - -// int My_Check_Browser::item_height(void * item) const { -// return browser_item_height_hook(this->user_data(), item); -// } - -// void * My_Check_Browser::item_first() const { -// return browser_item_first_hook(this->user_data()); -// } - -// void * My_Check_Browser::item_last() const { -// return browser_item_last_hook(this->user_data()); -// } - -// void * My_Check_Browser::item_next(void * item) const { -// return browser_item_next_hook(this->user_data(), item); -// } - -// void * My_Check_Browser::item_prev(void * item) const { -// return browser_item_prev_hook(this->user_data(), item); -// } - -// void * My_Check_Browser::item_at(int index) const { -// return browser_item_at_hook(this->user_data(), index); -// } - -// void My_Check_Browser::item_select(void * item, int val) { -// browser_item_select_hook(this->user_data(), item, val); -// } - -// int My_Check_Browser::item_selected(void * item) const { -// return browser_item_selected_hook(this->user_data(), item); -// } - -// void My_Check_Browser::item_swap(void * a, void * b) { -// browser_item_swap_hook(this->user_data(), a, b); -// } - -// const char * My_Check_Browser::item_text(void * item) const { -// return browser_item_text_hook(this->user_data(), item); -// } - -// void My_Check_Browser::item_draw(void * item, int x, int y, int w, int h) const { -// browser_item_draw_hook(this->user_data(), item, x, y, w, h); -// } - - -void My_Check_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Check_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -CHECKBROWSER new_fl_check_browser(int x, int y, int w, int h, char * label) { - My_Check_Browser *c = new My_Check_Browser(x, y, w, h, label); - return c; -} - -void free_fl_check_browser(CHECKBROWSER c) { - delete reinterpret_cast<My_Check_Browser*>(c); -} - - - - -int fl_check_browser_add(CHECKBROWSER c, const char * s, int b) { - return reinterpret_cast<Fl_Check_Browser*>(c)->add(s, b); -} - -int fl_check_browser_remove(CHECKBROWSER c, int i) { - return reinterpret_cast<Fl_Check_Browser*>(c)->remove(i); -} - -void fl_check_browser_clear(CHECKBROWSER c) { - reinterpret_cast<Fl_Check_Browser*>(c)->clear(); -} - -int fl_check_browser_nitems(CHECKBROWSER c) { - return reinterpret_cast<Fl_Check_Browser*>(c)->nitems(); -} - - - - -void fl_check_browser_check_all(CHECKBROWSER c) { - reinterpret_cast<Fl_Check_Browser*>(c)->check_all(); -} - -void fl_check_browser_check_none(CHECKBROWSER c) { - reinterpret_cast<Fl_Check_Browser*>(c)->check_none(); -} - -int fl_check_browser_get_checked(CHECKBROWSER c, int i) { - return reinterpret_cast<Fl_Check_Browser*>(c)->checked(i); -} - -void fl_check_browser_set_checked(CHECKBROWSER c, int i, int b) { - reinterpret_cast<Fl_Check_Browser*>(c)->checked(i, b); -} - -int fl_check_browser_nchecked(CHECKBROWSER c) { - return reinterpret_cast<Fl_Check_Browser*>(c)->nchecked(); -} - - - - -const char * fl_check_browser_text(CHECKBROWSER c, int i) { - return reinterpret_cast<Fl_Check_Browser*>(c)->text(i); -} - -int fl_check_browser_value(CHECKBROWSER c) { - return reinterpret_cast<Fl_Check_Browser*>(c)->value(); -} - - - - -int fl_check_browser_full_width(CHECKBROWSER c) { - return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::full_width(); -} - -int fl_check_browser_full_height(CHECKBROWSER c) { - return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::full_height(); -} - -int fl_check_browser_incr_height(CHECKBROWSER c) { - return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::incr_height(); -} - -int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i) { - return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_quick_height(i); -} - - - - -int fl_check_browser_item_width(CHECKBROWSER c, void * i) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_width))(i); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_width(i); -} - -int fl_check_browser_item_height(CHECKBROWSER c, void * i) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_height))(i); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_height(i); -} - -void * fl_check_browser_item_first(CHECKBROWSER c) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_first))(); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_first(); -} - -// missing item_last - -void * fl_check_browser_item_next(CHECKBROWSER c, void * i) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_next))(i); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_next(i); -} - -void * fl_check_browser_item_prev(CHECKBROWSER c, void * i) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_prev))(i); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_prev(i); -} - -// missing item_at - -void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v) { - (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_select))(i, v); - // reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_select(i, v); -} - -int fl_check_browser_item_selected(CHECKBROWSER c, void * i) { - return (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_selected))(i); - // return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_selected(i); -} - -// missing item_swap -// missing item_text - -void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h) { - (reinterpret_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_draw))(item, x, y, w, h); - // reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_draw(item, x, y, w, h); -} - - - - -void fl_check_browser_draw(CHECKBROWSER c) { - reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::draw(); -} - -int fl_check_browser_handle(CHECKBROWSER c, int e) { - return reinterpret_cast<My_Check_Browser*>(c)->Fl_Check_Browser::handle(e); -} - - diff --git a/src/c_fl_check_browser.h b/src/c_fl_check_browser.h deleted file mode 100644 index e9e832e..0000000 --- a/src/c_fl_check_browser.h +++ /dev/null @@ -1,61 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CHECK_BROWSER_GUARD -#define FL_CHECK_BROWSER_GUARD - - -typedef void* CHECKBROWSER; - - -extern "C" CHECKBROWSER new_fl_check_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_check_browser(CHECKBROWSER c); - - -extern "C" int fl_check_browser_add(CHECKBROWSER c, const char * s, int b); -extern "C" int fl_check_browser_remove(CHECKBROWSER c, int i); -extern "C" void fl_check_browser_clear(CHECKBROWSER c); -extern "C" int fl_check_browser_nitems(CHECKBROWSER c); - - -extern "C" void fl_check_browser_check_all(CHECKBROWSER c); -extern "C" void fl_check_browser_check_none(CHECKBROWSER c); -extern "C" int fl_check_browser_get_checked(CHECKBROWSER c, int i); -extern "C" void fl_check_browser_set_checked(CHECKBROWSER c, int i, int b); -extern "C" int fl_check_browser_nchecked(CHECKBROWSER c); - - -extern "C" const char * fl_check_browser_text(CHECKBROWSER c, int i); -extern "C" int fl_check_browser_value(CHECKBROWSER c); - - -extern "C" int fl_check_browser_full_width(CHECKBROWSER c); -extern "C" int fl_check_browser_full_height(CHECKBROWSER c); -extern "C" int fl_check_browser_incr_height(CHECKBROWSER c); -extern "C" int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i); - - -extern "C" int fl_check_browser_item_width(CHECKBROWSER c, void * i); -extern "C" int fl_check_browser_item_height(CHECKBROWSER c, void * i); -extern "C" void * fl_check_browser_item_first(CHECKBROWSER c); -// missing item_last -extern "C" void * fl_check_browser_item_next(CHECKBROWSER c, void * i); -extern "C" void * fl_check_browser_item_prev(CHECKBROWSER c, void * i); -// missing item_at -extern "C" void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v); -extern "C" int fl_check_browser_item_selected(CHECKBROWSER c, void * i); -// missing item_swap -// missing item_text -extern "C" void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h); - - -extern "C" void fl_check_browser_draw(CHECKBROWSER c); -extern "C" int fl_check_browser_handle(CHECKBROWSER c, int e); - - -#endif - - diff --git a/src/c_fl_check_button.cpp b/src/c_fl_check_button.cpp deleted file mode 100644 index 2eb61a1..0000000 --- a/src/c_fl_check_button.cpp +++ /dev/null @@ -1,83 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Check_Button.H> -#include "c_fl_check_button.h" - - - - -// Telprot stopovers - -extern "C" void check_button_extra_init_hook - (void * aobj, int x, int y, int w, int h, const char * l); -void fl_check_button_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) { - check_button_extra_init_hook(adaobj, x, y, w, h, label); -} - -extern "C" void check_button_extra_final_hook(void * aobj); -void fl_check_button_extra_final(void * adaobj) { - check_button_extra_final_hook(adaobj); -} - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Check_Button : public Fl_Check_Button { -public: - using Fl_Check_Button::Fl_Check_Button; - - friend void fl_check_button_draw(CHECKBUTTON b); - friend int fl_check_button_handle(CHECKBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Check_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Check_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_check_button_draw(CHECKBUTTON b) { - reinterpret_cast<My_Check_Button*>(b)->Fl_Check_Button::draw(); -} - -int fl_check_button_handle(CHECKBUTTON b, int e) { - return reinterpret_cast<My_Check_Button*>(b)->Fl_Check_Button::handle(e); -} - - diff --git a/src/c_fl_check_button.h b/src/c_fl_check_button.h deleted file mode 100644 index cfa6bff..0000000 --- a/src/c_fl_check_button.h +++ /dev/null @@ -1,29 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CHECK_BUTTON_GUARD -#define FL_CHECK_BUTTON_GUARD - - -extern "C" void fl_check_button_extra_init - (void * adaobj, int x, int y, int w, int h, const char * label); -extern "C" void fl_check_button_extra_final(void * adaobj); - - -typedef void* CHECKBUTTON; - - -extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_check_button(CHECKBUTTON b); - - -extern "C" void fl_check_button_draw(CHECKBUTTON b); -extern "C" int fl_check_button_handle(CHECKBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_choice.cpp b/src/c_fl_choice.cpp deleted file mode 100644 index e8c8374..0000000 --- a/src/c_fl_choice.cpp +++ /dev/null @@ -1,82 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Choice.H> -#include "c_fl_choice.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Choice : public Fl_Choice { -public: - using Fl_Choice::Fl_Choice; - - friend void fl_choice_draw(CHOICE n); - friend int fl_choice_handle(CHOICE n, int e); - - void draw(); - int handle(int e); -}; - -void My_Choice::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Choice::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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)); -} - - - - -void fl_choice_draw(CHOICE n) { - reinterpret_cast<My_Choice*>(n)->Fl_Choice::draw(); -} - -int fl_choice_handle(CHOICE n, int e) { - return reinterpret_cast<My_Choice*>(n)->Fl_Choice::handle(e); -} - - diff --git a/src/c_fl_choice.h b/src/c_fl_choice.h deleted file mode 100644 index 5d076b1..0000000 --- a/src/c_fl_choice.h +++ /dev/null @@ -1,29 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CHOICE_GUARD -#define FL_CHOICE_GUARD - - -typedef void* CHOICE; - - -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); - - -extern "C" void fl_choice_draw(CHOICE n); -extern "C" int fl_choice_handle(CHOICE n, int e); - - -#endif - - diff --git a/src/c_fl_clock.cpp b/src/c_fl_clock.cpp deleted file mode 100644 index a7e570e..0000000 --- a/src/c_fl_clock.cpp +++ /dev/null @@ -1,72 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Clock.H> -#include "c_fl_clock.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Clock : public Fl_Clock { -public: - using Fl_Clock::Fl_Clock; - - friend void fl_clock_draw(CLOCK c); - friend int fl_clock_handle(CLOCK c, int e); - - void draw(); - int handle(int e); -}; - -void My_Clock::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Clock::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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(unsigned char 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_draw(CLOCK c) { - reinterpret_cast<My_Clock*>(c)->Fl_Clock::draw(); -} - -int fl_clock_handle(CLOCK c, int e) { - return reinterpret_cast<My_Clock*>(c)->Fl_Clock::handle(e); -} - - diff --git a/src/c_fl_clock.h b/src/c_fl_clock.h deleted file mode 100644 index 4b07d7e..0000000 --- a/src/c_fl_clock.h +++ /dev/null @@ -1,25 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CLOCK_GUARD -#define FL_CLOCK_GUARD - - -typedef void* CLOCK; - - -extern "C" CLOCK new_fl_clock(int x, int y, int w, int h, char* label); -extern "C" CLOCK new_fl_clock2(unsigned char k, int x, int y, int w, int h, char* label); -extern "C" void free_fl_clock(CLOCK c); - - -extern "C" void fl_clock_draw(CLOCK c); -extern "C" int fl_clock_handle(CLOCK c, int e); - - -#endif - - diff --git a/src/c_fl_clock_output.cpp b/src/c_fl_clock_output.cpp deleted file mode 100644 index 91aaae4..0000000 --- a/src/c_fl_clock_output.cpp +++ /dev/null @@ -1,111 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Clock.H> -#include "c_fl_clock_output.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Clock_Output : Fl_Clock_Output { -public: - // Really only needed for the (int,int,int,int) version - using Fl_Clock_Output::draw; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Clock_Output : public Fl_Clock_Output { -public: - using Fl_Clock_Output::Fl_Clock_Output; - - friend void fl_clock_output_draw(CLOCK_OUTPUT c); - friend int fl_clock_output_handle(CLOCK_OUTPUT c, int e); - - void draw(); - int handle(int e); -}; - -void My_Clock_Output::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Clock_Output::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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(); -} - - -unsigned long 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, unsigned long 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_draw(CLOCK_OUTPUT c) { - reinterpret_cast<My_Clock_Output*>(c)->Fl_Clock_Output::draw(); -} - -void fl_clock_output_draw2(CLOCK_OUTPUT c, int x, int y, int w, int h) { - void (Fl_Clock_Output::*mydraw)(int,int,int,int) = &Friend_Clock_Output::draw; - (reinterpret_cast<Fl_Clock_Output*>(c)->*mydraw)(x, y, w, h); -} - -int fl_clock_output_handle(CLOCK_OUTPUT c, int e) { - return reinterpret_cast<My_Clock_Output*>(c)->Fl_Clock_Output::handle(e); -} - - diff --git a/src/c_fl_clock_output.h b/src/c_fl_clock_output.h deleted file mode 100644 index 6adb98d..0000000 --- a/src/c_fl_clock_output.h +++ /dev/null @@ -1,35 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_CLOCK_OUTPUT_GUARD -#define FL_CLOCK_OUTPUT_GUARD - - -typedef void* CLOCK_OUTPUT; - - -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" unsigned long fl_clock_output_get_value(CLOCK_OUTPUT c); -extern "C" void fl_clock_output_set_value(CLOCK_OUTPUT c, unsigned long v); -extern "C" void fl_clock_output_set_value2(CLOCK_OUTPUT c, int h, int m, int s); - - -extern "C" void fl_clock_output_draw(CLOCK_OUTPUT c); -extern "C" void fl_clock_output_draw2(CLOCK_OUTPUT c, int x, int y, int w, int h); -extern "C" int fl_clock_output_handle(CLOCK_OUTPUT c, int e); - - -#endif - - diff --git a/src/c_fl_color_chooser.cpp b/src/c_fl_color_chooser.cpp deleted file mode 100644 index 171155d..0000000 --- a/src/c_fl_color_chooser.cpp +++ /dev/null @@ -1,127 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Color_Chooser.H> -#include "c_fl_color_chooser.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Color_Chooser : public Fl_Color_Chooser { -public: - using Fl_Color_Chooser::Fl_Color_Chooser; - - friend void fl_color_chooser_draw(COLORCHOOSER n); - friend int fl_color_chooser_handle(COLORCHOOSER n, int e); - - void draw(); - int handle(int e); -}; - -void My_Color_Chooser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Color_Chooser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -COLORCHOOSER 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(COLORCHOOSER n) { - delete reinterpret_cast<My_Color_Chooser*>(n); -} - - - - -double fl_color_chooser_r(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->r(); -} - -double fl_color_chooser_g(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->g(); -} - -double fl_color_chooser_b(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->b(); -} - -int fl_color_chooser_rgb(COLORCHOOSER n, int r, int g, int b) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->rgb(r,g,b); -} - - - - -double fl_color_chooser_hue(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->hue(); -} - -double fl_color_chooser_saturation(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->saturation(); -} - -double fl_color_chooser_value(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->value(); -} - -int fl_color_chooser_hsv(COLORCHOOSER 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(COLORCHOOSER n) { - return reinterpret_cast<Fl_Color_Chooser*>(n)->mode(); -} - -void fl_color_chooser_set_mode(COLORCHOOSER n, int m) { - reinterpret_cast<Fl_Color_Chooser*>(n)->mode(m); -} - - - - -void fl_color_chooser_draw(COLORCHOOSER n) { - reinterpret_cast<My_Color_Chooser*>(n)->Fl_Color_Chooser::draw(); -} - -int fl_color_chooser_handle(COLORCHOOSER n, int e) { - return reinterpret_cast<My_Color_Chooser*>(n)->Fl_Color_Chooser::handle(e); -} - - diff --git a/src/c_fl_color_chooser.h b/src/c_fl_color_chooser.h deleted file mode 100644 index 22f9bc7..0000000 --- a/src/c_fl_color_chooser.h +++ /dev/null @@ -1,46 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_COLOR_CHOOSER_GUARD -#define FL_COLOR_CHOOSER_GUARD - - -typedef void* COLORCHOOSER; - - -extern "C" COLORCHOOSER new_fl_color_chooser(int x, int y, int w, int h, char* label); -extern "C" void free_fl_color_chooser(COLORCHOOSER n); - - -extern "C" double fl_color_chooser_r(COLORCHOOSER n); -extern "C" double fl_color_chooser_g(COLORCHOOSER n); -extern "C" double fl_color_chooser_b(COLORCHOOSER n); -extern "C" int fl_color_chooser_rgb(COLORCHOOSER n, int r, int g, int b); - - -extern "C" double fl_color_chooser_hue(COLORCHOOSER n); -extern "C" double fl_color_chooser_saturation(COLORCHOOSER n); -extern "C" double fl_color_chooser_value(COLORCHOOSER n); -extern "C" int fl_color_chooser_hsv(COLORCHOOSER 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(COLORCHOOSER n); -extern "C" void fl_color_chooser_set_mode(COLORCHOOSER n, int m); - - -extern "C" void fl_color_chooser_draw(COLORCHOOSER n); -extern "C" int fl_color_chooser_handle(COLORCHOOSER n, int e); - - -#endif - - diff --git a/src/c_fl_copy_surface.cpp b/src/c_fl_copy_surface.cpp deleted file mode 100644 index ff88735..0000000 --- a/src/c_fl_copy_surface.cpp +++ /dev/null @@ -1,55 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Copy_Surface.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_copy_surface.h" - - - - -// Flattened C API - -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 ed74e39..0000000 --- a/src/c_fl_copy_surface.h +++ /dev/null @@ -1,31 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 df8130e..0000000 --- a/src/c_fl_counter.cpp +++ /dev/null @@ -1,113 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Counter.H> -#include "c_fl_counter.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Counter : public Fl_Counter { -public: - using Fl_Counter::Fl_Counter; - - friend void fl_counter_draw(COUNTER c); - friend int fl_counter_handle(COUNTER c, int e); - - void draw(); - int handle(int e); -}; - -void My_Counter::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Counter::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_top(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); -} - -void fl_counter_set_step_both(COUNTER c, double s, double l) { - reinterpret_cast<Fl_Counter*>(c)->step(s, l); -} - - - - -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); -} - - - - -void fl_counter_draw(COUNTER c) { - reinterpret_cast<My_Counter*>(c)->Fl_Counter::draw(); -} - -int fl_counter_handle(COUNTER c, int e) { - return reinterpret_cast<My_Counter*>(c)->Fl_Counter::handle(e); -} - - diff --git a/src/c_fl_counter.h b/src/c_fl_counter.h deleted file mode 100644 index b5b4a8b..0000000 --- a/src/c_fl_counter.h +++ /dev/null @@ -1,38 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_COUNTER_GUARD -#define FL_COUNTER_GUARD - - -typedef void* COUNTER; - - -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_top(COUNTER c, double t); -extern "C" void fl_counter_set_lstep(COUNTER c, double t); -extern "C" void fl_counter_set_step_both(COUNTER c, double s, double l); - - -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); - - -extern "C" void fl_counter_draw(COUNTER c); -extern "C" int fl_counter_handle(COUNTER c, int e); - - -#endif - - diff --git a/src/c_fl_dial.cpp b/src/c_fl_dial.cpp deleted file mode 100644 index 8e32820..0000000 --- a/src/c_fl_dial.cpp +++ /dev/null @@ -1,112 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Dial.H> -#include "c_fl_dial.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Dial : Fl_Dial { -public: - // Really only needed for the (int,int,int,int) versions - using Fl_Dial::draw; - using Fl_Dial::handle; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Dial : public Fl_Dial { -public: - using Fl_Dial::Fl_Dial; - - friend void fl_dial_draw(DIAL v); - friend int fl_dial_handle(DIAL v, int e); - - void draw(); - int handle(int e); -}; - -void My_Dial::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Dial::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -short fl_dial_get_angle1(DIAL v) { - return reinterpret_cast<Fl_Dial*>(v)->angle1(); -} - -void fl_dial_set_angle1(DIAL v, short t) { - reinterpret_cast<Fl_Dial*>(v)->angle1(t); -} - -short fl_dial_get_angle2(DIAL v) { - return reinterpret_cast<Fl_Dial*>(v)->angle2(); -} - -void fl_dial_set_angle2(DIAL v, short t) { - reinterpret_cast<Fl_Dial*>(v)->angle2(t); -} - -void fl_dial_set_angles(DIAL v, short a, short b) { - reinterpret_cast<Fl_Dial*>(v)->angles(a,b); -} - - - - -void fl_dial_draw(DIAL v) { - reinterpret_cast<My_Dial*>(v)->Fl_Dial::draw(); -} - -void fl_dial_draw2(DIAL v, int x, int y, int w, int h) { - void (Fl_Dial::*mydraw)(int,int,int,int) = &Friend_Dial::draw; - (reinterpret_cast<Fl_Dial*>(v)->*mydraw)(x, y, w, h); -} - -int fl_dial_handle(DIAL v, int e) { - return reinterpret_cast<My_Dial*>(v)->Fl_Dial::handle(e); -} - -int fl_dial_handle2(DIAL v, int e, int x, int y, int w, int h) { - int (Fl_Dial::*myhandle)(int,int,int,int,int) = &Friend_Dial::handle; - return (reinterpret_cast<Fl_Dial*>(v)->*myhandle)(e, x, y, w, h); -} - - diff --git a/src/c_fl_dial.h b/src/c_fl_dial.h deleted file mode 100644 index b642abd..0000000 --- a/src/c_fl_dial.h +++ /dev/null @@ -1,33 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_DIAL_GUARD -#define FL_DIAL_GUARD - - -typedef void* DIAL; - - -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" short fl_dial_get_angle1(DIAL v); -extern "C" void fl_dial_set_angle1(DIAL v, short t); -extern "C" short fl_dial_get_angle2(DIAL v); -extern "C" void fl_dial_set_angle2(DIAL v, short t); -extern "C" void fl_dial_set_angles(DIAL v, short a, short b); - - -extern "C" void fl_dial_draw(DIAL v); -extern "C" void fl_dial_draw2(DIAL v, int x, int y, int w, int h); -extern "C" int fl_dial_handle(DIAL v, int e); -extern "C" int fl_dial_handle2(DIAL v, int e, int x, int y, int w, int h); - - -#endif - - diff --git a/src/c_fl_display_device.cpp b/src/c_fl_display_device.cpp deleted file mode 100644 index 9c88151..0000000 --- a/src/c_fl_display_device.cpp +++ /dev/null @@ -1,29 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Device.H> -#include "c_fl_display_device.h" - - - - -DISPLAYDEVICE new_fl_display_device(void * g) { - Fl_Display_Device *d = new Fl_Display_Device(reinterpret_cast<Fl_Graphics_Driver*>(g)); - return d; -} - -void free_fl_display_device(DISPLAYDEVICE d) { - delete reinterpret_cast<Fl_Display_Device*>(d); -} - - - - -DISPLAYDEVICE fl_display_device_display_device() { - return Fl_Display_Device::display_device(); -} - - diff --git a/src/c_fl_display_device.h b/src/c_fl_display_device.h deleted file mode 100644 index 1cf530c..0000000 --- a/src/c_fl_display_device.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_DISPLAY_DEVICE_GUARD -#define FL_DISPLAY_DEVICE_GUARD - - -typedef void* DISPLAYDEVICE; - - -extern "C" DISPLAYDEVICE new_fl_display_device(void * g); -extern "C" void free_fl_display_device(DISPLAYDEVICE d); - - -extern "C" DISPLAYDEVICE fl_display_device_display_device(); - - -#endif - - diff --git a/src/c_fl_double_window.cpp b/src/c_fl_double_window.cpp deleted file mode 100644 index 93c3f49..0000000 --- a/src/c_fl_double_window.cpp +++ /dev/null @@ -1,114 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Double_Window.H> -#include "c_fl_double_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Double_Window : Fl_Double_Window { -public: - // Only needed for the (int) version - using Fl_Double_Window::flush; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Double_Window : public Fl_Double_Window { -public: - using Fl_Double_Window::Fl_Double_Window; - - friend void fl_double_window_draw(DOUBLEWINDOW n); - friend int fl_double_window_handle(DOUBLEWINDOW n, int e); - - void draw(); - int handle(int e); -}; - -void My_Double_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Double_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_show2(DOUBLEWINDOW d, int c, void * v) { - reinterpret_cast<Fl_Double_Window*>(d)->show(c, static_cast<char**>(v)); -} - -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(); -} - -void fl_double_window_flush2(DOUBLEWINDOW d, int e) { - void (Fl_Double_Window::*myflush)(int) = &Friend_Double_Window::flush; - (reinterpret_cast<Fl_Double_Window*>(d)->*myflush)(e); -} - - - - -void fl_double_window_resize(DOUBLEWINDOW d, int x, int y, int w, int h) { - reinterpret_cast<Fl_Double_Window*>(d)->resize(x, y, w, h); -} - - - - -void fl_double_window_draw(DOUBLEWINDOW n) { - reinterpret_cast<My_Double_Window*>(n)->Fl_Double_Window::draw(); -} - -int fl_double_window_handle(DOUBLEWINDOW n, int e) { - return reinterpret_cast<My_Double_Window*>(n)->Fl_Double_Window::handle(e); -} - - diff --git a/src/c_fl_double_window.h b/src/c_fl_double_window.h deleted file mode 100644 index c6f4cc8..0000000 --- a/src/c_fl_double_window.h +++ /dev/null @@ -1,35 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_DOUBLE_WINDOW_GUARD -#define FL_DOUBLE_WINDOW_GUARD - - -typedef void* DOUBLEWINDOW; - - -extern "C" DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label); -extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h, 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_show2(DOUBLEWINDOW d, int c, void * v); -extern "C" void fl_double_window_hide(DOUBLEWINDOW d); -extern "C" void fl_double_window_flush(DOUBLEWINDOW d); -extern "C" void fl_double_window_flush2(DOUBLEWINDOW d, int e); - - -extern "C" void fl_double_window_resize(DOUBLEWINDOW d, int x, int y, int w, int h); - - -extern "C" void fl_double_window_draw(DOUBLEWINDOW n); -extern "C" int fl_double_window_handle(DOUBLEWINDOW n, int e); - - -#endif - - diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp deleted file mode 100644 index a649ceb..0000000 --- a/src/c_fl_draw.cpp +++ /dev/null @@ -1,447 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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); -} - -// function does not yet exist -// void fl_draw_chord(int x, int y, int w, int h, double a1, double a2) { -// function does not yet exist -// 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 50084f4..0000000 --- a/src/c_fl_draw.h +++ /dev/null @@ -1,138 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_error.cpp b/src/c_fl_error.cpp deleted file mode 100644 index e38481a..0000000 --- a/src/c_fl_error.cpp +++ /dev/null @@ -1,98 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl.H> -#include <errno.h> -#include <stdarg.h> -#include <string.h> -#include "c_fl_error.h" - - - - -// Obtaining general error messages from errno - -char * get_error_message() { - return strerror(errno); -} - - - - -// Exports from Ada - -extern "C" void error_warning_hook(const char * m); -extern "C" void error_error_hook(const char * m); -extern "C" void error_fatal_hook(const char * m); - - -// This is the size used internally in FLTK anyway -const int error_bsize = 1024; - - -// Some prep needed to convert vargs to a single char* - -void warning_hook_prep(const char * m, ...) { - va_list args; - char buf[error_bsize]; - va_start(args, m); - vsnprintf(buf, error_bsize, m, args); - va_end(args); - error_warning_hook(buf); -} - -void error_hook_prep(const char * m, ...) { - va_list args; - char buf[error_bsize]; - va_start(args, m); - vsnprintf(buf, error_bsize, m, args); - va_end(args); - error_error_hook(buf); -} - -void fatal_hook_prep(const char * m, ...) { - va_list args; - char buf[error_bsize]; - va_start(args, m); - vsnprintf(buf, error_bsize, m, args); - va_end(args); - error_fatal_hook(buf); -} - - - - -// Original function pointers - -void (*original_warning)(const char *, ...) = Fl::warning; -void (*original_error)(const char *, ...) = Fl::error; -void (*original_fatal)(const char *, ...) = Fl::fatal; - - -void fl_error_default_warning(const char * m) { - (*original_warning)(m); -} - -void fl_error_default_error(const char * m) { - (*original_error)(m); -} - -void fl_error_default_fatal(const char * m) { - (*original_fatal)(m); -} - - - - -// Tying it all together - -void fl_error_set_hooks() { - Fl::warning = &warning_hook_prep; - Fl::error = &error_hook_prep; - Fl::fatal = &fatal_hook_prep; -} - - diff --git a/src/c_fl_error.h b/src/c_fl_error.h deleted file mode 100644 index 1d4bc76..0000000 --- a/src/c_fl_error.h +++ /dev/null @@ -1,27 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ERROR_GUARD -#define FL_ERROR_GUARD - - -extern "C" char * get_error_message(); - - -extern "C" const int error_bsize; - - -extern "C" void fl_error_default_warning(const char * m); -extern "C" void fl_error_default_error(const char * m); -extern "C" void fl_error_default_fatal(const char * m); - - -extern "C" void fl_error_set_hooks(); - - -#endif - - diff --git a/src/c_fl_event.cpp b/src/c_fl_event.cpp deleted file mode 100644 index c5d7651..0000000 --- a/src/c_fl_event.cpp +++ /dev/null @@ -1,194 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 58c8314..0000000 --- a/src/c_fl_event.h +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_browser.cpp b/src/c_fl_file_browser.cpp deleted file mode 100644 index 8b5b632..0000000 --- a/src/c_fl_file_browser.cpp +++ /dev/null @@ -1,331 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_File_Browser.H> -#include <FL/Fl_Browser.H> -#include <FL/filename.H> -#include "c_fl_file_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -// extern "C" int browser_full_height_hook(void * b); -// extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -// extern "C" int browser_item_width_hook(void * b, void * i); -// extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -// extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected / private access - -// Should check these in future versions of FLTK to see whether -// it is possible to change them back to being overridden properly. - -class Friend_Browser : Fl_Browser { -public: - using Fl_Browser::full_height; - using Fl_Browser::incr_height; - using Fl_Browser::item_width; - using Fl_Browser::item_height; - using Fl_Browser::item_draw; -}; - - - - -// Attaching all relevant hooks and friends - -class My_File_Browser : public Fl_File_Browser { -public: - using Fl_File_Browser::Fl_File_Browser; - - friend int fl_file_browser_item_width(FILEBROWSER b, void * item); - friend int fl_file_browser_item_height(FILEBROWSER b, void * item); - friend void * fl_file_browser_item_first(FILEBROWSER b); - friend void * fl_file_browser_item_last(FILEBROWSER b); - friend void * fl_file_browser_item_next(FILEBROWSER b, void * item); - friend void * fl_file_browser_item_prev(FILEBROWSER b, void * item); - friend void * fl_file_browser_item_at(FILEBROWSER b, int index); - friend void fl_file_browser_item_select(FILEBROWSER b, void * item, int val); - friend int fl_file_browser_item_selected(FILEBROWSER b, void * item); - friend void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y); - friend const char * fl_file_browser_item_text(FILEBROWSER b, void * item); - friend void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h); - - friend int fl_file_browser_full_width(FILEBROWSER c); - friend int fl_file_browser_full_height(FILEBROWSER c); - friend int fl_file_browser_incr_height(FILEBROWSER c); - friend int fl_file_browser_item_quick_height(FILEBROWSER c, void * i); - - friend void fl_file_browser_draw(FILEBROWSER b); - - int handle(int e); - -protected: - int full_width() const; - // int full_height() const; - // int incr_height() const; - int item_quick_height(void * item) const; - - // int item_width(void * item) const; - // int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - // void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); -}; - - -int My_File_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -// int My_File_Browser::full_height() const { -// return browser_full_height_hook(this->user_data()); -// } - -// int My_File_Browser::incr_height() const { -// return browser_incr_height_hook(this->user_data()); -// } - -int My_File_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -// int My_File_Browser::item_width(void * item) const { -// return browser_item_width_hook(this->user_data(), item); -// } - -// int My_File_Browser::item_height(void * item) const { -// return browser_item_height_hook(this->user_data(), item); -// } - -void * My_File_Browser::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_File_Browser::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_File_Browser::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_File_Browser::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_File_Browser::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_File_Browser::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_File_Browser::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_File_Browser::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_File_Browser::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -// void My_File_Browser::item_draw(void * item, int x, int y, int w, int h) const { -// browser_item_draw_hook(this->user_data(), item, x, y, w, h); -// } - - -void My_File_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_File_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -FILEBROWSER new_fl_file_browser(int x, int y, int w, int h, char * label) { - My_File_Browser *b = new My_File_Browser(x, y, w, h, label); - return b; -} - -void free_fl_file_browser(FILEBROWSER b) { - delete reinterpret_cast<My_File_Browser*>(b); -} - - - - -int fl_file_browser_load(FILEBROWSER b, const char * d, void * s) { - return reinterpret_cast<Fl_File_Browser*>(b)->load(d, reinterpret_cast<Fl_File_Sort_F*>(s)); -} - - - - -int fl_file_browser_get_filetype(FILEBROWSER b) { - return reinterpret_cast<Fl_File_Browser*>(b)->filetype(); -} - -void fl_file_browser_set_filetype(FILEBROWSER b, int f) { - reinterpret_cast<Fl_File_Browser*>(b)->filetype(f); -} - -const char * fl_file_browser_get_filter(FILEBROWSER b) { - return reinterpret_cast<Fl_File_Browser*>(b)->filter(); -} - -void fl_file_browser_set_filter(FILEBROWSER b, const char * f) { - reinterpret_cast<Fl_File_Browser*>(b)->filter(f); -} - -unsigned char fl_file_browser_get_iconsize(FILEBROWSER b) { - return reinterpret_cast<Fl_File_Browser*>(b)->iconsize(); -} - -void fl_file_browser_set_iconsize(FILEBROWSER b, unsigned int i) { - reinterpret_cast<Fl_File_Browser*>(b)->iconsize(i); -} - -int fl_file_browser_get_textsize(FILEBROWSER b) { - return reinterpret_cast<Fl_File_Browser*>(b)->textsize(); -} - -void fl_file_browser_set_textsize(FILEBROWSER b, int s) { - reinterpret_cast<Fl_File_Browser*>(b)->textsize(s); -} - - - - -// These have to be reimplemented due to relying on custom class extensions - - -int fl_file_browser_full_height(FILEBROWSER c) { - // return reinterpret_cast<My_File_Browser*>(c)->Fl_File_Browser::full_height(); - return (reinterpret_cast<Fl_File_Browser*>(c)->*(&Friend_Browser::full_height))(); -} - -int fl_file_browser_incr_height(FILEBROWSER c) { - // return reinterpret_cast<My_File_Browser*>(c)->Fl_File_Browser::incr_height(); - return (reinterpret_cast<Fl_File_Browser*>(c)->*(&Friend_Browser::incr_height))(); -} - - - - -int fl_file_browser_item_width(FILEBROWSER b, void * item) { - // return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_width(item); - return (reinterpret_cast<Fl_File_Browser*>(b)->*(&Friend_Browser::item_width))(item); -} - -int fl_file_browser_item_height(FILEBROWSER b, void * item) { - // return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_height(item); - return (reinterpret_cast<My_File_Browser*>(b)->*(&Friend_Browser::item_height))(item); -} - -void * fl_file_browser_item_first(FILEBROWSER b) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_first(); -} - -void * fl_file_browser_item_last(FILEBROWSER b) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_last(); -} - -void * fl_file_browser_item_next(FILEBROWSER b, void * item) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_next(item); -} - -void * fl_file_browser_item_prev(FILEBROWSER b, void * item) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_prev(item); -} - -void * fl_file_browser_item_at(FILEBROWSER b, int index) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_at(index); -} - -void fl_file_browser_item_select(FILEBROWSER b, void * item, int val) { - reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_select(item, val); -} - -int fl_file_browser_item_selected(FILEBROWSER b, void * item) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_selected(item); -} - -void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y) { - reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_swap(x, y); -} - -const char * fl_file_browser_item_text(FILEBROWSER b, void * item) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_text(item); -} - -void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h) { - // reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::item_draw(item, x, y, w, h); - (reinterpret_cast<Fl_File_Browser*>(b)->*(&Friend_Browser::item_draw))(item, x, y, w, h); -} - - - - -int fl_file_browser_full_width(FILEBROWSER c) { - return reinterpret_cast<My_File_Browser*>(c)->Fl_File_Browser::full_width(); -} - -int fl_file_browser_item_quick_height(FILEBROWSER c, void * i) { - return reinterpret_cast<My_File_Browser*>(c)->Fl_File_Browser::item_quick_height(i); -} - - - - -void fl_file_browser_draw(FILEBROWSER b) { - reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::draw(); -} - -int fl_file_browser_handle(FILEBROWSER b, int e) { - return reinterpret_cast<My_File_Browser*>(b)->Fl_File_Browser::handle(e); -} - - diff --git a/src/c_fl_file_browser.h b/src/c_fl_file_browser.h deleted file mode 100644 index 67e1489..0000000 --- a/src/c_fl_file_browser.h +++ /dev/null @@ -1,61 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILE_BROWSER_GUARD -#define FL_FILE_BROWSER_GUARD - - -typedef void* FILEBROWSER; - - -extern "C" FILEBROWSER new_fl_file_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_file_browser(FILEBROWSER b); - - -extern "C" int fl_file_browser_load(FILEBROWSER b, const char * d, void * s); - - -extern "C" int fl_file_browser_get_filetype(FILEBROWSER b); -extern "C" void fl_file_browser_set_filetype(FILEBROWSER b, int f); -extern "C" const char * fl_file_browser_get_filter(FILEBROWSER b); -extern "C" void fl_file_browser_set_filter(FILEBROWSER b, const char * f); -extern "C" unsigned char fl_file_browser_get_iconsize(FILEBROWSER b); -extern "C" void fl_file_browser_set_iconsize(FILEBROWSER b, unsigned int i); -extern "C" int fl_file_browser_get_textsize(FILEBROWSER b); -extern "C" void fl_file_browser_set_textsize(FILEBROWSER b, int s); - - -// reimp below here - -extern "C" int fl_file_browser_full_height(FILEBROWSER c); -extern "C" int fl_file_browser_incr_height(FILEBROWSER c); - - -extern "C" int fl_file_browser_item_width(FILEBROWSER b, void * item); -extern "C" int fl_file_browser_item_height(FILEBROWSER b, void * item); -extern "C" void * fl_file_browser_item_first(FILEBROWSER b); -extern "C" void * fl_file_browser_item_last(FILEBROWSER b); -extern "C" void * fl_file_browser_item_next(FILEBROWSER b, void * item); -extern "C" void * fl_file_browser_item_prev(FILEBROWSER b, void * item); -extern "C" void * fl_file_browser_item_at(FILEBROWSER b, int index); -extern "C" void fl_file_browser_item_select(FILEBROWSER b, void * item, int val=1); -extern "C" int fl_file_browser_item_selected(FILEBROWSER b, void * item); -extern "C" void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y); -extern "C" const char * fl_file_browser_item_text(FILEBROWSER b, void * item); -extern "C" void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h); - - -extern "C" int fl_file_browser_full_width(FILEBROWSER c); -extern "C" int fl_file_browser_item_quick_height(FILEBROWSER c, void * i); - - -extern "C" void fl_file_browser_draw(FILEBROWSER b); -extern "C" int fl_file_browser_handle(FILEBROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_file_chooser.cpp b/src/c_fl_file_chooser.cpp deleted file mode 100644 index 3ca16e2..0000000 --- a/src/c_fl_file_chooser.cpp +++ /dev/null @@ -1,340 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_File_Chooser.H> -#include <FL/Fl_Widget.H> -#include "c_fl_file_chooser.h" - - - - -// Exports from Ada - -extern "C" int file_chooser_sort_hook(const char * a, const char * b); - - - - -// Some extra setup - -int file_chooser_sort_prehook(struct dirent ** a, struct dirent ** b) { - return file_chooser_sort_hook((*a)->d_name, (*b)->d_name); -} - -void file_chooser_setup_sort_hook() { - Fl_File_Chooser::sort = &file_chooser_sort_prehook; -} - - - - -// Flattened C API begins here - -FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t) { - Fl_File_Chooser *f = new Fl_File_Chooser(n, p, k, t); - return f; -} - -void free_fl_file_chooser(FILECHOOSER f) { - delete reinterpret_cast<Fl_File_Chooser*>(f); -} - - - - -void * fl_file_chooser_get_user_data(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->user_data(); -} - -void fl_file_chooser_set_user_data(FILECHOOSER f, void * ud) { - reinterpret_cast<Fl_File_Chooser*>(f)->user_data(ud); -} - - - - -void * fl_file_chooser_newbutton(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->newButton; -} - -void * fl_file_chooser_previewbutton(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->previewButton; -} - -void * fl_file_chooser_showhiddenbutton(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->showHiddenButton; -} - - - - -const char * fl_file_chooser_get_add_favorites_label() { - return Fl_File_Chooser::add_favorites_label; -} - -void fl_file_chooser_set_add_favorites_label(const char * s) { - Fl_File_Chooser::add_favorites_label = s; -} - -const char * fl_file_chooser_get_all_files_label() { - return Fl_File_Chooser::all_files_label; -} - -void fl_file_chooser_set_all_files_label(const char * s) { - Fl_File_Chooser::all_files_label = s; -} - -const char * fl_file_chooser_get_custom_filter_label() { - return Fl_File_Chooser::custom_filter_label; -} - -void fl_file_chooser_set_custom_filter_label(const char * s) { - Fl_File_Chooser::custom_filter_label = s; -} - -const char * fl_file_chooser_get_existing_file_label() { - return Fl_File_Chooser::existing_file_label; -} - -void fl_file_chooser_set_existing_file_label(const char * s) { - Fl_File_Chooser::existing_file_label = s; -} - -const char * fl_file_chooser_get_favorites_label() { - return Fl_File_Chooser::favorites_label; -} - -void fl_file_chooser_set_favorites_label(const char * s) { - Fl_File_Chooser::favorites_label = s; -} - -const char * fl_file_chooser_get_filename_label() { - return Fl_File_Chooser::filename_label; -} - -void fl_file_chooser_set_filename_label(const char * s) { - Fl_File_Chooser::filename_label = s; -} - -const char * fl_file_chooser_get_filesystems_label() { - return Fl_File_Chooser::filesystems_label; -} - -void fl_file_chooser_set_filesystems_label(const char * s) { - Fl_File_Chooser::filesystems_label = s; -} - -const char * fl_file_chooser_get_hidden_label() { - return Fl_File_Chooser::hidden_label; -} - -void fl_file_chooser_set_hidden_label(const char * s) { - Fl_File_Chooser::hidden_label = s; -} - -const char * fl_file_chooser_get_manage_favorites_label() { - return Fl_File_Chooser::manage_favorites_label; -} - -void fl_file_chooser_set_manage_favorites_label(const char * s) { - Fl_File_Chooser::manage_favorites_label = s; -} - -const char * fl_file_chooser_get_new_directory_label() { - return Fl_File_Chooser::new_directory_label; -} - -void fl_file_chooser_set_new_directory_label(const char * s) { - Fl_File_Chooser::new_directory_label = s; -} - -const char * fl_file_chooser_get_new_directory_tooltip() { - return Fl_File_Chooser::new_directory_tooltip; -} - -void fl_file_chooser_set_new_directory_tooltip(const char * s) { - Fl_File_Chooser::new_directory_tooltip = s; -} - -const char * fl_file_chooser_get_preview_label() { - return Fl_File_Chooser::preview_label; -} - -void fl_file_chooser_set_preview_label(const char * s) { - Fl_File_Chooser::preview_label = s; -} - -const char * fl_file_chooser_get_save_label() { - return Fl_File_Chooser::save_label; -} - -void fl_file_chooser_set_save_label(const char * s) { - Fl_File_Chooser::save_label = s; -} - -const char * fl_file_chooser_get_show_label() { - return Fl_File_Chooser::show_label; -} - -void fl_file_chooser_set_show_label(const char * s) { - Fl_File_Chooser::show_label = s; -} - - - - -void * fl_file_chooser_add_extra(FILECHOOSER f, void * w) { - return reinterpret_cast<Fl_File_Chooser*>(f)->add_extra(reinterpret_cast<Fl_Widget*>(w)); -} - -typedef void (*Chooser_Callback)(Fl_File_Chooser *, void *); - -void fl_file_chooser_callback(FILECHOOSER f, void * c, void * u) { - reinterpret_cast<Fl_File_Chooser*>(f)->callback(reinterpret_cast<Chooser_Callback>(c), u); -} - - - - -unsigned int fl_file_chooser_get_color(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->color(); -} - -void fl_file_chooser_set_color(FILECHOOSER f, unsigned int c) { - reinterpret_cast<Fl_File_Chooser*>(f)->color(c); -} - -unsigned char fl_file_chooser_get_iconsize(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->iconsize(); -} - -void fl_file_chooser_set_iconsize(FILECHOOSER f, unsigned char i) { - reinterpret_cast<Fl_File_Chooser*>(f)->iconsize(i); -} - -const char * fl_file_chooser_get_label(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->label(); -} - -void fl_file_chooser_set_label(FILECHOOSER f, const char * t) { - reinterpret_cast<Fl_File_Chooser*>(f)->label(t); -} - -const char * fl_file_chooser_get_ok_label(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->ok_label(); -} - -void fl_file_chooser_set_ok_label(FILECHOOSER f, const char * t) { - reinterpret_cast<Fl_File_Chooser*>(f)->ok_label(t); -} - -int fl_file_chooser_get_preview(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->preview(); -} - -void fl_file_chooser_set_preview(FILECHOOSER f, int p) { - reinterpret_cast<Fl_File_Chooser*>(f)->preview(p); -} - -unsigned int fl_file_chooser_get_textcolor(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->textcolor(); -} - -void fl_file_chooser_set_textcolor(FILECHOOSER f, unsigned int c) { - reinterpret_cast<Fl_File_Chooser*>(f)->textcolor(c); -} - -int fl_file_chooser_get_textfont(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->textfont(); -} - -void fl_file_chooser_set_textfont(FILECHOOSER f, int n) { - reinterpret_cast<Fl_File_Chooser*>(f)->textfont(n); -} - -int fl_file_chooser_get_textsize(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->textsize(); -} - -void fl_file_chooser_set_textsize(FILECHOOSER f, int s) { - reinterpret_cast<Fl_File_Chooser*>(f)->textsize(s); -} - -int fl_file_chooser_get_type(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->type(); -} - -void fl_file_chooser_set_type(FILECHOOSER f, int t) { - reinterpret_cast<Fl_File_Chooser*>(f)->type(t); -} - - - - -int fl_file_chooser_count(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->count(); -} - -const char * fl_file_chooser_get_directory(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->directory(); -} - -void fl_file_chooser_set_directory(FILECHOOSER f, const char * v) { - reinterpret_cast<Fl_File_Chooser*>(f)->directory(v); -} - -const char * fl_file_chooser_get_filter(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->filter(); -} - -void fl_file_chooser_set_filter(FILECHOOSER f, const char * v) { - reinterpret_cast<Fl_File_Chooser*>(f)->filter(v); -} - -int fl_file_chooser_get_filter_value(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->filter_value(); -} - -void fl_file_chooser_set_filter_value(FILECHOOSER f, int v) { - reinterpret_cast<Fl_File_Chooser*>(f)->filter_value(v); -} - -void fl_file_chooser_rescan(FILECHOOSER f) { - reinterpret_cast<Fl_File_Chooser*>(f)->rescan(); -} - -void fl_file_chooser_rescan_keep_filename(FILECHOOSER f) { - reinterpret_cast<Fl_File_Chooser*>(f)->rescan_keep_filename(); -} - -const char * fl_file_chooser_get_value(FILECHOOSER f, int n) { - return reinterpret_cast<Fl_File_Chooser*>(f)->value(n); -} - -void fl_file_chooser_set_value(FILECHOOSER f, const char * v) { - reinterpret_cast<Fl_File_Chooser*>(f)->value(v); -} - - - - -void fl_file_chooser_show(FILECHOOSER f) { - reinterpret_cast<Fl_File_Chooser*>(f)->show(); -} - -void fl_file_chooser_hide(FILECHOOSER f) { - reinterpret_cast<Fl_File_Chooser*>(f)->hide(); -} - -int fl_file_chooser_shown(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->shown(); -} - -int fl_file_chooser_visible(FILECHOOSER f) { - return reinterpret_cast<Fl_File_Chooser*>(f)->visible(); -} - - diff --git a/src/c_fl_file_chooser.h b/src/c_fl_file_chooser.h deleted file mode 100644 index 17ee63c..0000000 --- a/src/c_fl_file_chooser.h +++ /dev/null @@ -1,105 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILE_CHOOSER_GUARD -#define FL_FILE_CHOOSER_GUARD - - -typedef void* FILECHOOSER; - - -extern "C" void file_chooser_setup_sort_hook(); - - -extern "C" FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t); -extern "C" void free_fl_file_chooser(FILECHOOSER f); - - -extern "C" void * fl_file_chooser_get_user_data(FILECHOOSER f); -extern "C" void fl_file_chooser_set_user_data(FILECHOOSER f, void * ud); - - -extern "C" void * fl_file_chooser_newbutton(FILECHOOSER f); -extern "C" void * fl_file_chooser_previewbutton(FILECHOOSER f); -extern "C" void * fl_file_chooser_showhiddenbutton(FILECHOOSER f); - - -extern "C" const char * fl_file_chooser_get_add_favorites_label(); -extern "C" void fl_file_chooser_set_add_favorites_label(const char * s); -extern "C" const char * fl_file_chooser_get_all_files_label(); -extern "C" void fl_file_chooser_set_all_files_label(const char * s); -extern "C" const char * fl_file_chooser_get_custom_filter_label(); -extern "C" void fl_file_chooser_set_custom_filter_label(const char * s); -extern "C" const char * fl_file_chooser_get_existing_file_label(); -extern "C" void fl_file_chooser_set_existing_file_label(const char * s); -extern "C" const char * fl_file_chooser_get_favorites_label(); -extern "C" void fl_file_chooser_set_favorites_label(const char * s); -extern "C" const char * fl_file_chooser_get_filename_label(); -extern "C" void fl_file_chooser_set_filename_label(const char * s); -extern "C" const char * fl_file_chooser_get_filesystems_label(); -extern "C" void fl_file_chooser_set_filesystems_label(const char * s); -extern "C" const char * fl_file_chooser_get_hidden_label(); -extern "C" void fl_file_chooser_set_hidden_label(const char * s); -extern "C" const char * fl_file_chooser_get_manage_favorites_label(); -extern "C" void fl_file_chooser_set_manage_favorites_label(const char * s); -extern "C" const char * fl_file_chooser_get_new_directory_label(); -extern "C" void fl_file_chooser_set_new_directory_label(const char * s); -extern "C" const char * fl_file_chooser_get_new_directory_tooltip(); -extern "C" void fl_file_chooser_set_new_directory_tooltip(const char * s); -extern "C" const char * fl_file_chooser_get_preview_label(); -extern "C" void fl_file_chooser_set_preview_label(const char * s); -extern "C" const char * fl_file_chooser_get_save_label(); -extern "C" void fl_file_chooser_set_save_label(const char * s); -extern "C" const char * fl_file_chooser_get_show_label(); -extern "C" void fl_file_chooser_set_show_label(const char * s); - - -extern "C" void * fl_file_chooser_add_extra(FILECHOOSER f, void * w); -extern "C" void fl_file_chooser_callback(FILECHOOSER f, void * c, void * u); - - -extern "C" unsigned int fl_file_chooser_get_color(FILECHOOSER f); -extern "C" void fl_file_chooser_set_color(FILECHOOSER f, unsigned int c); -extern "C" unsigned char fl_file_chooser_get_iconsize(FILECHOOSER f); -extern "C" void fl_file_chooser_set_iconsize(FILECHOOSER f, unsigned char i); -extern "C" const char * fl_file_chooser_get_label(FILECHOOSER f); -extern "C" void fl_file_chooser_set_label(FILECHOOSER f, const char * t); -extern "C" const char * fl_file_chooser_get_ok_label(FILECHOOSER f); -extern "C" void fl_file_chooser_set_ok_label(FILECHOOSER f, const char * t); -extern "C" int fl_file_chooser_get_preview(FILECHOOSER f); -extern "C" void fl_file_chooser_set_preview(FILECHOOSER f, int p); -extern "C" unsigned int fl_file_chooser_get_textcolor(FILECHOOSER f); -extern "C" void fl_file_chooser_set_textcolor(FILECHOOSER f, unsigned int c); -extern "C" int fl_file_chooser_get_textfont(FILECHOOSER f); -extern "C" void fl_file_chooser_set_textfont(FILECHOOSER f, int n); -extern "C" int fl_file_chooser_get_textsize(FILECHOOSER f); -extern "C" void fl_file_chooser_set_textsize(FILECHOOSER f, int s); -extern "C" int fl_file_chooser_get_type(FILECHOOSER f); -extern "C" void fl_file_chooser_set_type(FILECHOOSER f, int t); - - -extern "C" int fl_file_chooser_count(FILECHOOSER f); -extern "C" const char * fl_file_chooser_get_directory(FILECHOOSER f); -extern "C" void fl_file_chooser_set_directory(FILECHOOSER f, const char * v); -extern "C" const char * fl_file_chooser_get_filter(FILECHOOSER f); -extern "C" void fl_file_chooser_set_filter(FILECHOOSER f, const char * v); -extern "C" int fl_file_chooser_get_filter_value(FILECHOOSER f); -extern "C" void fl_file_chooser_set_filter_value(FILECHOOSER f, int v); -extern "C" void fl_file_chooser_rescan(FILECHOOSER f); -extern "C" void fl_file_chooser_rescan_keep_filename(FILECHOOSER f); -extern "C" const char * fl_file_chooser_get_value(FILECHOOSER f, int n); -extern "C" void fl_file_chooser_set_value(FILECHOOSER f, const char * v); - - -extern "C" void fl_file_chooser_show(FILECHOOSER f); -extern "C" void fl_file_chooser_hide(FILECHOOSER f); -extern "C" int fl_file_chooser_shown(FILECHOOSER f); -extern "C" int fl_file_chooser_visible(FILECHOOSER f); - - -#endif - - diff --git a/src/c_fl_file_input.cpp b/src/c_fl_file_input.cpp deleted file mode 100644 index adf8f37..0000000 --- a/src/c_fl_file_input.cpp +++ /dev/null @@ -1,97 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_File_Input.H> -#include "c_fl_file_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_File_Input : public Fl_File_Input { -public: - using Fl_File_Input::Fl_File_Input; - - friend void fl_file_input_draw(FILEINPUT i); - friend int fl_file_input_handle(FILEINPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_File_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_File_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label) { - My_File_Input *i = new My_File_Input(x, y, w, h, label); - return i; -} - -void free_fl_file_input(FILEINPUT i) { - delete reinterpret_cast<My_File_Input*>(i); -} - - - - -int fl_file_input_get_down_box(FILEINPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->down_box(); -} - -void fl_file_input_set_down_box(FILEINPUT i, int t) { - reinterpret_cast<Fl_File_Input*>(i)->down_box(static_cast<Fl_Boxtype>(t)); -} - -unsigned int fl_file_input_get_errorcolor(FILEINPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->errorcolor(); -} - -void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t) { - reinterpret_cast<Fl_File_Input*>(i)->errorcolor(t); -} - - - - -const char * fl_file_input_get_value(FILEINPUT i) { - return reinterpret_cast<Fl_File_Input*>(i)->value(); -} - -int fl_file_input_set_value(FILEINPUT i, const char * s, int len) { - return reinterpret_cast<Fl_File_Input*>(i)->value(s,len); -} - - - - -void fl_file_input_draw(FILEINPUT i) { - reinterpret_cast<My_File_Input*>(i)->Fl_File_Input::draw(); -} - -int fl_file_input_handle(FILEINPUT i, int e) { - return reinterpret_cast<My_File_Input*>(i)->Fl_File_Input::handle(e); -} - - diff --git a/src/c_fl_file_input.h b/src/c_fl_file_input.h deleted file mode 100644 index df05cbb..0000000 --- a/src/c_fl_file_input.h +++ /dev/null @@ -1,34 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILE_INPUT_GUARD -#define FL_FILE_INPUT_GUARD - - -typedef void* FILEINPUT; - - -extern "C" FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_file_input(FILEINPUT i); - - -extern "C" int fl_file_input_get_down_box(FILEINPUT i); -extern "C" void fl_file_input_set_down_box(FILEINPUT i, int t); -extern "C" unsigned int fl_file_input_get_errorcolor(FILEINPUT i); -extern "C" void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t); - - -extern "C" const char * fl_file_input_get_value(FILEINPUT i); -extern "C" int fl_file_input_set_value(FILEINPUT i, const char * s, int len); - - -extern "C" void fl_file_input_draw(FILEINPUT i); -extern "C" int fl_file_input_handle(FILEINPUT i, int e); - - -#endif - - diff --git a/src/c_fl_filename.cpp b/src/c_fl_filename.cpp deleted file mode 100644 index 39af3d1..0000000 --- a/src/c_fl_filename.cpp +++ /dev/null @@ -1,127 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/filename.H> -#include <string.h> -#include "c_fl_filename.h" - - - - -const int fl_path_max = FL_PATH_MAX; - - - - -void free_filename_file_list(void * l, int n) { - struct dirent ** p = reinterpret_cast<struct dirent **>(l); - fl_filename_free_list(&p, n); -} - -const char * filename_dname(void * l, int n) { - return (reinterpret_cast<struct dirent **>(l)[n])->d_name; -} - - - - -void filename_decode_uri(char *uri) { - fl_decode_uri(uri); -} - -int filename_absolute(char * to, int tolen, const char * from) { - return fl_filename_absolute(to, tolen, from); -} - -int filename_expand(char * to, int tolen, const char * from) { - return fl_filename_expand(to, tolen, from); -} - -const char * filename_ext(const char * buf) { - return fl_filename_ext(buf); -} - -int filename_isdir(const char * name) { - return fl_filename_isdir(name); -} - -int filename_list(const char * d, void * l, void * f) { - return fl_filename_list(d, reinterpret_cast<struct dirent ***>(l), - reinterpret_cast<Fl_File_Sort_F*>(f)); -} - -int filename_match(const char * name, const char * pattern) { - return fl_filename_match(name, pattern); -} - -const char * filename_name(const char * name) { - return fl_filename_name(name); -} - -int filename_relative(char * to, int tolen, const char * from) { - return fl_filename_relative(to, tolen, from); -} - -char * filename_setext(char * to, int tolen, const char * ext) { - return fl_filename_setext(to, tolen, ext); -} - -int filename_open_uri(const char * uri, char * msg, int msglen) { - return fl_open_uri(uri, msg, msglen); -} - - - - -int filename_alphasort(char * a, char * b) { - struct dirent d_aye, d_bee; - d_aye.d_name[0] = '\0'; - strncat (d_aye.d_name, a, 255); - d_bee.d_name[0] = '\0'; - strncat (d_bee.d_name, b, 255); - struct dirent * dp_aye = &d_aye; - struct dirent * dp_bee = &d_bee; - int result = fl_alphasort(&dp_aye, &dp_bee); - return result < 0 ? 0 : result == 0 ? 1 : 2; -} - -int filename_casealphasort(char * a, char * b) { - struct dirent d_aye, d_bee; - d_aye.d_name[0] = '\0'; - strncat (d_aye.d_name, a, 255); - d_bee.d_name[0] = '\0'; - strncat (d_bee.d_name, b, 255); - struct dirent * dp_aye = &d_aye; - struct dirent * dp_bee = &d_bee; - int result = fl_casealphasort(&dp_aye, &dp_bee); - return result < 0 ? 0 : result == 0 ? 1 : 2; -} - -int filename_numericsort(char * a, char * b) { - struct dirent d_aye, d_bee; - d_aye.d_name[0] = '\0'; - strncat (d_aye.d_name, a, 255); - d_bee.d_name[0] = '\0'; - strncat (d_bee.d_name, b, 255); - struct dirent * dp_aye = &d_aye; - struct dirent * dp_bee = &d_bee; - int result = fl_numericsort(&dp_aye, &dp_bee); - return result < 0 ? 0 : result == 0 ? 1 : 2; -} - -int filename_casenumericsort(char * a, char * b) { - struct dirent d_aye, d_bee; - d_aye.d_name[0] = '\0'; - strncat (d_aye.d_name, a, 255); - d_bee.d_name[0] = '\0'; - strncat (d_bee.d_name, b, 255); - struct dirent * dp_aye = &d_aye; - struct dirent * dp_bee = &d_bee; - int result = fl_casenumericsort(&dp_aye, &dp_bee); - return result < 0 ? 0 : result == 0 ? 1 : 2; -} - - diff --git a/src/c_fl_filename.h b/src/c_fl_filename.h deleted file mode 100644 index 0839293..0000000 --- a/src/c_fl_filename.h +++ /dev/null @@ -1,39 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILENAME_GUARD -#define FL_FILENAME_GUARD - - -extern "C" const int fl_path_max; - - -extern "C" void free_filename_file_list(void * l, int n); -extern "C" const char * filename_dname(void * l, int n); - - -extern "C" void filename_decode_uri(char *uri); -extern "C" int filename_absolute(char * to, int tolen, const char * from); -extern "C" int filename_expand(char * to, int tolen, const char * from); -extern "C" const char * filename_ext(const char * buf); -extern "C" int filename_isdir(const char * name); -extern "C" int filename_list(const char * d, void * l, void * f); -extern "C" int filename_match(const char * name, const char * pattern); -extern "C" const char * filename_name(const char * name); -extern "C" int filename_relative(char * to, int tolen, const char * from); -extern "C" char * filename_setext(char * to, int tolen, const char * ext); -extern "C" int filename_open_uri(const char * uri, char * msg, int msglen); - - -extern "C" int filename_alphasort(char * a, char * b); -extern "C" int filename_casealphasort(char * a, char * b); -extern "C" int filename_numericsort(char * a, char * b); -extern "C" int filename_casenumericsort(char * a, char * b); - - -#endif - - diff --git a/src/c_fl_fill_dial.cpp b/src/c_fl_fill_dial.cpp deleted file mode 100644 index 43f0167..0000000 --- a/src/c_fl_fill_dial.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Fill_Dial.H> -#include "c_fl_fill_dial.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Fill_Dial : public Fl_Fill_Dial { -public: - using Fl_Fill_Dial::Fl_Fill_Dial; - - friend void fl_fill_dial_draw(FILL_DIAL v); - friend int fl_fill_dial_handle(FILL_DIAL v, int e); - - void draw(); - int handle(int e); -}; - -void My_Fill_Dial::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Fill_Dial::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_fill_dial_draw(FILL_DIAL v) { - reinterpret_cast<My_Fill_Dial*>(v)->Fl_Fill_Dial::draw(); -} - -int fl_fill_dial_handle(FILL_DIAL v, int e) { - return reinterpret_cast<My_Fill_Dial*>(v)->Fl_Fill_Dial::handle(e); -} - - diff --git a/src/c_fl_fill_dial.h b/src/c_fl_fill_dial.h deleted file mode 100644 index 84ecab8..0000000 --- a/src/c_fl_fill_dial.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILL_DIAL_GUARD -#define FL_FILL_DIAL_GUARD - - -typedef void* FILL_DIAL; - - -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); - - -extern "C" void fl_fill_dial_draw(FILL_DIAL v); -extern "C" int fl_fill_dial_handle(FILL_DIAL v, int e); - - -#endif - - diff --git a/src/c_fl_fill_slider.cpp b/src/c_fl_fill_slider.cpp deleted file mode 100644 index d443684..0000000 --- a/src/c_fl_fill_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Fill_Slider.H> -#include "c_fl_fill_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Fill_Slider : public Fl_Fill_Slider { -public: - using Fl_Fill_Slider::Fl_Fill_Slider; - - friend void fl_fill_slider_draw(FILLSLIDER s); - friend int fl_fill_slider_handle(FILLSLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Fill_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Fill_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -FILLSLIDER 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(FILLSLIDER s) { - delete reinterpret_cast<My_Fill_Slider*>(s); -} - - - - -void fl_fill_slider_draw(FILLSLIDER s) { - reinterpret_cast<My_Fill_Slider*>(s)->Fl_Fill_Slider::draw(); -} - -int fl_fill_slider_handle(FILLSLIDER s, int e) { - return reinterpret_cast<My_Fill_Slider*>(s)->Fl_Fill_Slider::handle(e); -} - - diff --git a/src/c_fl_fill_slider.h b/src/c_fl_fill_slider.h deleted file mode 100644 index d208d93..0000000 --- a/src/c_fl_fill_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FILL_SLIDER_GUARD -#define FL_FILL_SLIDER_GUARD - - -typedef void* FILLSLIDER; - - -extern "C" FILLSLIDER new_fl_fill_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_fill_slider(FILLSLIDER s); - - -extern "C" void fl_fill_slider_draw(FILLSLIDER s); -extern "C" int fl_fill_slider_handle(FILLSLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_float_input.cpp b/src/c_fl_float_input.cpp deleted file mode 100644 index c5ce3e1..0000000 --- a/src/c_fl_float_input.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Float_Input.H> -#include "c_fl_float_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Float_Input : public Fl_Float_Input { -public: - using Fl_Float_Input::Fl_Float_Input; - - friend void fl_float_input_draw(FLOATINPUT i); - friend int fl_float_input_handle(FLOATINPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Float_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Float_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label) { - My_Float_Input *i = new My_Float_Input(x, y, w, h, label); - return i; -} - -void free_fl_float_input(FLOATINPUT i) { - delete reinterpret_cast<My_Float_Input*>(i); -} - - - - -void fl_float_input_draw(FLOATINPUT i) { - reinterpret_cast<My_Float_Input*>(i)->Fl_Float_Input::draw(); -} - -int fl_float_input_handle(FLOATINPUT i, int e) { - return reinterpret_cast<My_Float_Input*>(i)->Fl_Float_Input::handle(e); -} - - diff --git a/src/c_fl_float_input.h b/src/c_fl_float_input.h deleted file mode 100644 index 5ee1689..0000000 --- a/src/c_fl_float_input.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_FLOAT_INPUT_GUARD -#define FL_FLOAT_INPUT_GUARD - - -typedef void* FLOATINPUT; - - -extern "C" FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_float_input(FLOATINPUT i); - - -extern "C" void fl_float_input_draw(FLOATINPUT i); -extern "C" int fl_float_input_handle(FLOATINPUT i, int e); - - -#endif - - diff --git a/src/c_fl_gif_image.cpp b/src/c_fl_gif_image.cpp deleted file mode 100644 index 142bcc6..0000000 --- a/src/c_fl_gif_image.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 1aa3721..0000000 --- a/src/c_fl_gif_image.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 ac2d7a5..0000000 --- a/src/c_fl_gl_window.cpp +++ /dev/null @@ -1,191 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Gl_Window.H> -#include "c_fl_gl_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Gl_Window : public Fl_Gl_Window { -public: - using Fl_Gl_Window::Fl_Gl_Window; - - friend void fl_gl_window_draw(GLWINDOW n); - friend int fl_gl_window_handle(GLWINDOW n, int e); - - void draw(); - int handle(int e); -}; - -void My_Gl_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Gl_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_show2(GLWINDOW w, int c, void * v) { - reinterpret_cast<Fl_Gl_Window*>(w)->show(c, static_cast<char**>(v)); -} - -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(); -} - -void fl_gl_window_resize(GLWINDOW gw, int x, int y, int w, int h) { - reinterpret_cast<Fl_Gl_Window*>(gw)->resize(x, y, w, h); -} - - - - -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_invalidate(GLWINDOW w) { - reinterpret_cast<Fl_Gl_Window*>(w)->invalidate(); -} - -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(); -} - - - - -void fl_gl_window_draw(GLWINDOW n) { - reinterpret_cast<My_Gl_Window*>(n)->Fl_Gl_Window::draw(); -} - -int fl_gl_window_handle(GLWINDOW n, int e) { - return reinterpret_cast<My_Gl_Window*>(n)->Fl_Gl_Window::handle(e); -} - - diff --git a/src/c_fl_gl_window.h b/src/c_fl_gl_window.h deleted file mode 100644 index 6177db6..0000000 --- a/src/c_fl_gl_window.h +++ /dev/null @@ -1,61 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_GL_WINDOW_GUARD -#define FL_GL_WINDOW_GUARD - - -typedef void* GLWINDOW; - - -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_show2(GLWINDOW w, int c, void * v); -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" void fl_gl_window_resize(GLWINDOW gw, int x, int y, int w, int h); - - -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_invalidate(GLWINDOW w); -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); - - -extern "C" void fl_gl_window_draw(GLWINDOW n); -extern "C" int fl_gl_window_handle(GLWINDOW n, int e); - - -#endif - - diff --git a/src/c_fl_graphics_driver.cpp b/src/c_fl_graphics_driver.cpp deleted file mode 100644 index d524aac..0000000 --- a/src/c_fl_graphics_driver.cpp +++ /dev/null @@ -1,62 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 f68ad1f..0000000 --- a/src/c_fl_graphics_driver.h +++ /dev/null @@ -1,34 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 62bee03..0000000 --- a/src/c_fl_group.cpp +++ /dev/null @@ -1,193 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Group.H> -#include <FL/Fl_Widget.H> -#include "c_fl_group.h" -#include "c_fl_widget.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Group : Fl_Group { -public: - using Fl_Group::draw_child; - using Fl_Group::draw_children; - using Fl_Group::draw_outside_label; - using Fl_Group::update_child; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Group : public Fl_Group { -public: - using Fl_Group::Fl_Group; - - friend void fl_group_draw(GROUP g); - friend int fl_group_handle(GROUP g, int e); - - void draw(); - int handle(int e); -}; - -void My_Group::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Group::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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 static_cast<My_Group*>(g); -} - - - - -void fl_group_add(GROUP g, WIDGET item) { - static_cast<Fl_Group*>(g)->add(static_cast<Fl_Widget*>(item)); -} - -void fl_group_insert(GROUP g, WIDGET item, int place) { - static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), place); -} - -void fl_group_insert2(GROUP g, WIDGET item, WIDGET before) { - static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), static_cast<Fl_Widget*>(before)); -} - -void fl_group_remove(GROUP g, WIDGET item) { - static_cast<Fl_Group*>(g)->remove(static_cast<Fl_Widget*>(item)); -} - -void fl_group_remove2(GROUP g, int place) { - static_cast<Fl_Group*>(g)->remove(place); -} - - - - -void * fl_group_child(GROUP g, int place) { - return static_cast<Fl_Group*>(g)->child(place); -} - -int fl_group_find(GROUP g, WIDGET item) { - return static_cast<Fl_Group*>(g)->find(static_cast<Fl_Widget*>(item)); -} - -int fl_group_children(GROUP g) { - return static_cast<Fl_Group*>(g)->children(); -} - - - - -unsigned int fl_group_get_clip_children(GROUP g) { - return static_cast<Fl_Group*>(g)->clip_children(); -} - -void fl_group_set_clip_children(GROUP g, int c) { - static_cast<Fl_Group*>(g)->clip_children(c); -} - - - - -void fl_group_add_resizable(GROUP g, WIDGET w) { - Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); - static_cast<Fl_Group*>(g)->add_resizable(ref); -} - -void * fl_group_get_resizable(GROUP g) { - return static_cast<Fl_Group*>(g)->resizable(); -} - -void fl_group_set_resizable(GROUP g, WIDGET item) { - static_cast<Fl_Group*>(g)->resizable(static_cast<Fl_Widget*>(item)); -} - -void fl_group_init_sizes(GROUP g) { - static_cast<Fl_Group*>(g)->init_sizes(); -} - -void fl_group_resize(GROUP g, int x, int y, int w, int h) { - static_cast<Fl_Group*>(g)->resize(x, y, w, h); -} - - - - -void * fl_group_get_current() { - return Fl_Group::current(); -} - -void fl_group_set_current(GROUP g) { - Fl_Group::current(static_cast<Fl_Group*>(g)); -} - -void fl_group_begin(GROUP g) { - static_cast<Fl_Group*>(g)->begin(); -} - -void fl_group_end(GROUP g) { - static_cast<Fl_Group*>(g)->end(); -} - - - - -void fl_group_draw(GROUP g) { - static_cast<My_Group*>(g)->Fl_Group::draw(); -} - -void fl_group_draw_child(GROUP g, WIDGET w) { - Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); - (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_child))(ref); -} - -void fl_group_draw_children(GROUP g) { - (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_children))(); -} - -void fl_group_draw_outside_label(GROUP g, WIDGET w) { - Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); - (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_outside_label))(ref); -} - -void fl_group_update_child(GROUP g, WIDGET w) { - Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); - (static_cast<Fl_Group*>(g)->*(&Friend_Group::update_child))(ref); -} - -int fl_group_handle(GROUP g, int e) { - return static_cast<My_Group*>(g)->Fl_Group::handle(e); -} - - diff --git a/src/c_fl_group.h b/src/c_fl_group.h deleted file mode 100644 index af4559d..0000000 --- a/src/c_fl_group.h +++ /dev/null @@ -1,59 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_GROUP_GUARD -#define FL_GROUP_GUARD - -#include "c_fl_widget.h" - - -typedef void* GROUP; - - -extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); -extern "C" void free_fl_group(GROUP g); - - -extern "C" void fl_group_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_add_resizable(GROUP g, WIDGET w); -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_resize(GROUP g, int x, int y, int w, int h); - - -extern "C" void * fl_group_get_current(); -extern "C" void fl_group_set_current(GROUP g); -extern "C" void fl_group_begin(GROUP g); -extern "C" void fl_group_end(GROUP g); - - -extern "C" void fl_group_draw(GROUP g); -extern "C" void fl_group_draw_child(GROUP g, WIDGET w); -extern "C" void fl_group_draw_children(GROUP g); -extern "C" void fl_group_draw_outside_label(GROUP g, WIDGET w); -extern "C" void fl_group_update_child(GROUP g, WIDGET w); -extern "C" int fl_group_handle(GROUP g, int e); - - -#endif - - diff --git a/src/c_fl_help_dialog.cpp b/src/c_fl_help_dialog.cpp deleted file mode 100644 index 5eb719e..0000000 --- a/src/c_fl_help_dialog.cpp +++ /dev/null @@ -1,105 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Help_Dialog.H> -#include "c_fl_help_dialog.h" - - - - -HELPDIALOG new_fl_help_dialog() { - Fl_Help_Dialog *d = new Fl_Help_Dialog(); - return d; -} - -void free_fl_help_dialog(HELPDIALOG d) { - delete reinterpret_cast<Fl_Help_Dialog*>(d); -} - - - - -void fl_help_dialog_show(HELPDIALOG d) { - reinterpret_cast<Fl_Help_Dialog*>(d)->show(); -} - -void fl_help_dialog_show2(HELPDIALOG d, int c, void * v) { - reinterpret_cast<Fl_Help_Dialog*>(d)->show(c, static_cast<char**>(v)); -} - -void fl_help_dialog_hide(HELPDIALOG d) { - reinterpret_cast<Fl_Help_Dialog*>(d)->hide(); -} - -int fl_help_dialog_visible(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->visible(); -} - - - - -void fl_help_dialog_set_topline_number(HELPDIALOG d, int n) { - reinterpret_cast<Fl_Help_Dialog*>(d)->topline(n); -} - -void fl_help_dialog_set_topline_target(HELPDIALOG d, const char * t) { - reinterpret_cast<Fl_Help_Dialog*>(d)->topline(t); -} - - - - -void fl_help_dialog_load(HELPDIALOG d, const char * n) { - reinterpret_cast<Fl_Help_Dialog*>(d)->load(n); -} - -const char * fl_help_dialog_get_value(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->value(); -} - -void fl_help_dialog_set_value(HELPDIALOG d, const char * v) { - reinterpret_cast<Fl_Help_Dialog*>(d)->value(v); -} - - - - -int fl_help_dialog_get_textsize(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->textsize(); -} - -void fl_help_dialog_set_textsize(HELPDIALOG d, int s) { - reinterpret_cast<Fl_Help_Dialog*>(d)->textsize(s); -} - - - - -int fl_help_dialog_get_x(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->x(); -} - -int fl_help_dialog_get_y(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->y(); -} - -int fl_help_dialog_get_w(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->w(); -} - -int fl_help_dialog_get_h(HELPDIALOG d) { - return reinterpret_cast<Fl_Help_Dialog*>(d)->h(); -} - -void fl_help_dialog_resize(HELPDIALOG d, int xx, int yy, int ww, int hh) { - reinterpret_cast<Fl_Help_Dialog*>(d)->resize(xx, yy, ww, hh); -} - -void fl_help_dialog_position(HELPDIALOG d, int xx, int yy) { - reinterpret_cast<Fl_Help_Dialog*>(d)->position(xx, yy); -} - - diff --git a/src/c_fl_help_dialog.h b/src/c_fl_help_dialog.h deleted file mode 100644 index ddabce8..0000000 --- a/src/c_fl_help_dialog.h +++ /dev/null @@ -1,47 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HELP_DIALOG_GUARD -#define FL_HELP_DIALOG_GUARD - - -typedef void* HELPDIALOG; - - -extern "C" HELPDIALOG new_fl_help_dialog(); -extern "C" void free_fl_help_dialog(HELPDIALOG d); - - -extern "C" void fl_help_dialog_show(HELPDIALOG d); -extern "C" void fl_help_dialog_show2(HELPDIALOG d, int c, void * v); -extern "C" void fl_help_dialog_hide(HELPDIALOG d); -extern "C" int fl_help_dialog_visible(HELPDIALOG d); - - -extern "C" void fl_help_dialog_set_topline_number(HELPDIALOG d, int n); -extern "C" void fl_help_dialog_set_topline_target(HELPDIALOG d, const char * t); - - -extern "C" void fl_help_dialog_load(HELPDIALOG d, const char * n); -extern "C" const char * fl_help_dialog_get_value(HELPDIALOG d); -extern "C" void fl_help_dialog_set_value(HELPDIALOG d, const char * v); - - -extern "C" int fl_help_dialog_get_textsize(HELPDIALOG d); -extern "C" void fl_help_dialog_set_textsize(HELPDIALOG d, int s); - - -extern "C" int fl_help_dialog_get_x(HELPDIALOG d); -extern "C" int fl_help_dialog_get_y(HELPDIALOG d); -extern "C" int fl_help_dialog_get_w(HELPDIALOG d); -extern "C" int fl_help_dialog_get_h(HELPDIALOG d); -extern "C" void fl_help_dialog_resize(HELPDIALOG d, int xx, int yy, int ww, int hh); -extern "C" void fl_help_dialog_position(HELPDIALOG d, int xx, int yy); - - -#endif - - diff --git a/src/c_fl_help_view.cpp b/src/c_fl_help_view.cpp deleted file mode 100644 index 6275052..0000000 --- a/src/c_fl_help_view.cpp +++ /dev/null @@ -1,193 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Group.H> -#include <FL/Fl_Help_View.H> -#include <FL/Enumerations.H> -#include "c_fl_help_view.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Help_View : public Fl_Help_View { -public: - using Fl_Help_View::Fl_Help_View; - - friend void fl_help_view_draw(HELPVIEW v); - friend int fl_help_view_handle(HELPVIEW v, int e); - - void draw(); - int handle(int e); -}; - -void My_Help_View::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Help_View::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label) { - My_Help_View *v = new My_Help_View(x, y, w, h, label); - return v; -} - -void free_fl_help_view(HELPVIEW v) { - delete reinterpret_cast<My_Help_View*>(v); -} - - - - -void fl_help_view_clear_selection(HELPVIEW v) { - reinterpret_cast<Fl_Help_View*>(v)->clear_selection(); -} - -void fl_help_view_select_all(HELPVIEW v) { - reinterpret_cast<Fl_Help_View*>(v)->select_all(); -} - - - - -int fl_help_view_find(HELPVIEW v, const char * s, int p) { - return reinterpret_cast<Fl_Help_View*>(v)->find(s, p); -} - -int fl_help_view_get_leftline(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->leftline(); -} - -void fl_help_view_set_leftline(HELPVIEW v, int t) { - reinterpret_cast<Fl_Help_View*>(v)->leftline(t); -} - -int fl_help_view_get_topline(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->topline(); -} - -void fl_help_view_set_topline(HELPVIEW v, int t) { - reinterpret_cast<Fl_Help_View*>(v)->topline(t); -} - -void fl_help_view_set_topline_target(HELPVIEW v, const char * t) { - reinterpret_cast<Fl_Help_View*>(v)->topline(t); -} - - - - -const char * fl_help_view_directory(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->directory(); -} - -const char * fl_help_view_filename(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->filename(); -} - -int fl_help_view_load(HELPVIEW v, const char * f) { - return reinterpret_cast<Fl_Help_View*>(v)->load(f); -} - -const char * fl_help_view_title(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->title(); -} - -const char * fl_help_view_get_value(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->value(); -} - -void fl_help_view_set_value(HELPVIEW v, const char * t) { - reinterpret_cast<Fl_Help_View*>(v)->value(t); -} - -void fl_help_view_link(HELPVIEW v, void * f) { - reinterpret_cast<Fl_Help_View*>(v)->link(reinterpret_cast<Fl_Help_Func*>(f)); -} - - - - -int fl_help_view_get_scrollbar_size(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->scrollbar_size(); -} - -void fl_help_view_set_scrollbar_size(HELPVIEW v, int s) { - reinterpret_cast<Fl_Help_View*>(v)->scrollbar_size(s); -} - -int fl_help_view_get_size(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->size(); -} - -void fl_help_view_set_size(HELPVIEW v, int w, int h) { - reinterpret_cast<Fl_Help_View*>(v)->size(w, h); -} - -void fl_help_view_resize(HELPVIEW v, int x, int y, int w, int h) { - reinterpret_cast<Fl_Help_View*>(v)->resize(x, y, w, h); -} - -unsigned int fl_help_view_get_textcolor(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->textcolor(); -} - -void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c) { - reinterpret_cast<Fl_Help_View*>(v)->textcolor(c); -} - -int fl_help_view_get_textfont(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->textfont(); -} - -void fl_help_view_set_textfont(HELPVIEW v, int f) { - reinterpret_cast<Fl_Help_View*>(v)->textfont(f); -} - -int fl_help_view_get_textsize(HELPVIEW v) { - return reinterpret_cast<Fl_Help_View*>(v)->textsize(); -} - -void fl_help_view_set_textsize(HELPVIEW v, int s) { - reinterpret_cast<Fl_Help_View*>(v)->textsize(s); -} - - - - -void fl_help_view_draw(HELPVIEW v) { -#if FL_ABI_VERSION >= 10303 - reinterpret_cast<My_Help_View*>(v)->Fl_Help_View::draw(); -#else - reinterpret_cast<My_Help_View*>(v)->Fl_Group::draw(); -#endif -} - -int fl_help_view_handle(HELPVIEW v, int e) { -#if FL_ABI_VERSION >= 10303 - return reinterpret_cast<My_Help_View*>(v)->Fl_Help_View::handle(e); -#else - return reinterpret_cast<My_Help_View*>(v)->Fl_Group::handle(e); -#endif -} - - diff --git a/src/c_fl_help_view.h b/src/c_fl_help_view.h deleted file mode 100644 index b16b344..0000000 --- a/src/c_fl_help_view.h +++ /dev/null @@ -1,58 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HELP_VIEW_GUARD -#define FL_HELP_VIEW_GUARD - - -typedef void* HELPVIEW; - - -extern "C" HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label); -extern "C" void free_fl_help_view(HELPVIEW v); - - -extern "C" void fl_help_view_clear_selection(HELPVIEW v); -extern "C" void fl_help_view_select_all(HELPVIEW v); - - -extern "C" int fl_help_view_find(HELPVIEW v, const char * s, int p); -extern "C" int fl_help_view_get_leftline(HELPVIEW v); -extern "C" void fl_help_view_set_leftline(HELPVIEW v, int t); -extern "C" int fl_help_view_get_topline(HELPVIEW v); -extern "C" void fl_help_view_set_topline(HELPVIEW v, int t); -extern "C" void fl_help_view_set_topline_target(HELPVIEW v, const char * t); - - -extern "C" const char * fl_help_view_directory(HELPVIEW v); -extern "C" const char * fl_help_view_filename(HELPVIEW v); -extern "C" int fl_help_view_load(HELPVIEW v, const char * f); -extern "C" const char * fl_help_view_title(HELPVIEW v); -extern "C" const char * fl_help_view_get_value(HELPVIEW v); -extern "C" void fl_help_view_set_value(HELPVIEW v, const char * t); -extern "C" void fl_help_view_link(HELPVIEW v, void * f); - - -extern "C" int fl_help_view_get_scrollbar_size(HELPVIEW v); -extern "C" void fl_help_view_set_scrollbar_size(HELPVIEW v, int s); -extern "C" int fl_help_view_get_size(HELPVIEW v); -extern "C" void fl_help_view_set_size(HELPVIEW v, int w, int h); -extern "C" void fl_help_view_resize(HELPVIEW v, int x, int y, int w, int h); -extern "C" unsigned int fl_help_view_get_textcolor(HELPVIEW v); -extern "C" void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c); -extern "C" int fl_help_view_get_textfont(HELPVIEW v); -extern "C" void fl_help_view_set_textfont(HELPVIEW v, int f); -extern "C" int fl_help_view_get_textsize(HELPVIEW v); -extern "C" void fl_help_view_set_textsize(HELPVIEW v, int s); - - -extern "C" void fl_help_view_draw(HELPVIEW v); -extern "C" int fl_help_view_handle(HELPVIEW v, int e); - - -#endif - - diff --git a/src/c_fl_hold_browser.cpp b/src/c_fl_hold_browser.cpp deleted file mode 100644 index e9ccae0..0000000 --- a/src/c_fl_hold_browser.cpp +++ /dev/null @@ -1,265 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Hold_Browser.H> -#include "c_fl_hold_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -extern "C" int browser_item_width_hook(void * b, void * i); -extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Hold_Browser : public Fl_Hold_Browser { -public: - using Fl_Hold_Browser::Fl_Hold_Browser; - - friend int fl_hold_browser_item_width(HOLDBROWSER b, void * item); - friend int fl_hold_browser_item_height(HOLDBROWSER b, void * item); - friend void * fl_hold_browser_item_first(HOLDBROWSER b); - friend void * fl_hold_browser_item_last(HOLDBROWSER b); - friend void * fl_hold_browser_item_next(HOLDBROWSER b, void * item); - friend void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item); - friend void * fl_hold_browser_item_at(HOLDBROWSER b, int index); - friend void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val); - friend int fl_hold_browser_item_selected(HOLDBROWSER b, void * item); - friend void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y); - friend const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item); - friend void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h); - - friend int fl_hold_browser_full_width(HOLDBROWSER c); - friend int fl_hold_browser_full_height(HOLDBROWSER c); - friend int fl_hold_browser_incr_height(HOLDBROWSER c); - friend int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i); - - friend void fl_hold_browser_draw(HOLDBROWSER b); - - int handle(int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - int item_width(void * item) const; - int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); -}; - - -int My_Hold_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Hold_Browser::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Hold_Browser::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Hold_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -int My_Hold_Browser::item_width(void * item) const { - return browser_item_width_hook(this->user_data(), item); -} - -int My_Hold_Browser::item_height(void * item) const { - return browser_item_height_hook(this->user_data(), item); -} - -void * My_Hold_Browser::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_Hold_Browser::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_Hold_Browser::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_Hold_Browser::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_Hold_Browser::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_Hold_Browser::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_Hold_Browser::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_Hold_Browser::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_Hold_Browser::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -void My_Hold_Browser::item_draw(void * item, int x, int y, int w, int h) const { - browser_item_draw_hook(this->user_data(), item, x, y, w, h); -} - - -void My_Hold_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Hold_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -HOLDBROWSER new_fl_hold_browser(int x, int y, int w, int h, char * label) { - My_Hold_Browser *b = new My_Hold_Browser(x, y, w, h, label); - return b; -} - -void free_fl_hold_browser(HOLDBROWSER b) { - delete reinterpret_cast<My_Hold_Browser*>(b); -} - - - - -// These have to be reimplemented due to relying on custom class extensions - - -int fl_hold_browser_full_height(HOLDBROWSER c) { - return reinterpret_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::full_height(); -} - -int fl_hold_browser_incr_height(HOLDBROWSER c) { - return reinterpret_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::incr_height(); -} - - - - -int fl_hold_browser_item_width(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_width(item); -} - -int fl_hold_browser_item_height(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_height(item); -} - -void * fl_hold_browser_item_first(HOLDBROWSER b) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_first(); -} - -void * fl_hold_browser_item_last(HOLDBROWSER b) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_last(); -} - -void * fl_hold_browser_item_next(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_next(item); -} - -void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_prev(item); -} - -void * fl_hold_browser_item_at(HOLDBROWSER b, int index) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_at(index); -} - -void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val) { - reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_select(item, val); -} - -int fl_hold_browser_item_selected(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_selected(item); -} - -void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y) { - reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_swap(x, y); -} - -const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_text(item); -} - -void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h) { - reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_draw(item, x, y, w, h); -} - - - - -int fl_hold_browser_full_width(HOLDBROWSER c) { - return reinterpret_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::full_width(); -} - -int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i) { - return reinterpret_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::item_quick_height(i); -} - - - - -void fl_hold_browser_draw(HOLDBROWSER b) { - reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::draw(); -} - -int fl_hold_browser_handle(HOLDBROWSER b, int e) { - return reinterpret_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::handle(e); -} - - diff --git a/src/c_fl_hold_browser.h b/src/c_fl_hold_browser.h deleted file mode 100644 index 6f295c6..0000000 --- a/src/c_fl_hold_browser.h +++ /dev/null @@ -1,48 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HOLD_BROWSER_GUARD -#define FL_HOLD_BROWSER_GUARD - - -typedef void* HOLDBROWSER; - - -extern "C" HOLDBROWSER new_fl_hold_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_hold_browser(HOLDBROWSER b); - - -// reimp below here - -extern "C" int fl_hold_browser_full_height(HOLDBROWSER c); -extern "C" int fl_hold_browser_incr_height(HOLDBROWSER c); - - -extern "C" int fl_hold_browser_item_width(HOLDBROWSER b, void * item); -extern "C" int fl_hold_browser_item_height(HOLDBROWSER b, void * item); -extern "C" void * fl_hold_browser_item_first(HOLDBROWSER b); -extern "C" void * fl_hold_browser_item_last(HOLDBROWSER b); -extern "C" void * fl_hold_browser_item_next(HOLDBROWSER b, void * item); -extern "C" void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item); -extern "C" void * fl_hold_browser_item_at(HOLDBROWSER b, int index); -extern "C" void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val=1); -extern "C" int fl_hold_browser_item_selected(HOLDBROWSER b, void * item); -extern "C" void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y); -extern "C" const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item); -extern "C" void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h); - - -extern "C" int fl_hold_browser_full_width(HOLDBROWSER c); -extern "C" int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i); - - -extern "C" void fl_hold_browser_draw(HOLDBROWSER b); -extern "C" int fl_hold_browser_handle(HOLDBROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_hor_fill_slider.cpp b/src/c_fl_hor_fill_slider.cpp deleted file mode 100644 index d146698..0000000 --- a/src/c_fl_hor_fill_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Hor_Fill_Slider.H> -#include "c_fl_hor_fill_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Hor_Fill_Slider : public Fl_Hor_Fill_Slider { -public: - using Fl_Hor_Fill_Slider::Fl_Hor_Fill_Slider; - - friend void fl_hor_fill_slider_draw(HORFILLSLIDER s); - friend int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Hor_Fill_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Hor_Fill_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -HORFILLSLIDER 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(HORFILLSLIDER s) { - delete reinterpret_cast<My_Hor_Fill_Slider*>(s); -} - - - - -void fl_hor_fill_slider_draw(HORFILLSLIDER s) { - reinterpret_cast<My_Hor_Fill_Slider*>(s)->Fl_Hor_Fill_Slider::draw(); -} - -int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e) { - return reinterpret_cast<My_Hor_Fill_Slider*>(s)->Fl_Hor_Fill_Slider::handle(e); -} - - diff --git a/src/c_fl_hor_fill_slider.h b/src/c_fl_hor_fill_slider.h deleted file mode 100644 index d698a93..0000000 --- a/src/c_fl_hor_fill_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HOR_FILL_SLIDER_GUARD -#define FL_HOR_FILL_SLIDER_GUARD - - -typedef void* HORFILLSLIDER; - - -extern "C" HORFILLSLIDER new_fl_hor_fill_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_fill_slider(HORFILLSLIDER s); - - -extern "C" void fl_hor_fill_slider_draw(HORFILLSLIDER s); -extern "C" int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_hor_nice_slider.cpp b/src/c_fl_hor_nice_slider.cpp deleted file mode 100644 index e3f828f..0000000 --- a/src/c_fl_hor_nice_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Hor_Nice_Slider.H> -#include "c_fl_hor_nice_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Hor_Nice_Slider : public Fl_Hor_Nice_Slider { -public: - using Fl_Hor_Nice_Slider::Fl_Hor_Nice_Slider; - - friend void fl_hor_nice_slider_draw(HORNICESLIDER s); - friend int fl_hor_nice_slider_handle(HORNICESLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Hor_Nice_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Hor_Nice_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -HORNICESLIDER 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(HORNICESLIDER s) { - delete reinterpret_cast<My_Hor_Nice_Slider*>(s); -} - - - - -void fl_hor_nice_slider_draw(HORNICESLIDER s) { - reinterpret_cast<My_Hor_Nice_Slider*>(s)->Fl_Hor_Nice_Slider::draw(); -} - -int fl_hor_nice_slider_handle(HORNICESLIDER s, int e) { - return reinterpret_cast<My_Hor_Nice_Slider*>(s)->Fl_Hor_Nice_Slider::handle(e); -} - - diff --git a/src/c_fl_hor_nice_slider.h b/src/c_fl_hor_nice_slider.h deleted file mode 100644 index a4e3bc1..0000000 --- a/src/c_fl_hor_nice_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HOR_NICE_SLIDER_GUARD -#define FL_HOR_NICE_SLIDER_GUARD - - -typedef void* HORNICESLIDER; - - -extern "C" HORNICESLIDER new_fl_hor_nice_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_nice_slider(HORNICESLIDER s); - - -extern "C" void fl_hor_nice_slider_draw(HORNICESLIDER s); -extern "C" int fl_hor_nice_slider_handle(HORNICESLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_hor_value_slider.cpp b/src/c_fl_hor_value_slider.cpp deleted file mode 100644 index 0630b12..0000000 --- a/src/c_fl_hor_value_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Hor_Value_Slider.H> -#include "c_fl_hor_value_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Hor_Value_Slider : public Fl_Hor_Value_Slider { -public: - using Fl_Hor_Value_Slider::Fl_Hor_Value_Slider; - - friend void fl_hor_value_slider_draw(HORVALUESLIDER s); - friend int fl_hor_value_slider_handle(HORVALUESLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Hor_Value_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Hor_Value_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -HORVALUESLIDER 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(HORVALUESLIDER s) { - delete reinterpret_cast<My_Hor_Value_Slider*>(s); -} - - - - -void fl_hor_value_slider_draw(HORVALUESLIDER s) { - reinterpret_cast<My_Hor_Value_Slider*>(s)->Fl_Hor_Value_Slider::draw(); -} - -int fl_hor_value_slider_handle(HORVALUESLIDER s, int e) { - return reinterpret_cast<My_Hor_Value_Slider*>(s)->Fl_Hor_Value_Slider::handle(e); -} - - diff --git a/src/c_fl_hor_value_slider.h b/src/c_fl_hor_value_slider.h deleted file mode 100644 index 6257313..0000000 --- a/src/c_fl_hor_value_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HOR_VALUE_SLIDER_GUARD -#define FL_HOR_VALUE_SLIDER_GUARD - - -typedef void* HORVALUESLIDER; - - -extern "C" HORVALUESLIDER new_fl_hor_value_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_hor_value_slider(HORVALUESLIDER s); - - -extern "C" void fl_hor_value_slider_draw(HORVALUESLIDER s); -extern "C" int fl_hor_value_slider_handle(HORVALUESLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_horizontal_slider.cpp b/src/c_fl_horizontal_slider.cpp deleted file mode 100644 index 2856a21..0000000 --- a/src/c_fl_horizontal_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Hor_Slider.H> -#include "c_fl_horizontal_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Horizontal_Slider : public Fl_Hor_Slider { -public: - using Fl_Hor_Slider::Fl_Hor_Slider; - - friend void fl_horizontal_slider_draw(HORIZONTALSLIDER s); - friend int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Horizontal_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Horizontal_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -HORIZONTALSLIDER 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(HORIZONTALSLIDER s) { - delete reinterpret_cast<My_Horizontal_Slider*>(s); -} - - - - -void fl_horizontal_slider_draw(HORIZONTALSLIDER s) { - reinterpret_cast<My_Horizontal_Slider*>(s)->Fl_Hor_Slider::draw(); -} - -int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e) { - return reinterpret_cast<My_Horizontal_Slider*>(s)->Fl_Hor_Slider::handle(e); -} - - diff --git a/src/c_fl_horizontal_slider.h b/src/c_fl_horizontal_slider.h deleted file mode 100644 index 96dd11a..0000000 --- a/src/c_fl_horizontal_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_HORIZONTAL_SLIDER_GUARD -#define FL_HORIZONTAL_SLIDER_GUARD - - -typedef void* HORIZONTALSLIDER; - - -extern "C" HORIZONTALSLIDER new_fl_horizontal_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_horizontal_slider(HORIZONTALSLIDER s); - - -extern "C" void fl_horizontal_slider_draw(HORIZONTALSLIDER s); -extern "C" int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_image.cpp b/src/c_fl_image.cpp deleted file mode 100644 index 2aacc02..0000000 --- a/src/c_fl_image.cpp +++ /dev/null @@ -1,142 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 75afb4a..0000000 --- a/src/c_fl_image.h +++ /dev/null @@ -1,57 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 b03659f..0000000 --- a/src/c_fl_image_surface.cpp +++ /dev/null @@ -1,55 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Image_Surface.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_image_surface.h" - - - - -// Flattened C API - -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 d0f671b..0000000 --- a/src/c_fl_image_surface.h +++ /dev/null @@ -1,31 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 c66b46d..0000000 --- a/src/c_fl_input.cpp +++ /dev/null @@ -1,82 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Input.H> -#include "c_fl_input.h" - - - - -// Telprot stopovers - -extern "C" void text_input_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); -void fl_text_input_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { - text_input_extra_init_hook(adaobj, x, y, w, h, label); -} - -extern "C" void text_input_extra_final_hook(void * aobj); -void fl_text_input_extra_final(void * adaobj) { - text_input_extra_final_hook(adaobj); -} - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Text_Input : public Fl_Input { -public: - using Fl_Input::Fl_Input; - - friend void fl_text_input_draw(TEXTINPUT t); - friend int fl_text_input_handle(TEXTINPUT t, int e); - - void draw(); - int handle(int e); -}; - -void My_Text_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Text_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label) { - My_Text_Input * t = new My_Text_Input(x, y, w, h, label); - return t; -} - -void free_fl_text_input(TEXTINPUT t) { - delete reinterpret_cast<My_Text_Input*>(t); -} - - - - -void fl_text_input_draw(TEXTINPUT t) { - reinterpret_cast<My_Text_Input*>(t)->Fl_Input::draw(); -} - -int fl_text_input_handle(TEXTINPUT t, int e) { - return reinterpret_cast<My_Text_Input*>(t)->Fl_Input::handle(e); -} - - diff --git a/src/c_fl_input.h b/src/c_fl_input.h deleted file mode 100644 index 06a8a0c..0000000 --- a/src/c_fl_input.h +++ /dev/null @@ -1,29 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TEXT_INPUT_GUARD -#define FL_TEXT_INPUT_GUARD - - -extern "C" void fl_text_input_extra_init - (void * adaobj, int x, int y, int w, int h, const char * label); -extern "C" void fl_text_input_extra_final(void * adaobj); - - -typedef void* TEXTINPUT; - - -extern "C" TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label); -extern "C" void free_fl_text_input(TEXTINPUT t); - - -extern "C" void fl_text_input_draw(TEXTINPUT t); -extern "C" int fl_text_input_handle(TEXTINPUT t, int e); - - -#endif - - diff --git a/src/c_fl_input_.cpp b/src/c_fl_input_.cpp deleted file mode 100644 index 0971d1d..0000000 --- a/src/c_fl_input_.cpp +++ /dev/null @@ -1,249 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Input_.H> -#include "c_fl_input_.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Input : public Fl_Input_ { -public: - using Fl_Input_::Fl_Input_; - - friend void fl_input_draw(INPUT i); - friend int fl_input_handle(INPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -INPUT new_fl_input(int x, int y, int w, int h, char* label) { - My_Input *i = new My_Input(x, y, w, h, label); - return i; -} - -void free_fl_input(INPUT i) { - delete reinterpret_cast<My_Input*>(i); -} - - - - -int fl_input_copy(INPUT i, int c) { - return reinterpret_cast<Fl_Input_*>(i)->copy(c); -} - -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); -} - -int fl_input_set_position2(INPUT i, int p, int m) { - return reinterpret_cast<Fl_Input_*>(i)->position(p, m); -} - - - - -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(); -} - -int fl_input_set_value(INPUT i, char * s, int len) { - return 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); -} - -void fl_input_resize(INPUT i, int x, int y, int w, int h) { - reinterpret_cast<Fl_Input_*>(i)->Fl_Input_::resize(x, y, w, h); -} - - - - -void fl_input_draw(INPUT i) { - // This inherits directly from Fl_Widget::draw, and - // the Fl_Widget draw method doesn't technically exist, so... - (void)(i); - // It is more convenient for this function to exist, however, - // even though it will likely never be called, because it simplifies - // and makes uniform the implementation of the Ada Input Draw subprogram. -} - -int fl_input_handle(INPUT i, int e) { - return reinterpret_cast<My_Input*>(i)->Fl_Input_::handle(e); -} - - diff --git a/src/c_fl_input_.h b/src/c_fl_input_.h deleted file mode 100644 index eec03c2..0000000 --- a/src/c_fl_input_.h +++ /dev/null @@ -1,77 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_INPUT_GUARD -#define FL_INPUT_GUARD - - -typedef void* INPUT; - - -extern "C" INPUT new_fl_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_input(INPUT i); - - -extern "C" int fl_input_copy(INPUT i, int c); -extern "C" int fl_input_cut(INPUT i); -extern "C" int fl_input_cut2(INPUT i, int b); -extern "C" int fl_input_cut3(INPUT i, int a, int b); -extern "C" int fl_input_copy_cuts(INPUT i); -extern "C" int fl_input_undo(INPUT i); - - -extern "C" int fl_input_get_readonly(INPUT i); -extern "C" void fl_input_set_readonly(INPUT i, int t); -extern "C" int fl_input_get_tab_nav(INPUT i); -extern "C" void fl_input_set_tab_nav(INPUT i, int t); -extern "C" int fl_input_get_wrap(INPUT i); -extern "C" void fl_input_set_wrap(INPUT i, int t); - - -extern "C" int fl_input_get_input_type(INPUT i); -extern "C" void fl_input_set_input_type(INPUT i, int t); -extern "C" unsigned long fl_input_get_shortcut(INPUT i); -extern "C" void fl_input_set_shortcut(INPUT i, unsigned long t); -extern "C" int fl_input_get_mark(INPUT i); -extern "C" int fl_input_set_mark(INPUT i, int t); -extern "C" int fl_input_get_position(INPUT i); -extern "C" int fl_input_set_position(INPUT i, int t); -extern "C" int fl_input_set_position2(INPUT i, int p, int m); - - -extern "C" unsigned int fl_input_index(INPUT i, int p); -extern "C" int fl_input_insert(INPUT i, const char * s, int l); -extern "C" int fl_input_replace(INPUT i, int b, int e, const char * s, int l); -extern "C" const char * fl_input_get_value(INPUT i); -extern "C" int fl_input_set_value(INPUT i, char * s, int len); - - -extern "C" int fl_input_get_maximum_size(INPUT i); -extern "C" void fl_input_set_maximum_size(INPUT i, int t); -extern "C" int fl_input_get_size(INPUT i); - - -extern "C" unsigned int fl_input_get_cursor_color(INPUT i); -extern "C" void fl_input_set_cursor_color(INPUT i, unsigned int t); -extern "C" unsigned int fl_input_get_textcolor(INPUT i); -extern "C" void fl_input_set_textcolor(INPUT i, unsigned int t); -extern "C" int fl_input_get_textfont(INPUT i); -extern "C" void fl_input_set_textfont(INPUT i, int t); -extern "C" int fl_input_get_textsize(INPUT i); -extern "C" void fl_input_set_textsize(INPUT i, int t); - - -extern "C" void fl_input_set_size(INPUT i, int w, int h); -extern "C" void fl_input_resize(INPUT i, int x, int y, int w, int h); - - -extern "C" void fl_input_draw(INPUT n); -extern "C" int fl_input_handle(INPUT i, int e); - - -#endif - - diff --git a/src/c_fl_input_choice.cpp b/src/c_fl_input_choice.cpp deleted file mode 100644 index 682aed0..0000000 --- a/src/c_fl_input_choice.cpp +++ /dev/null @@ -1,151 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Input_Choice.H> -#include "c_fl_input_choice.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Input_Choice : public Fl_Input_Choice { -public: - using Fl_Input_Choice::Fl_Input_Choice; - - friend void fl_input_choice_draw(INPUTCHOICE n); - friend int fl_input_choice_handle(INPUTCHOICE n, int e); - - void draw(); - int handle(int e); -}; - -void My_Input_Choice::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Input_Choice::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -INPUTCHOICE 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(INPUTCHOICE n) { - delete reinterpret_cast<My_Input_Choice*>(n); -} - - - - -void * fl_input_choice_input(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->input(); -} - -void * fl_input_choice_menubutton(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->menubutton(); -} - - - - -void fl_input_choice_clear(INPUTCHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->clear(); -} - - - - -int fl_input_choice_changed(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->changed(); -} - -void fl_input_choice_clear_changed(INPUTCHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->clear_changed(); -} - -void fl_input_choice_set_changed(INPUTCHOICE n) { - reinterpret_cast<Fl_Input_Choice*>(n)->set_changed(); -} - -int fl_input_choice_get_down_box(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->down_box(); -} - -void fl_input_choice_set_down_box(INPUTCHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->down_box(static_cast<Fl_Boxtype>(t)); -} - -unsigned int fl_input_choice_get_textcolor(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textcolor(); -} - -void fl_input_choice_set_textcolor(INPUTCHOICE n, unsigned int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textcolor(t); -} - -int fl_input_choice_get_textfont(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textfont(); -} - -void fl_input_choice_set_textfont(INPUTCHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textfont(t); -} - -int fl_input_choice_get_textsize(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->textsize(); -} - -void fl_input_choice_set_textsize(INPUTCHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->textsize(t); -} - -const char * fl_input_choice_get_value(INPUTCHOICE n) { - return reinterpret_cast<Fl_Input_Choice*>(n)->value(); -} - -void fl_input_choice_set_value(INPUTCHOICE n, const char * t) { - reinterpret_cast<Fl_Input_Choice*>(n)->value(t); -} - -void fl_input_choice_set_value2(INPUTCHOICE n, int t) { - reinterpret_cast<Fl_Input_Choice*>(n)->value(t); -} - - - - -void fl_input_choice_resize(INPUTCHOICE n, int x, int y, int w, int h) { - reinterpret_cast<Fl_Input_Choice*>(n)->resize(x, y, w, h); -} - - - - -void fl_input_choice_draw(INPUTCHOICE n) { - reinterpret_cast<My_Input_Choice*>(n)->Fl_Input_Choice::draw(); -} - -int fl_input_choice_handle(INPUTCHOICE n, int e) { - return reinterpret_cast<My_Input_Choice*>(n)->Fl_Input_Choice::handle(e); -} - - diff --git a/src/c_fl_input_choice.h b/src/c_fl_input_choice.h deleted file mode 100644 index a7ee0c3..0000000 --- a/src/c_fl_input_choice.h +++ /dev/null @@ -1,50 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_INPUT_CHOICE_GUARD -#define FL_INPUT_CHOICE_GUARD - - -typedef void* INPUTCHOICE; - - -extern "C" INPUTCHOICE new_fl_input_choice(int x, int y, int w, int h, char* label); -extern "C" void free_fl_input_choice(INPUTCHOICE n); - - -extern "C" void * fl_input_choice_input(INPUTCHOICE n); -extern "C" void * fl_input_choice_menubutton(INPUTCHOICE n); - - -extern "C" void fl_input_choice_clear(INPUTCHOICE n); - - -extern "C" int fl_input_choice_changed(INPUTCHOICE n); -extern "C" void fl_input_choice_clear_changed(INPUTCHOICE n); -extern "C" void fl_input_choice_set_changed(INPUTCHOICE n); -extern "C" int fl_input_choice_get_down_box(INPUTCHOICE n); -extern "C" void fl_input_choice_set_down_box(INPUTCHOICE n, int t); -extern "C" unsigned int fl_input_choice_get_textcolor(INPUTCHOICE n); -extern "C" void fl_input_choice_set_textcolor(INPUTCHOICE n, unsigned int t); -extern "C" int fl_input_choice_get_textfont(INPUTCHOICE n); -extern "C" void fl_input_choice_set_textfont(INPUTCHOICE n, int t); -extern "C" int fl_input_choice_get_textsize(INPUTCHOICE n); -extern "C" void fl_input_choice_set_textsize(INPUTCHOICE n, int t); -extern "C" const char * fl_input_choice_get_value(INPUTCHOICE n); -extern "C" void fl_input_choice_set_value(INPUTCHOICE n, const char * t); -extern "C" void fl_input_choice_set_value2(INPUTCHOICE n, int t); - - -extern "C" void fl_input_choice_resize(INPUTCHOICE n, int x, int y, int w, int h); - - -extern "C" void fl_input_choice_draw(INPUTCHOICE n); -extern "C" int fl_input_choice_handle(INPUTCHOICE n, int e); - - -#endif - - diff --git a/src/c_fl_int_input.cpp b/src/c_fl_int_input.cpp deleted file mode 100644 index 0f90cf2..0000000 --- a/src/c_fl_int_input.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Int_Input.H> -#include "c_fl_int_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Int_Input : public Fl_Int_Input { -public: - using Fl_Int_Input::Fl_Int_Input; - - friend void fl_int_input_draw(INTINPUT i); - friend int fl_int_input_handle(INTINPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Int_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Int_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label) { - My_Int_Input *i = new My_Int_Input(x, y, w, h, label); - return i; -} - -void free_fl_int_input(INTINPUT i) { - delete reinterpret_cast<My_Int_Input*>(i); -} - - - - -void fl_int_input_draw(INTINPUT i) { - reinterpret_cast<My_Int_Input*>(i)->Fl_Int_Input::draw(); -} - -int fl_int_input_handle(INTINPUT i, int e) { - return reinterpret_cast<My_Int_Input*>(i)->Fl_Int_Input::handle(e); -} - - diff --git a/src/c_fl_int_input.h b/src/c_fl_int_input.h deleted file mode 100644 index e36cfaa..0000000 --- a/src/c_fl_int_input.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_INT_INPUT_GUARD -#define FL_INT_INPUT_GUARD - - -typedef void* INTINPUT; - - -extern "C" INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_int_input(INTINPUT i); - - -extern "C" void fl_int_input_draw(INTINPUT i); -extern "C" int fl_int_input_handle(INTINPUT i, int e); - - -#endif - - diff --git a/src/c_fl_jpeg_image.cpp b/src/c_fl_jpeg_image.cpp deleted file mode 100644 index 6523e39..0000000 --- a/src/c_fl_jpeg_image.cpp +++ /dev/null @@ -1,26 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 4fef486..0000000 --- a/src/c_fl_jpeg_image.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_label.cpp b/src/c_fl_label.cpp deleted file mode 100644 index 1fb5579..0000000 --- a/src/c_fl_label.cpp +++ /dev/null @@ -1,95 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Widget.H> -#include <FL/Fl_Image.H> -#include "c_fl_label.h" - - - - -LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p) { - Fl_Label *l = new Fl_Label; - l->value = v; - l->font = f; - l->size = s; - l->color = h; - l->align_ = p; - l->type = (uchar)k; - return l; -} - -void free_fl_label(LABEL l) { - delete reinterpret_cast<Fl_Label*>(l); -} - - - - -void fl_label_set_value(LABEL l, const char * v) { - reinterpret_cast<Fl_Label*>(l)->value = v; -} - -int fl_label_get_font(LABEL l) { - return reinterpret_cast<Fl_Label*>(l)->font; -} - -void fl_label_set_font(LABEL l, int f) { - reinterpret_cast<Fl_Label*>(l)->font = f; -} - -int fl_label_get_size(LABEL l) { - return reinterpret_cast<Fl_Label*>(l)->size; -} - -void fl_label_set_size(LABEL l, int s) { - reinterpret_cast<Fl_Label*>(l)->size = s; -} - -unsigned int fl_label_get_color(LABEL l) { - return reinterpret_cast<Fl_Label*>(l)->color; -} - -void fl_label_set_color(LABEL l, unsigned int h) { - reinterpret_cast<Fl_Label*>(l)->color = h; -} - -int fl_label_get_type(LABEL l) { - return (int)reinterpret_cast<Fl_Label*>(l)->type; -} - -void fl_label_set_type(LABEL l, int k) { - reinterpret_cast<Fl_Label*>(l)->type = (uchar)k; -} - -unsigned int fl_label_get_align(LABEL l) { - return reinterpret_cast<Fl_Label*>(l)->align_; -} - -void fl_label_set_align(LABEL l, unsigned int p) { - reinterpret_cast<Fl_Label*>(l)->align_ = p; -} - -void fl_label_set_image(LABEL l, void * i) { - reinterpret_cast<Fl_Label*>(l)->image = reinterpret_cast<Fl_Image*>(i); -} - -void fl_label_set_deimage(LABEL l, void * i) { - reinterpret_cast<Fl_Label*>(l)->deimage = reinterpret_cast<Fl_Image*>(i); -} - - - - -void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p) { - reinterpret_cast<Fl_Label*>(l)->draw(x, y, w, h, p); -} - -void fl_label_measure(LABEL l, int &w, int &h) { - reinterpret_cast<Fl_Label*>(l)->measure(w, h); -} - - diff --git a/src/c_fl_label.h b/src/c_fl_label.h deleted file mode 100644 index 806aa72..0000000 --- a/src/c_fl_label.h +++ /dev/null @@ -1,39 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_LABEL_GUARD -#define FL_LABEL_GUARD - - -typedef void* LABEL; - - -extern "C" LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p); -extern "C" void free_fl_label(LABEL l); - - -extern "C" void fl_label_set_value(LABEL l, const char * v); -extern "C" int fl_label_get_font(LABEL l); -extern "C" void fl_label_set_font(LABEL l, int f); -extern "C" int fl_label_get_size(LABEL l); -extern "C" void fl_label_set_size(LABEL l, int s); -extern "C" unsigned int fl_label_get_color(LABEL l); -extern "C" void fl_label_set_color(LABEL l, unsigned int h); -extern "C" int fl_label_get_type(LABEL l); -extern "C" void fl_label_set_type(LABEL l, int k); -extern "C" unsigned int fl_label_get_align(LABEL l); -extern "C" void fl_label_set_align(LABEL l, unsigned int p); -extern "C" void fl_label_set_image(LABEL l, void * i); -extern "C" void fl_label_set_deimage(LABEL l, void * i); - - -extern "C" void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p); -extern "C" void fl_label_measure(LABEL l, int &w, int &h); - - -#endif - - diff --git a/src/c_fl_light_button.cpp b/src/c_fl_light_button.cpp deleted file mode 100644 index f8d52a8..0000000 --- a/src/c_fl_light_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Light_Button.H> -#include "c_fl_light_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Light_Button : public Fl_Light_Button { -public: - using Fl_Light_Button::Fl_Light_Button; - - friend void fl_light_button_draw(LIGHTBUTTON b); - friend int fl_light_button_handle(LIGHTBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Light_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Light_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_light_button_draw(LIGHTBUTTON b) { - reinterpret_cast<My_Light_Button*>(b)->Fl_Light_Button::draw(); -} - -int fl_light_button_handle(LIGHTBUTTON b, int e) { - return reinterpret_cast<My_Light_Button*>(b)->Fl_Light_Button::handle(e); -} - - diff --git a/src/c_fl_light_button.h b/src/c_fl_light_button.h deleted file mode 100644 index 5d604d2..0000000 --- a/src/c_fl_light_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_LIGHT_BUTTON_GUARD -#define FL_LIGHT_BUTTON_GUARD - - -typedef void* LIGHTBUTTON; - - -extern "C" LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_light_button(LIGHTBUTTON b); - - -extern "C" void fl_light_button_draw(LIGHTBUTTON b); -extern "C" int fl_light_button_handle(LIGHTBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_line_dial.cpp b/src/c_fl_line_dial.cpp deleted file mode 100644 index cb0727f..0000000 --- a/src/c_fl_line_dial.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Line_Dial.H> -#include "c_fl_line_dial.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Line_Dial : public Fl_Line_Dial { -public: - using Fl_Line_Dial::Fl_Line_Dial; - - friend void fl_line_dial_draw(LINE_DIAL v); - friend int fl_line_dial_handle(LINE_DIAL v, int e); - - void draw(); - int handle(int e); -}; - -void My_Line_Dial::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Line_Dial::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_line_dial_draw(LINE_DIAL v) { - reinterpret_cast<My_Line_Dial*>(v)->Fl_Line_Dial::draw(); -} - -int fl_line_dial_handle(LINE_DIAL v, int e) { - return reinterpret_cast<My_Line_Dial*>(v)->Fl_Line_Dial::handle(e); -} - - diff --git a/src/c_fl_line_dial.h b/src/c_fl_line_dial.h deleted file mode 100644 index 73ffb89..0000000 --- a/src/c_fl_line_dial.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_LINE_DIAL_GUARD -#define FL_LINE_DIAL_GUARD - - -typedef void* LINE_DIAL; - - -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); - - -extern "C" void fl_line_dial_draw(LINE_DIAL v); -extern "C" int fl_line_dial_handle(LINE_DIAL v, int e); - - -#endif - - diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp deleted file mode 100644 index 8aa82f2..0000000 --- a/src/c_fl_menu.cpp +++ /dev/null @@ -1,240 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Menu_.H> -#include <FL/Fl_Menu_Item.H> -#include "c_fl_menu.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Menu : public Fl_Menu_ { -public: - using Fl_Menu_::Fl_Menu_; - - friend void fl_menu_draw(MENU m); - friend int fl_menu_handle(MENU m, int e); - - void draw(); - int handle(int e); -}; - -void My_Menu::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Menu::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - -void fl_menu_draw(MENU m) { - // The Fl_Menu_ draw method doesn't technically exist, so... - (void)(m); - // It is more convenient for this function to exist, however, - // even though it will likely never be called, because it simplifies - // and makes uniform the implementation of the Ada Menu Draw subprogram. -} - -int fl_menu_handle(MENU m, int e) { - return reinterpret_cast<My_Menu*>(m)->Fl_Menu_::handle(e); -} - - diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h deleted file mode 100644 index b4265aa..0000000 --- a/src/c_fl_menu.h +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MENU_GUARD -#define FL_MENU_GUARD - - -typedef void* MENU; - - -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); -extern "C" void fl_menu_draw(MENU m); -extern "C" int fl_menu_handle(MENU m, int e); - - -#endif - - diff --git a/src/c_fl_menu_bar.cpp b/src/c_fl_menu_bar.cpp deleted file mode 100644 index 1da51e9..0000000 --- a/src/c_fl_menu_bar.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Menu_Bar.H> -#include "c_fl_menu_bar.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Menu_Bar : public Fl_Menu_Bar { -public: - using Fl_Menu_Bar::Fl_Menu_Bar; - - friend void fl_menu_bar_draw(MENUBAR m); - friend int fl_menu_bar_handle(MENUBAR m, int e); - - void draw(); - int handle(int e); -}; - -void My_Menu_Bar::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Menu_Bar::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_menu_bar_draw(MENUBAR m) { - reinterpret_cast<My_Menu_Bar*>(m)->Fl_Menu_Bar::draw(); -} - -int fl_menu_bar_handle(MENUBAR m, int e) { - return reinterpret_cast<My_Menu_Bar*>(m)->Fl_Menu_Bar::handle(e); -} - - diff --git a/src/c_fl_menu_bar.h b/src/c_fl_menu_bar.h deleted file mode 100644 index ae99467..0000000 --- a/src/c_fl_menu_bar.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MENU_BAR_GUARD -#define FL_MENU_BAR_GUARD - - -typedef void* MENUBAR; - - -extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_bar(MENUBAR m); - - -extern "C" void fl_menu_bar_draw(MENUBAR m); -extern "C" int fl_menu_bar_handle(MENUBAR m, int e); - - -#endif - - diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp deleted file mode 100644 index 4a32ca6..0000000 --- a/src/c_fl_menu_button.cpp +++ /dev/null @@ -1,94 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Menu_Button.H> -#include "c_fl_menu_button.h" - - - - -// Telprot stopovers - -extern "C" void menu_button_extra_init_hook - (void * aobj, int x, int y, int w, int h, const char * l); -void fl_menu_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { - menu_button_extra_init_hook(adaobj, x, y, w, h, label); -} - -extern "C" void menu_button_extra_final_hook(void * aobj); -void fl_menu_button_extra_final(void * adaobj) { - menu_button_extra_final_hook(adaobj); -} - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Menu_Button : public Fl_Menu_Button { -public: - using Fl_Menu_Button::Fl_Menu_Button; - - friend void fl_menu_button_draw(MENUBUTTON m); - friend int fl_menu_button_handle(MENUBUTTON m, int e); - - void draw(); - int handle(int e); -}; - -void My_Menu_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Menu_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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(); -} - - - - -void fl_menu_button_draw(MENUBUTTON m) { - reinterpret_cast<My_Menu_Button*>(m)->Fl_Menu_Button::draw(); -} - -int fl_menu_button_handle(MENUBUTTON m, int e) { - return reinterpret_cast<My_Menu_Button*>(m)->Fl_Menu_Button::handle(e); -} - - diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h deleted file mode 100644 index e0e2b00..0000000 --- a/src/c_fl_menu_button.h +++ /dev/null @@ -1,33 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MENU_BUTTON_GUARD -#define FL_MENU_BUTTON_GUARD - - -extern "C" void fl_menu_button_extra_init - (void * adaobj, int x, int y, int w, int h, const char * label); -extern "C" void fl_menu_button_extra_final(void * adaobj); - - -typedef void* MENUBUTTON; - - -extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_button(MENUBUTTON m); - - -extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); -extern "C" const void * fl_menu_button_popup(MENUBUTTON m); - - -extern "C" void fl_menu_button_draw(MENUBUTTON m); -extern "C" int fl_menu_button_handle(MENUBUTTON m, int e); - - -#endif - - diff --git a/src/c_fl_menu_window.cpp b/src/c_fl_menu_window.cpp deleted file mode 100644 index a01b0f7..0000000 --- a/src/c_fl_menu_window.cpp +++ /dev/null @@ -1,106 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Menu_Window.H> -#include "c_fl_menu_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Menu_Window : public Fl_Menu_Window { -public: - using Fl_Menu_Window::Fl_Menu_Window; - - friend void fl_menu_window_draw(MENUWINDOW n); - friend int fl_menu_window_handle(MENUWINDOW n, int e); - - void draw(); - int handle(int e); -}; - -void My_Menu_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Menu_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_erase(MENUWINDOW m) { - reinterpret_cast<Fl_Menu_Window*>(m)->erase(); -} - - - - -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(); -} - - - - -void fl_menu_window_draw(MENUWINDOW n) { - reinterpret_cast<My_Menu_Window*>(n)->Fl_Menu_Window::draw(); -} - -int fl_menu_window_handle(MENUWINDOW n, int e) { - return reinterpret_cast<My_Menu_Window*>(n)->Fl_Menu_Window::handle(e); -} - - diff --git a/src/c_fl_menu_window.h b/src/c_fl_menu_window.h deleted file mode 100644 index 020a377..0000000 --- a/src/c_fl_menu_window.h +++ /dev/null @@ -1,36 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MENU_WINDOW_GUARD -#define FL_MENU_WINDOW_GUARD - - -typedef void* MENUWINDOW; - - -extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label); -extern "C" MENUWINDOW new_fl_menu_window2(int w, int h, 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_erase(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); - - -extern "C" void fl_menu_window_draw(MENUWINDOW n); -extern "C" int fl_menu_window_handle(MENUWINDOW n, int e); - - -#endif - - diff --git a/src/c_fl_menuitem.cpp b/src/c_fl_menuitem.cpp deleted file mode 100644 index 217b3bd..0000000 --- a/src/c_fl_menuitem.cpp +++ /dev/null @@ -1,162 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 665cace..0000000 --- a/src/c_fl_menuitem.h +++ /dev/null @@ -1,65 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_multi_browser.cpp b/src/c_fl_multi_browser.cpp deleted file mode 100644 index 82fbdfb..0000000 --- a/src/c_fl_multi_browser.cpp +++ /dev/null @@ -1,265 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Multi_Browser.H> -#include "c_fl_multi_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -extern "C" int browser_item_width_hook(void * b, void * i); -extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Multi_Browser : public Fl_Multi_Browser { -public: - using Fl_Multi_Browser::Fl_Multi_Browser; - - friend int fl_multi_browser_item_width(MULTIBROWSER b, void * item); - friend int fl_multi_browser_item_height(MULTIBROWSER b, void * item); - friend void * fl_multi_browser_item_first(MULTIBROWSER b); - friend void * fl_multi_browser_item_last(MULTIBROWSER b); - friend void * fl_multi_browser_item_next(MULTIBROWSER b, void * item); - friend void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item); - friend void * fl_multi_browser_item_at(MULTIBROWSER b, int index); - friend void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val); - friend int fl_multi_browser_item_selected(MULTIBROWSER b, void * item); - friend void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y); - friend const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item); - friend void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h); - - friend int fl_multi_browser_full_width(MULTIBROWSER c); - friend int fl_multi_browser_full_height(MULTIBROWSER c); - friend int fl_multi_browser_incr_height(MULTIBROWSER c); - friend int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i); - - friend void fl_multi_browser_draw(MULTIBROWSER b); - - int handle(int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - int item_width(void * item) const; - int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); -}; - - -int My_Multi_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Multi_Browser::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Multi_Browser::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Multi_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -int My_Multi_Browser::item_width(void * item) const { - return browser_item_width_hook(this->user_data(), item); -} - -int My_Multi_Browser::item_height(void * item) const { - return browser_item_height_hook(this->user_data(), item); -} - -void * My_Multi_Browser::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_Multi_Browser::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_Multi_Browser::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_Multi_Browser::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_Multi_Browser::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_Multi_Browser::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_Multi_Browser::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_Multi_Browser::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_Multi_Browser::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -void My_Multi_Browser::item_draw(void * item, int x, int y, int w, int h) const { - browser_item_draw_hook(this->user_data(), item, x, y, w, h); -} - - -void My_Multi_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Multi_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -MULTIBROWSER new_fl_multi_browser(int x, int y, int w, int h, char * label) { - My_Multi_Browser *b = new My_Multi_Browser(x, y, w, h, label); - return b; -} - -void free_fl_multi_browser(MULTIBROWSER b) { - delete reinterpret_cast<My_Multi_Browser*>(b); -} - - - - -// These have to be reimplemented due to relying on custom class extensions - - -int fl_multi_browser_full_height(MULTIBROWSER c) { - return reinterpret_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::full_height(); -} - -int fl_multi_browser_incr_height(MULTIBROWSER c) { - return reinterpret_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::incr_height(); -} - - - - -int fl_multi_browser_item_width(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_width(item); -} - -int fl_multi_browser_item_height(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_height(item); -} - -void * fl_multi_browser_item_first(MULTIBROWSER b) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_first(); -} - -void * fl_multi_browser_item_last(MULTIBROWSER b) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_last(); -} - -void * fl_multi_browser_item_next(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_next(item); -} - -void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_prev(item); -} - -void * fl_multi_browser_item_at(MULTIBROWSER b, int index) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_at(index); -} - -void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val) { - reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_select(item, val); -} - -int fl_multi_browser_item_selected(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_selected(item); -} - -void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y) { - reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_swap(x, y); -} - -const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_text(item); -} - -void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h) { - reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_draw(item, x, y, w, h); -} - - - - -int fl_multi_browser_full_width(MULTIBROWSER c) { - return reinterpret_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::full_width(); -} - -int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i) { - return reinterpret_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::item_quick_height(i); -} - - - - -void fl_multi_browser_draw(MULTIBROWSER b) { - reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::draw(); -} - -int fl_multi_browser_handle(MULTIBROWSER b, int e) { - return reinterpret_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::handle(e); -} - - diff --git a/src/c_fl_multi_browser.h b/src/c_fl_multi_browser.h deleted file mode 100644 index 29d18ec..0000000 --- a/src/c_fl_multi_browser.h +++ /dev/null @@ -1,48 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MULTI_BROWSER_GUARD -#define FL_MULTI_BROWSER_GUARD - - -typedef void* MULTIBROWSER; - - -extern "C" MULTIBROWSER new_fl_multi_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_multi_browser(MULTIBROWSER b); - - -// reimp below here - -extern "C" int fl_multi_browser_full_height(MULTIBROWSER c); -extern "C" int fl_multi_browser_incr_height(MULTIBROWSER c); - - -extern "C" int fl_multi_browser_item_width(MULTIBROWSER b, void * item); -extern "C" int fl_multi_browser_item_height(MULTIBROWSER b, void * item); -extern "C" void * fl_multi_browser_item_first(MULTIBROWSER b); -extern "C" void * fl_multi_browser_item_last(MULTIBROWSER b); -extern "C" void * fl_multi_browser_item_next(MULTIBROWSER b, void * item); -extern "C" void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item); -extern "C" void * fl_multi_browser_item_at(MULTIBROWSER b, int index); -extern "C" void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val=1); -extern "C" int fl_multi_browser_item_selected(MULTIBROWSER b, void * item); -extern "C" void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y); -extern "C" const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item); -extern "C" void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h); - - -extern "C" int fl_multi_browser_full_width(MULTIBROWSER c); -extern "C" int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i); - - -extern "C" void fl_multi_browser_draw(MULTIBROWSER b); -extern "C" int fl_multi_browser_handle(MULTIBROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_multiline_input.cpp b/src/c_fl_multiline_input.cpp deleted file mode 100644 index 46d0a33..0000000 --- a/src/c_fl_multiline_input.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Multiline_Input.H> -#include "c_fl_multiline_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Multiline_Input : public Fl_Multiline_Input { -public: - using Fl_Multiline_Input::Fl_Multiline_Input; - - friend void fl_multiline_input_draw(MULTILINEINPUT i); - friend int fl_multiline_input_handle(MULTILINEINPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Multiline_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Multiline_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label) { - My_Multiline_Input *i = new My_Multiline_Input(x, y, w, h, label); - return i; -} - -void free_fl_multiline_input(MULTILINEINPUT i) { - delete reinterpret_cast<My_Multiline_Input*>(i); -} - - - - -void fl_multiline_input_draw(MULTILINEINPUT i) { - reinterpret_cast<My_Multiline_Input*>(i)->Fl_Multiline_Input::draw(); -} - -int fl_multiline_input_handle(MULTILINEINPUT i, int e) { - return reinterpret_cast<My_Multiline_Input*>(i)->Fl_Multiline_Input::handle(e); -} - - diff --git a/src/c_fl_multiline_input.h b/src/c_fl_multiline_input.h deleted file mode 100644 index ba4e723..0000000 --- a/src/c_fl_multiline_input.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MULTILINE_INPUT_GUARD -#define FL_MULTILINE_INPUT_GUARD - - -typedef void* MULTILINEINPUT; - - -extern "C" MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_multiline_input(MULTILINEINPUT i); - - -extern "C" void fl_multiline_input_draw(MULTILINEINPUT i); -extern "C" int fl_multiline_input_handle(MULTILINEINPUT i, int e); - - -#endif - - diff --git a/src/c_fl_multiline_output.cpp b/src/c_fl_multiline_output.cpp deleted file mode 100644 index 6be13a2..0000000 --- a/src/c_fl_multiline_output.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Multiline_Output.H> -#include "c_fl_multiline_output.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Multiline_Output : public Fl_Multiline_Output { -public: - using Fl_Multiline_Output::Fl_Multiline_Output; - - friend void fl_multiline_output_draw(MULTILINEOUTPUT i); - friend int fl_multiline_output_handle(MULTILINEOUTPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Multiline_Output::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Multiline_Output::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label) { - My_Multiline_Output *i = new My_Multiline_Output(x, y, w, h, label); - return i; -} - -void free_fl_multiline_output(MULTILINEOUTPUT i) { - delete reinterpret_cast<My_Multiline_Output*>(i); -} - - - - -void fl_multiline_output_draw(MULTILINEOUTPUT i) { - reinterpret_cast<My_Multiline_Output*>(i)->Fl_Multiline_Output::draw(); -} - -int fl_multiline_output_handle(MULTILINEOUTPUT i, int e) { - return reinterpret_cast<My_Multiline_Output*>(i)->Fl_Multiline_Output::handle(e); -} - - diff --git a/src/c_fl_multiline_output.h b/src/c_fl_multiline_output.h deleted file mode 100644 index 43fee90..0000000 --- a/src/c_fl_multiline_output.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_MULTILINE_OUTPUT_GUARD -#define FL_MULTILINE_OUTPUT_GUARD - - -typedef void* MULTILINEOUTPUT; - - -extern "C" MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_multiline_output(MULTILINEOUTPUT i); - - -extern "C" void fl_multiline_output_draw(MULTILINEOUTPUT i); -extern "C" int fl_multiline_output_handle(MULTILINEOUTPUT i, int e); - - -#endif - - diff --git a/src/c_fl_nice_slider.cpp b/src/c_fl_nice_slider.cpp deleted file mode 100644 index e4263dd..0000000 --- a/src/c_fl_nice_slider.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Nice_Slider.H> -#include "c_fl_nice_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Nice_Slider : public Fl_Nice_Slider { -public: - using Fl_Nice_Slider::Fl_Nice_Slider; - - friend void fl_nice_slider_draw(NICESLIDER s); - friend int fl_nice_slider_handle(NICESLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Nice_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Nice_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -NICESLIDER 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(NICESLIDER s) { - delete reinterpret_cast<My_Nice_Slider*>(s); -} - - - - -void fl_nice_slider_draw(NICESLIDER s) { - reinterpret_cast<My_Nice_Slider*>(s)->Fl_Nice_Slider::draw(); -} - -int fl_nice_slider_handle(NICESLIDER s, int e) { - return reinterpret_cast<My_Nice_Slider*>(s)->Fl_Nice_Slider::handle(e); -} - - diff --git a/src/c_fl_nice_slider.h b/src/c_fl_nice_slider.h deleted file mode 100644 index 2da3207..0000000 --- a/src/c_fl_nice_slider.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_NICE_SLIDER_GUARD -#define FL_NICE_SLIDER_GUARD - - -typedef void* NICESLIDER; - - -extern "C" NICESLIDER new_fl_nice_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_nice_slider(NICESLIDER s); - - -extern "C" void fl_nice_slider_draw(NICESLIDER s); -extern "C" int fl_nice_slider_handle(NICESLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_output.cpp b/src/c_fl_output.cpp deleted file mode 100644 index 2251f8d..0000000 --- a/src/c_fl_output.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Output.H> -#include "c_fl_output.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Output : public Fl_Output { -public: - using Fl_Output::Fl_Output; - - friend void fl_output_draw(OUTPUTT i); - friend int fl_output_handle(OUTPUTT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Output::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Output::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -OUTPUTT new_fl_output(int x, int y, int w, int h, char* label) { - My_Output *i = new My_Output(x, y, w, h, label); - return i; -} - -void free_fl_output(OUTPUTT i) { - delete reinterpret_cast<My_Output*>(i); -} - - - - -void fl_output_draw(OUTPUTT i) { - reinterpret_cast<My_Output*>(i)->Fl_Output::draw(); -} - -int fl_output_handle(OUTPUTT i, int e) { - return reinterpret_cast<My_Output*>(i)->Fl_Output::handle(e); -} - - diff --git a/src/c_fl_output.h b/src/c_fl_output.h deleted file mode 100644 index 174c32e..0000000 --- a/src/c_fl_output.h +++ /dev/null @@ -1,26 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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" OUTPUTT new_fl_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_output(OUTPUTT i); - - -extern "C" void fl_output_draw(OUTPUTT i); -extern "C" int fl_output_handle(OUTPUTT i, int e); - - -#endif - - diff --git a/src/c_fl_overlay_window.cpp b/src/c_fl_overlay_window.cpp deleted file mode 100644 index c5610ef..0000000 --- a/src/c_fl_overlay_window.cpp +++ /dev/null @@ -1,116 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Overlay_Window.H> -#include "c_fl_overlay_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - -extern "C" void overlay_window_draw_overlay_hook(void * ud); - - - - -// Attaching all relevant hooks and friends - -class My_Overlay_Window : public Fl_Overlay_Window { -public: - using Fl_Overlay_Window::Fl_Overlay_Window; - - 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); - - friend void fl_overlay_window_draw(OVERLAYWINDOW w); - friend int fl_overlay_window_handle(OVERLAYWINDOW w, int e); - - void draw(); - void draw_overlay(); - int handle(int e); -}; - -void My_Overlay_Window::draw() { - widget_draw_hook(this->user_data()); -} - -void My_Overlay_Window::draw_overlay() { - overlay_window_draw_overlay_hook(this->user_data()); -} - -int My_Overlay_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_resize(OVERLAYWINDOW ow, int x, int y, int w, int h) { - reinterpret_cast<Fl_Overlay_Window*>(ow)->resize(x, y, w, h); -} - - - - -void fl_overlay_window_show(OVERLAYWINDOW w) { - reinterpret_cast<Fl_Overlay_Window*>(w)->show(); -} - -void fl_overlay_window_show2(OVERLAYWINDOW w, int c, void * v) { - reinterpret_cast<Fl_Overlay_Window*>(w)->show(c, static_cast<char**>(v)); -} - -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(); -} - -void fl_overlay_window_draw(OVERLAYWINDOW w) { - reinterpret_cast<My_Overlay_Window*>(w)->Fl_Overlay_Window::draw(); -} - -int fl_overlay_window_handle(OVERLAYWINDOW w, int e) { - return reinterpret_cast<My_Overlay_Window*>(w)->Fl_Overlay_Window::handle(e); -} - - diff --git a/src/c_fl_overlay_window.h b/src/c_fl_overlay_window.h deleted file mode 100644 index a94bbec..0000000 --- a/src/c_fl_overlay_window.h +++ /dev/null @@ -1,36 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_OVERLAY_WINDOW_GUARD -#define FL_OVERLAY_WINDOW_GUARD - - -typedef void* OVERLAYWINDOW; - - -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_resize(OVERLAYWINDOW ow, int x, int y, int w, int h); - - -extern "C" void fl_overlay_window_show(OVERLAYWINDOW w); -extern "C" void fl_overlay_window_show2(OVERLAYWINDOW w, int c, void * v); -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); -extern "C" void fl_overlay_window_draw(OVERLAYWINDOW w); -extern "C" int fl_overlay_window_handle(OVERLAYWINDOW w, int e); - - -#endif - - diff --git a/src/c_fl_pack.cpp b/src/c_fl_pack.cpp deleted file mode 100644 index 2e83b3f..0000000 --- a/src/c_fl_pack.cpp +++ /dev/null @@ -1,78 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Pack.H> -#include "c_fl_pack.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Pack : public Fl_Pack { -public: - using Fl_Pack::Fl_Pack; - - friend void fl_pack_draw(PACK n); - friend int fl_pack_handle(PACK n, int e); - - void draw(); - int handle(int e); -}; - -void My_Pack::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Pack::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_pack_draw(PACK n) { - reinterpret_cast<My_Pack*>(n)->Fl_Pack::draw(); -} - -int fl_pack_handle(PACK n, int e) { - return reinterpret_cast<My_Pack*>(n)->Fl_Pack::handle(e); -} - - diff --git a/src/c_fl_pack.h b/src/c_fl_pack.h deleted file mode 100644 index a8bfe75..0000000 --- a/src/c_fl_pack.h +++ /dev/null @@ -1,28 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_PACK_GUARD -#define FL_PACK_GUARD - - -typedef void* PACK; - - -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); - - -extern "C" void fl_pack_draw(PACK n); -extern "C" int fl_pack_handle(PACK n, int e); - - -#endif - - diff --git a/src/c_fl_paged_device.cpp b/src/c_fl_paged_device.cpp deleted file mode 100644 index 2d3e788..0000000 --- a/src/c_fl_paged_device.cpp +++ /dev/null @@ -1,153 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Paged_Device.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_paged_device.h" - - - - -// Enums and macro constants - -const int fl_page_format_media = Fl_Paged_Device::MEDIA; - -const int fl_page_layout_portrait = Fl_Paged_Device::PORTRAIT; -const int fl_page_layout_landscape = Fl_Paged_Device::LANDSCAPE; -const int fl_page_layout_reversed = Fl_Paged_Device::REVERSED; -const int fl_page_layout_orientation = Fl_Paged_Device::ORIENTATION; - -const int fl_no_page_formats = NO_PAGE_FORMATS; - - - - -// Helper functions - -void fl_paged_device_get_page_format(int i, const char ** n, int * w, int * h) { - *n = Fl_Paged_Device::page_formats[i].name; - *w = Fl_Paged_Device::page_formats[i].height; - *h = Fl_Paged_Device::page_formats[i].width; -} - - - - -// Adding relevant friends - -class My_Paged_Device : public Fl_Paged_Device { -public: - using Fl_Paged_Device::Fl_Paged_Device; - friend PAGED_DEVICE new_fl_paged_device(void); -}; - - - - -// Flattened C API - -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 aef50c1..0000000 --- a/src/c_fl_paged_device.h +++ /dev/null @@ -1,54 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_PAGED_DEVICE_GUARD -#define FL_PAGED_DEVICE_GUARD - - -extern "C" const int fl_page_format_media; -extern "C" const int fl_page_layout_portrait; -extern "C" const int fl_page_layout_landscape; -extern "C" const int fl_page_layout_reversed; -extern "C" const int fl_page_layout_orientation; -extern "C" const int fl_no_page_formats; - - -extern "C" void fl_paged_device_get_page_format(int i, const char ** n, int * w, int * h); - - -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 b880bac..0000000 --- a/src/c_fl_pixmap.cpp +++ /dev/null @@ -1,58 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 aa3be59..0000000 --- a/src/c_fl_pixmap.h +++ /dev/null @@ -1,35 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 e4b0c33..0000000 --- a/src/c_fl_png_image.cpp +++ /dev/null @@ -1,26 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 78dd203..0000000 --- a/src/c_fl_png_image.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 d88a92e..0000000 --- a/src/c_fl_pnm_image.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 0757916..0000000 --- a/src/c_fl_pnm_image.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_positioner.cpp b/src/c_fl_positioner.cpp deleted file mode 100644 index ce23b64..0000000 --- a/src/c_fl_positioner.cpp +++ /dev/null @@ -1,166 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Positioner.H> -#include "c_fl_positioner.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Positioner : Fl_Positioner { -public: - // Really only needed for the versions with (x,y,w,h) - using Fl_Positioner::draw; - using Fl_Positioner::handle; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Positioner : public Fl_Positioner { -public: - using Fl_Positioner::Fl_Positioner; - - friend void fl_positioner_draw(POSITIONER p); - friend int fl_positioner_handle(POSITIONER p, int e); - - void draw(); - int handle(int e); -}; - -void My_Positioner::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Positioner::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -POSITIONER new_fl_positioner(int x, int y, int w, int h, char* label) { - My_Positioner *p = new My_Positioner(x, y, w, h, label); - return p; -} - -void free_fl_positioner(POSITIONER p) { - delete static_cast<My_Positioner*>(p); -} - - - - -int fl_positioner_set_value(POSITIONER p, double x, double y) { - return static_cast<Fl_Positioner*>(p)->value(x, y); -} - - - - -void fl_positioner_xbounds(POSITIONER p, double l, double h) { - static_cast<Fl_Positioner*>(p)->xbounds(l, h); -} - -void fl_positioner_xstep(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->xstep(a); -} - -double fl_positioner_get_xminimum(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->xminimum(); -} - -void fl_positioner_set_xminimum(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->xminimum(a); -} - -double fl_positioner_get_xmaximum(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->xmaximum(); -} - -void fl_positioner_set_xmaximum(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->xmaximum(a); -} - -double fl_positioner_get_xvalue(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->xvalue(); -} - -int fl_positioner_set_xvalue(POSITIONER p, double x) { - return static_cast<Fl_Positioner*>(p)->xvalue(x); -} - - - - -void fl_positioner_ybounds(POSITIONER p, double l, double h) { - static_cast<Fl_Positioner*>(p)->ybounds(l, h); -} - -void fl_positioner_ystep(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->ystep(a); -} - -double fl_positioner_get_yminimum(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->yminimum(); -} - -void fl_positioner_set_yminimum(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->yminimum(a); -} - -double fl_positioner_get_ymaximum(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->ymaximum(); -} - -void fl_positioner_set_ymaximum(POSITIONER p, double a) { - static_cast<Fl_Positioner*>(p)->ymaximum(a); -} - -double fl_positioner_get_yvalue(POSITIONER p) { - return static_cast<Fl_Positioner*>(p)->yvalue(); -} - -int fl_positioner_set_yvalue(POSITIONER p, double y) { - return static_cast<Fl_Positioner*>(p)->yvalue(y); -} - - - - -void fl_positioner_draw(POSITIONER p) { - static_cast<My_Positioner*>(p)->Fl_Positioner::draw(); -} - -void fl_positioner_draw2(POSITIONER p, int x, int y, int w, int h) { - void (Fl_Positioner::*mydraw)(int,int,int,int) = &Friend_Positioner::draw; - (static_cast<Fl_Positioner*>(p)->*mydraw)(x, y, w, h); -} - -int fl_positioner_handle(POSITIONER p, int e) { - return static_cast<My_Positioner*>(p)->Fl_Positioner::handle(e); -} - -int fl_positioner_handle2(POSITIONER p, int e, int x, int y, int w, int h) { - int (Fl_Positioner::*myhandle)(int,int,int,int,int) = &Friend_Positioner::handle; - return (static_cast<Fl_Positioner*>(p)->*myhandle)(e, x, y, w, h); -} - - diff --git a/src/c_fl_positioner.h b/src/c_fl_positioner.h deleted file mode 100644 index 9fd96d4..0000000 --- a/src/c_fl_positioner.h +++ /dev/null @@ -1,49 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_POSITIONER_GUARD -#define FL_POSITIONER_GUARD - - -typedef void* POSITIONER; - - -extern "C" POSITIONER new_fl_positioner(int x, int y, int w, int h, char* label); -extern "C" void free_fl_positioner(POSITIONER p); - - -extern "C" int fl_positioner_set_value(POSITIONER p, double x, double y); - - -extern "C" void fl_positioner_xbounds(POSITIONER p, double l, double h); -extern "C" void fl_positioner_xstep(POSITIONER p, double a); -extern "C" double fl_positioner_get_xminimum(POSITIONER p); -extern "C" void fl_positioner_set_xminimum(POSITIONER p, double a); -extern "C" double fl_positioner_get_xmaximum(POSITIONER p); -extern "C" void fl_positioner_set_xmaximum(POSITIONER p, double a); -extern "C" double fl_positioner_get_xvalue(POSITIONER p); -extern "C" int fl_positioner_set_xvalue(POSITIONER p, double x); - - -extern "C" void fl_positioner_ybounds(POSITIONER p, double l, double h); -extern "C" void fl_positioner_ystep(POSITIONER p, double a); -extern "C" double fl_positioner_get_yminimum(POSITIONER p); -extern "C" void fl_positioner_set_yminimum(POSITIONER p, double a); -extern "C" double fl_positioner_get_ymaximum(POSITIONER p); -extern "C" void fl_positioner_set_ymaximum(POSITIONER p, double a); -extern "C" double fl_positioner_get_yvalue(POSITIONER p); -extern "C" int fl_positioner_set_yvalue(POSITIONER p, double y); - - -extern "C" void fl_positioner_draw(POSITIONER p); -extern "C" void fl_positioner_draw2(POSITIONER p, int x, int y, int w, int h); -extern "C" int fl_positioner_handle(POSITIONER p, int e); -extern "C" int fl_positioner_handle2(POSITIONER p, int e, int x, int y, int w, int h); - - -#endif - - diff --git a/src/c_fl_postscript_file_device.cpp b/src/c_fl_postscript_file_device.cpp deleted file mode 100644 index 22495dd..0000000 --- a/src/c_fl_postscript_file_device.cpp +++ /dev/null @@ -1,125 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_PostScript.H> -#include "c_fl_postscript_file_device.h" - - - - -// Making available protected methods - -class My_PostScript_File_Device : Fl_PostScript_File_Device { -public: - using Fl_PostScript_File_Device::driver; -}; - - - - -// Flattened C API - -POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void) { - Fl_PostScript_File_Device *p = new Fl_PostScript_File_Device(); - return p; -} - -void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p) { - delete reinterpret_cast<Fl_PostScript_File_Device*>(p); -} - - - - -const char * fl_postscript_file_device_get_file_chooser_title() { - return Fl_PostScript_File_Device::file_chooser_title; -} - -void fl_postscript_file_device_set_file_chooser_title(const char * v) { - Fl_PostScript_File_Device::file_chooser_title = v; -} - - - - -void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p) { - return (reinterpret_cast<Fl_PostScript_File_Device*>(p)->*(&My_PostScript_File_Device::driver))(); -} - - - - -int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job(c, 0, 0); -} - -int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job(c, f, t); -} - -int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job - (reinterpret_cast<FILE*>(o), - c, - static_cast<Fl_Paged_Device::Page_Format>(f), - static_cast<Fl_Paged_Device::Page_Layout>(l)); -} - -int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job - (c, - static_cast<Fl_Paged_Device::Page_Format>(f), - static_cast<Fl_Paged_Device::Page_Layout>(l)); -} - -void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->end_job(); -} - -int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_page(); -} - -int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->end_page(); -} - - - - -void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t, int * r, int * b) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->margins(l,t,r,b); -} - -int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h) { - return reinterpret_cast<Fl_PostScript_File_Device*>(p)->printable_rect(w,h); -} - -void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->origin(x,y); -} - -void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->origin(x,y); -} - -void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->rotate(r); -} - -void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->scale(x,y); -} - -void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->translate(x,y); -} - -void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p) { - reinterpret_cast<Fl_PostScript_File_Device*>(p)->untranslate(); -} - - diff --git a/src/c_fl_postscript_file_device.h b/src/c_fl_postscript_file_device.h deleted file mode 100644 index f4d6d31..0000000 --- a/src/c_fl_postscript_file_device.h +++ /dev/null @@ -1,47 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_POSTSCRIPT_FILE_DEVICE_GUARD -#define FL_POSTSCRIPT_FILE_DEVICE_GUARD - - -typedef void* POSTSCRIPTFILEDEVICE; - - -extern "C" POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void); -extern "C" void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p); - - -extern "C" const char * fl_postscript_file_device_get_file_chooser_title(); -extern "C" void fl_postscript_file_device_set_file_chooser_title(const char * v); - - -extern "C" void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p); - - -extern "C" int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c); -extern "C" int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t); -extern "C" int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l); -extern "C" int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l); -extern "C" void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p); -extern "C" int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p); -extern "C" int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p); - - -extern "C" void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t, - int * r, int * b); -extern "C" int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h); -extern "C" void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y); -extern "C" void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y); -extern "C" void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r); -extern "C" void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y); -extern "C" void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y); -extern "C" void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p); - - -#endif - - diff --git a/src/c_fl_preferences.cpp b/src/c_fl_preferences.cpp deleted file mode 100644 index 6f2e1ad..0000000 --- a/src/c_fl_preferences.cpp +++ /dev/null @@ -1,233 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Preferences.H> -#include <FL/filename.H> -#include <cstdlib> -#include "c_fl_preferences.h" - - - - -const int root_fl_prefs_system = Fl_Preferences::SYSTEM; -const int root_fl_prefs_user = Fl_Preferences::USER; - -const int const_fl_path_max = FL_PATH_MAX; - - - - -const char * fl_preferences_new_uuid() { - return Fl_Preferences::newUUID(); -} - - - - -class My_Preferences : public Fl_Preferences { - public: - using Fl_Preferences::Fl_Preferences; - int reference_count = 0; -}; - - - - -PREFS new_fl_pref_database_path(char * p, char * v, char * a) { - My_Preferences *e = new My_Preferences(p, v, a); - return e; -} - -PREFS new_fl_pref_database_scope(int s, char * v, char * a) { - My_Preferences *e = new My_Preferences((Fl_Preferences::Root)s, v, a); - return e; -} - -void upref_fl_pref_database(PREFS e) { - reinterpret_cast<My_Preferences*>(e)->reference_count += 1; -} - -void free_fl_pref_database(PREFS e) { - if (reinterpret_cast<My_Preferences*>(e)->reference_count <= 0) { - delete reinterpret_cast<My_Preferences*>(e); - } else { - reinterpret_cast<My_Preferences*>(e)->reference_count -= 1; - } -} - - -PREFS new_fl_pref_group_copy(PREFS e) { - Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e)); - return g; -} - -PREFS new_fl_pref_group_memory(char * n) { - Fl_Preferences *g = new Fl_Preferences(NULL, n); - return g; -} - -PREFS new_fl_pref_group_name(PREFS e, char * n) { - Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e), n); - return g; -} - -PREFS new_fl_pref_group_index(PREFS e, int i) { - Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e), i); - return g; -} - -void free_fl_pref_group(PREFS e) { - delete reinterpret_cast<Fl_Preferences*>(e); -} - - - - -void fl_preferences_flush(PREFS e) { - reinterpret_cast<Fl_Preferences*>(e)->flush(); -} - -int fl_preferences_getuserdatapath(PREFS e, char * p, int len) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->getUserdataPath(p, len); -} - - - - -int fl_preferences_deleteentry(PREFS e, const char * k) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteEntry(k); -} - -int fl_preferences_deleteallentries(PREFS e) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteAllEntries(); -} - -int fl_preferences_deletegroup(PREFS e, const char * g) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteGroup(g); -} - -int fl_preferences_deleteallgroups(PREFS e) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteAllGroups(); -} - -int fl_preferences_clear(PREFS e) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->clear(); -} - - - - -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 (int)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_groups(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->groups(); -} - -const char * fl_preferences_group(PREFS e, int i) { - return reinterpret_cast<Fl_Preferences*>(e)->group(i); -} - -int fl_preferences_groupexists(PREFS e, const char * g) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->groupExists(g); -} - - - - -const char * fl_preferences_name(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->name(); -} - -const char * fl_preferences_path(PREFS e) { - return reinterpret_cast<Fl_Preferences*>(e)->path(); -} - - - - -int fl_preferences_get_int(PREFS e, const char * k, int& v, int d) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_float(PREFS e, const char * k, float& v, float d) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_double(PREFS e, const char * k, double& v, double d) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -// must deallocate result afterwards -int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d); -} - -int fl_preferences_get_str_limit (PREFS e, const char * k, char * v, const char * d, int m) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, m); -} - -// must deallocate result afterwards -int fl_preferences_get_void (PREFS e, const char * k, void *& v, const void * d, int ds) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, ds); -} - -int fl_preferences_get_void_limit (PREFS e, const char * k, void * v, const void * d, int ds, int ms) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, ds, ms); -} - -void free_fl_preferences_void_data(void * v) { - free(v); -} - - - - -int fl_preferences_set_int(PREFS e, const char * k, int v) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_float(PREFS e, const char * k, float v) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p); -} - -int fl_preferences_set_double(PREFS e, const char * k, double v) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p); -} - -int fl_preferences_set_str(PREFS e, const char * k, const char * v) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v); -} - -int fl_preferences_set_void(PREFS e, const char * k, const void * d, int ds) { - return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k, d, ds); -} - - diff --git a/src/c_fl_preferences.h b/src/c_fl_preferences.h deleted file mode 100644 index efc6254..0000000 --- a/src/c_fl_preferences.h +++ /dev/null @@ -1,95 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_PREFERENCES_GUARD -#define FL_PREFERENCES_GUARD - - - - -typedef void* PREFS; - - - - -extern const int root_fl_prefs_system; -extern const int root_fl_prefs_user; - -extern const int const_fl_path_max; - - - - -extern "C" const char * fl_preferences_new_uuid(); - - - - -extern "C" PREFS new_fl_pref_database_path(char * p, char * v, char * a); -extern "C" PREFS new_fl_pref_database_scope(int s, char * v, char * a); -extern "C" void upref_fl_pref_database(PREFS e); -extern "C" void free_fl_pref_database(PREFS e); - -extern "C" PREFS new_fl_pref_group_copy(PREFS e); -extern "C" PREFS new_fl_pref_group_memory(char * n); -extern "C" PREFS new_fl_pref_group_name(PREFS e, char * n); -extern "C" PREFS new_fl_pref_group_index(PREFS e, int i); -extern "C" void free_fl_pref_group(PREFS e); - - - - -extern "C" void fl_preferences_flush(PREFS e); -extern "C" int fl_preferences_getuserdatapath(PREFS e, char * p, int len); - - -extern "C" int fl_preferences_deleteentry(PREFS e, const char * k); -extern "C" int fl_preferences_deleteallentries(PREFS e); -extern "C" int fl_preferences_deletegroup(PREFS e, const char * g); -extern "C" int fl_preferences_deleteallgroups(PREFS e); -extern "C" int fl_preferences_clear(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_groups(PREFS e); -extern "C" const char * fl_preferences_group(PREFS e, int i); -extern "C" int fl_preferences_groupexists(PREFS e, const char * g); - - -extern "C" const char * fl_preferences_name(PREFS e); -extern "C" const char * fl_preferences_path(PREFS e); - - -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_get_str_limit - (PREFS e, const char * k, char * v, const char * d, int m); -extern "C" int fl_preferences_get_void - (PREFS e, const char * k, void *& v, const void * d, int ds); -extern "C" int fl_preferences_get_void_limit - (PREFS e, const char * k, void * v, const void * d, int ds, int ms); -extern "C" void free_fl_preferences_void_data(void * v); - - -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_set_void(PREFS e, const char * k, const void * d, int ds); - - -#endif - diff --git a/src/c_fl_printer.cpp b/src/c_fl_printer.cpp deleted file mode 100644 index 9967678..0000000 --- a/src/c_fl_printer.cpp +++ /dev/null @@ -1,259 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Printer.H> -#include <FL/Fl_Widget.H> -#include <FL/Fl_Window.H> -#include "c_fl_printer.h" - - - - -// Flattened C API - -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); -} - - - - -const char * fl_printer_get_dialog_title() { - return Fl_Printer::dialog_title; -} - -void fl_printer_set_dialog_title(const char * v) { - Fl_Printer::dialog_title = v; -} - -const char * fl_printer_get_dialog_printer() { - return Fl_Printer::dialog_printer; -} - -void fl_printer_set_dialog_printer(const char * v) { - Fl_Printer::dialog_printer = v; -} - -const char * fl_printer_get_dialog_range() { - return Fl_Printer::dialog_range; -} - -void fl_printer_set_dialog_range(const char * v) { - Fl_Printer::dialog_range = v; -} - -const char * fl_printer_get_dialog_copies() { - return Fl_Printer::dialog_copies; -} - -void fl_printer_set_dialog_copies(const char * v) { - Fl_Printer::dialog_copies = v; -} - -const char * fl_printer_get_dialog_all() { - return Fl_Printer::dialog_all; -} - -void fl_printer_set_dialog_all(const char * v) { - Fl_Printer::dialog_all = v; -} - -const char * fl_printer_get_dialog_pages() { - return Fl_Printer::dialog_pages; -} - -void fl_printer_set_dialog_pages(const char * v) { - Fl_Printer::dialog_pages = v; -} - -const char * fl_printer_get_dialog_from() { - return Fl_Printer::dialog_from; -} - -void fl_printer_set_dialog_from(const char * v) { - Fl_Printer::dialog_from = v; -} - -const char * fl_printer_get_dialog_to() { - return Fl_Printer::dialog_to; -} - -void fl_printer_set_dialog_to(const char * v) { - Fl_Printer::dialog_to = v; -} - -const char * fl_printer_get_dialog_properties() { - return Fl_Printer::dialog_properties; -} - -void fl_printer_set_dialog_properties(const char * v) { - Fl_Printer::dialog_properties = v; -} - -const char * fl_printer_get_dialog_copyno() { - return Fl_Printer::dialog_copyNo; -} - -void fl_printer_set_dialog_copyno(const char * v) { - Fl_Printer::dialog_copyNo = v; -} - -const char * fl_printer_get_dialog_print_button() { - return Fl_Printer::dialog_print_button; -} - -void fl_printer_set_dialog_print_button(const char * v) { - Fl_Printer::dialog_print_button = v; -} - -const char * fl_printer_get_dialog_cancel_button() { - return Fl_Printer::dialog_cancel_button; -} - -void fl_printer_set_dialog_cancel_button(const char * v) { - Fl_Printer::dialog_cancel_button = v; -} - -const char * fl_printer_get_dialog_print_to_file() { - return Fl_Printer::dialog_print_to_file; -} - -void fl_printer_set_dialog_print_to_file(const char * v) { - Fl_Printer::dialog_print_to_file = v; -} - -const char * fl_printer_get_property_title() { - return Fl_Printer::property_title; -} - -void fl_printer_set_property_title(const char * v) { - Fl_Printer::property_title = v; -} - -const char * fl_printer_get_property_pagesize() { - return Fl_Printer::property_pagesize; -} - -void fl_printer_set_property_pagesize(const char * v) { - Fl_Printer::property_pagesize = v; -} - -const char * fl_printer_get_property_mode() { - return Fl_Printer::property_mode; -} - -void fl_printer_set_property_mode(const char * v) { - Fl_Printer::property_mode = v; -} - -const char * fl_printer_get_property_use() { - return Fl_Printer::property_use; -} - -void fl_printer_set_property_use(const char * v) { - Fl_Printer::property_use = v; -} - -const char * fl_printer_get_property_save() { - return Fl_Printer::property_save; -} - -void fl_printer_set_property_save(const char * v) { - Fl_Printer::property_save = v; -} - -const char * fl_printer_get_property_cancel() { - return Fl_Printer::property_cancel; -} - -void fl_printer_set_property_cancel(const char * v) { - Fl_Printer::property_cancel = v; -} - - - - -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 90f070d..0000000 --- a/src/c_fl_printer.h +++ /dev/null @@ -1,85 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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" const char * fl_printer_get_dialog_title(); -extern "C" void fl_printer_set_dialog_title(const char * v); -extern "C" const char * fl_printer_get_dialog_printer(); -extern "C" void fl_printer_set_dialog_printer(const char * v); -extern "C" const char * fl_printer_get_dialog_range(); -extern "C" void fl_printer_set_dialog_range(const char * v); -extern "C" const char * fl_printer_get_dialog_copies(); -extern "C" void fl_printer_set_dialog_copies(const char * v); -extern "C" const char * fl_printer_get_dialog_all(); -extern "C" void fl_printer_set_dialog_all(const char * v); -extern "C" const char * fl_printer_get_dialog_pages(); -extern "C" void fl_printer_set_dialog_pages(const char * v); -extern "C" const char * fl_printer_get_dialog_from(); -extern "C" void fl_printer_set_dialog_from(const char * v); -extern "C" const char * fl_printer_get_dialog_to(); -extern "C" void fl_printer_set_dialog_to(const char * v); -extern "C" const char * fl_printer_get_dialog_properties(); -extern "C" void fl_printer_set_dialog_properties(const char * v); -extern "C" const char * fl_printer_get_dialog_copyno(); -extern "C" void fl_printer_set_dialog_copyno(const char * v); -extern "C" const char * fl_printer_get_dialog_print_button(); -extern "C" void fl_printer_set_dialog_print_button(const char * v); -extern "C" const char * fl_printer_get_dialog_cancel_button(); -extern "C" void fl_printer_set_dialog_cancel_button(const char * v); -extern "C" const char * fl_printer_get_dialog_print_to_file(); -extern "C" void fl_printer_set_dialog_print_to_file(const char * v); -extern "C" const char * fl_printer_get_property_title(); -extern "C" void fl_printer_set_property_title(const char * v); -extern "C" const char * fl_printer_get_property_pagesize(); -extern "C" void fl_printer_set_property_pagesize(const char * v); -extern "C" const char * fl_printer_get_property_mode(); -extern "C" void fl_printer_set_property_mode(const char * v); -extern "C" const char * fl_printer_get_property_use(); -extern "C" void fl_printer_set_property_use(const char * v); -extern "C" const char * fl_printer_get_property_save(); -extern "C" void fl_printer_set_property_save(const char * v); -extern "C" const char * fl_printer_get_property_cancel(); -extern "C" void fl_printer_set_property_cancel(const char * v); - - -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 9c18300..0000000 --- a/src/c_fl_progress.cpp +++ /dev/null @@ -1,94 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Progress.H> -#include "c_fl_progress.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Progress : public Fl_Progress { -public: - using Fl_Progress::Fl_Progress; - - friend void fl_progress_draw(PROGRESS p); - friend int fl_progress_handle(PROGRESS p, int e); - - void draw(); - int handle(int e); -}; - -void My_Progress::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Progress::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_progress_draw(PROGRESS p) { - reinterpret_cast<My_Progress*>(p)->Fl_Progress::draw(); -} - -int fl_progress_handle(PROGRESS p, int e) { - return reinterpret_cast<My_Progress*>(p)->Fl_Progress::handle(e); -} - - diff --git a/src/c_fl_progress.h b/src/c_fl_progress.h deleted file mode 100644 index d75e136..0000000 --- a/src/c_fl_progress.h +++ /dev/null @@ -1,32 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_PROGRESS_GUARD -#define FL_PROGRESS_GUARD - - -typedef void* PROGRESS; - - -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); - - -extern "C" void fl_progress_draw(PROGRESS p); -extern "C" int fl_progress_handle(PROGRESS p, int e); - - -#endif - - diff --git a/src/c_fl_radio_button.cpp b/src/c_fl_radio_button.cpp deleted file mode 100644 index 1813f0d..0000000 --- a/src/c_fl_radio_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Radio_Button.H> -#include "c_fl_radio_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Radio_Button : public Fl_Radio_Button { -public: - using Fl_Radio_Button::Fl_Radio_Button; - - friend void fl_radio_button_draw(RADIOBUTTON b); - friend int fl_radio_button_handle(RADIOBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Radio_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Radio_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_radio_button_draw(RADIOBUTTON b) { - reinterpret_cast<My_Radio_Button*>(b)->Fl_Radio_Button::draw(); -} - -int fl_radio_button_handle(RADIOBUTTON b, int e) { - return reinterpret_cast<My_Radio_Button*>(b)->Fl_Radio_Button::handle(e); -} - - diff --git a/src/c_fl_radio_button.h b/src/c_fl_radio_button.h deleted file mode 100644 index 53bdd57..0000000 --- a/src/c_fl_radio_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_RADIO_BUTTON_GUARD -#define FL_RADIO_BUTTON_GUARD - - -typedef void* RADIOBUTTON; - - -extern "C" RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_button(RADIOBUTTON b); - - -extern "C" void fl_radio_button_draw(RADIOBUTTON b); -extern "C" int fl_radio_button_handle(RADIOBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_radio_light_button.cpp b/src/c_fl_radio_light_button.cpp deleted file mode 100644 index c0a1d90..0000000 --- a/src/c_fl_radio_light_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Radio_Light_Button.H> -#include "c_fl_radio_light_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Radio_Light_Button : public Fl_Radio_Light_Button { -public: - using Fl_Radio_Light_Button::Fl_Radio_Light_Button; - - friend void fl_radio_light_button_draw(RADIOLIGHTBUTTON b); - friend int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Radio_Light_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Radio_Light_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_radio_light_button_draw(RADIOLIGHTBUTTON b) { - reinterpret_cast<My_Radio_Light_Button*>(b)->Fl_Radio_Light_Button::draw(); -} - -int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e) { - return reinterpret_cast<My_Radio_Light_Button*>(b)->Fl_Radio_Light_Button::handle(e); -} - - diff --git a/src/c_fl_radio_light_button.h b/src/c_fl_radio_light_button.h deleted file mode 100644 index 217bd69..0000000 --- a/src/c_fl_radio_light_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_RADIO_LIGHT_BUTTON_GUARD -#define FL_RADIO_LIGHT_BUTTON_GUARD - - -typedef void* RADIOLIGHTBUTTON; - - -extern "C" RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_light_button(RADIOLIGHTBUTTON b); - - -extern "C" void fl_radio_light_button_draw(RADIOLIGHTBUTTON b); -extern "C" int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_radio_round_button.cpp b/src/c_fl_radio_round_button.cpp deleted file mode 100644 index 5ddaa1f..0000000 --- a/src/c_fl_radio_round_button.cpp +++ /dev/null @@ -1,68 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Radio_Round_Button.H> -#include "c_fl_radio_round_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Radio_Round_Button : public Fl_Radio_Round_Button { -public: - using Fl_Radio_Round_Button::Fl_Radio_Round_Button; - - friend void fl_radio_round_button_draw(RADIOROUNDBUTTON b); - friend int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Radio_Round_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Radio_Round_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - - -void fl_radio_round_button_draw(RADIOROUNDBUTTON b) { - reinterpret_cast<My_Radio_Round_Button*>(b)->Fl_Radio_Round_Button::draw(); -} - -int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e) { - return reinterpret_cast<My_Radio_Round_Button*>(b)->Fl_Radio_Round_Button::handle(e); -} - - diff --git a/src/c_fl_radio_round_button.h b/src/c_fl_radio_round_button.h deleted file mode 100644 index bea7076..0000000 --- a/src/c_fl_radio_round_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_RADIO_ROUND_BUTTON_GUARD -#define FL_RADIO_ROUND_BUTTON_GUARD - - -typedef void* RADIOROUNDBUTTON; - - -extern "C" RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_round_button(RADIOROUNDBUTTON b); - - -extern "C" void fl_radio_round_button_draw(RADIOROUNDBUTTON b); -extern "C" int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_repeat_button.cpp b/src/c_fl_repeat_button.cpp deleted file mode 100644 index 7f05235..0000000 --- a/src/c_fl_repeat_button.cpp +++ /dev/null @@ -1,74 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Repeat_Button.H> -#include "c_fl_repeat_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Repeat_Button : public Fl_Repeat_Button { -public: - using Fl_Repeat_Button::Fl_Repeat_Button; - - friend void fl_repeat_button_draw(REPEATBUTTON b); - friend int fl_repeat_button_handle(REPEATBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Repeat_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Repeat_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_repeat_button_deactivate(REPEATBUTTON b) { - reinterpret_cast<Fl_Repeat_Button*>(b)->deactivate(); -} - - - - -void fl_repeat_button_draw(REPEATBUTTON b) { - reinterpret_cast<My_Repeat_Button*>(b)->Fl_Repeat_Button::draw(); -} - -int fl_repeat_button_handle(REPEATBUTTON b, int e) { - return reinterpret_cast<My_Repeat_Button*>(b)->Fl_Repeat_Button::handle(e); -} - - diff --git a/src/c_fl_repeat_button.h b/src/c_fl_repeat_button.h deleted file mode 100644 index 5750a60..0000000 --- a/src/c_fl_repeat_button.h +++ /dev/null @@ -1,27 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_REPEAT_BUTTON_GUARD -#define FL_REPEAT_BUTTON_GUARD - - -typedef void* REPEATBUTTON; - - -extern "C" REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_repeat_button(REPEATBUTTON b); - - -extern "C" void fl_repeat_button_deactivate(REPEATBUTTON b); - - -extern "C" void fl_repeat_button_draw(REPEATBUTTON b); -extern "C" int fl_repeat_button_handle(REPEATBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_return_button.cpp b/src/c_fl_return_button.cpp deleted file mode 100644 index 022685c..0000000 --- a/src/c_fl_return_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Return_Button.H> -#include "c_fl_return_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Return_Button : public Fl_Return_Button { -public: - using Fl_Return_Button::Fl_Return_Button; - - friend void fl_return_button_draw(RETURNBUTTON b); - friend int fl_return_button_handle(RETURNBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Return_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Return_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_return_button_draw(RETURNBUTTON b) { - reinterpret_cast<My_Return_Button*>(b)->Fl_Return_Button::draw(); -} - -int fl_return_button_handle(RETURNBUTTON b, int e) { - return reinterpret_cast<My_Return_Button*>(b)->Fl_Return_Button::handle(e); -} - - diff --git a/src/c_fl_return_button.h b/src/c_fl_return_button.h deleted file mode 100644 index c9f4d62..0000000 --- a/src/c_fl_return_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_RETURN_BUTTON_GUARD -#define FL_RETURN_BUTTON_GUARD - - -typedef void* RETURNBUTTON; - - -extern "C" RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_return_button(RETURNBUTTON b); - - -extern "C" void fl_return_button_draw(RETURNBUTTON b); -extern "C" int fl_return_button_handle(RETURNBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_rgb_image.cpp b/src/c_fl_rgb_image.cpp deleted file mode 100644 index cfd87a6..0000000 --- a/src/c_fl_rgb_image.cpp +++ /dev/null @@ -1,78 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 a76d239..0000000 --- a/src/c_fl_rgb_image.h +++ /dev/null @@ -1,41 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 f5c7dd6..0000000 --- a/src/c_fl_roller.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Roller.H> -#include "c_fl_roller.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Roller : public Fl_Roller { -public: - using Fl_Roller::Fl_Roller; - - friend void fl_roller_draw(ROLLER r); - friend int fl_roller_handle(ROLLER r, int e); - - void draw(); - int handle(int e); -}; - -void My_Roller::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Roller::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_roller_draw(ROLLER r) { - reinterpret_cast<My_Roller*>(r)->Fl_Roller::draw(); -} - -int fl_roller_handle(ROLLER r, int e) { - return reinterpret_cast<My_Roller*>(r)->Fl_Roller::handle(e); -} - - diff --git a/src/c_fl_roller.h b/src/c_fl_roller.h deleted file mode 100644 index a864d71..0000000 --- a/src/c_fl_roller.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ROLLER_GUARD -#define FL_ROLLER_GUARD - - -typedef void* ROLLER; - - -extern "C" ROLLER new_fl_roller(int x, int y, int w, int h, char* label); -extern "C" void free_fl_roller(ROLLER r); - - -extern "C" void fl_roller_draw(ROLLER r); -extern "C" int fl_roller_handle(ROLLER r, int e); - - -#endif - - diff --git a/src/c_fl_round_button.cpp b/src/c_fl_round_button.cpp deleted file mode 100644 index b7c2d12..0000000 --- a/src/c_fl_round_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Round_Button.H> -#include "c_fl_round_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Round_Button : public Fl_Round_Button { -public: - using Fl_Round_Button::Fl_Round_Button; - - friend void fl_round_button_draw(ROUNDBUTTON b); - friend int fl_round_button_handle(ROUNDBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Round_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Round_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_round_button_draw(ROUNDBUTTON b) { - reinterpret_cast<My_Round_Button*>(b)->Fl_Round_Button::draw(); -} - -int fl_round_button_handle(ROUNDBUTTON b, int e) { - return reinterpret_cast<My_Round_Button*>(b)->Fl_Round_Button::handle(e); -} - - diff --git a/src/c_fl_round_button.h b/src/c_fl_round_button.h deleted file mode 100644 index cbbaf9f..0000000 --- a/src/c_fl_round_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ROUND_BUTTON_GUARD -#define FL_ROUND_BUTTON_GUARD - - -typedef void* ROUNDBUTTON; - - -extern "C" ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_round_button(ROUNDBUTTON b); - - -extern "C" void fl_round_button_draw(ROUNDBUTTON b); -extern "C" int fl_round_button_handle(ROUNDBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_round_clock.cpp b/src/c_fl_round_clock.cpp deleted file mode 100644 index d2ab087..0000000 --- a/src/c_fl_round_clock.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Round_Clock.H> -#include "c_fl_round_clock.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Round_Clock : public Fl_Round_Clock { -public: - using Fl_Round_Clock::Fl_Round_Clock; - - friend void fl_round_clock_draw(ROUNDCLOCK c); - friend int fl_round_clock_handle(ROUNDCLOCK c, int e); - - void draw(); - int handle(int e); -}; - -void My_Round_Clock::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Round_Clock::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -ROUNDCLOCK 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(ROUNDCLOCK c) { - delete reinterpret_cast<My_Round_Clock*>(c); -} - - - - -void fl_round_clock_draw(ROUNDCLOCK c) { - reinterpret_cast<My_Round_Clock*>(c)->Fl_Round_Clock::draw(); -} - -int fl_round_clock_handle(ROUNDCLOCK c, int e) { - return reinterpret_cast<My_Round_Clock*>(c)->Fl_Round_Clock::handle(e); -} - - diff --git a/src/c_fl_round_clock.h b/src/c_fl_round_clock.h deleted file mode 100644 index 475a5d0..0000000 --- a/src/c_fl_round_clock.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_ROUND_CLOCK_GUARD -#define FL_ROUND_CLOCK_GUARD - - -typedef void* ROUNDCLOCK; - - -extern "C" ROUNDCLOCK new_fl_round_clock(int x, int y, int w, int h, char* label); -extern "C" void free_fl_round_clock(ROUNDCLOCK c); - - -extern "C" void fl_round_clock_draw(ROUNDCLOCK c); -extern "C" int fl_round_clock_handle(ROUNDCLOCK c, int e); - - -#endif - - diff --git a/src/c_fl_screen.cpp b/src/c_fl_screen.cpp deleted file mode 100644 index 88550bd..0000000 --- a/src/c_fl_screen.cpp +++ /dev/null @@ -1,84 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 37f7924..0000000 --- a/src/c_fl_screen.h +++ /dev/null @@ -1,39 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 b3d2c14..0000000 --- a/src/c_fl_scroll.cpp +++ /dev/null @@ -1,108 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Scroll.H> -#include "c_fl_scroll.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Scroll : public Fl_Scroll { -public: - using Fl_Scroll::Fl_Scroll; - - friend void fl_scroll_draw(SCROLL s); - friend int fl_scroll_handle(SCROLL s, int e); - - void draw(); - int handle(int e); -}; - -void My_Scroll::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Scroll::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_hscrollbar(SCROLL s) { - return &static_cast<Fl_Scroll*>(s)->hscrollbar; -} - -void * fl_scroll_scrollbar(SCROLL s) { - return &static_cast<Fl_Scroll*>(s)->scrollbar; -} - - - - -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(); -} - - - - -void fl_scroll_draw(SCROLL s) { - reinterpret_cast<My_Scroll*>(s)->Fl_Scroll::draw(); -} - -int fl_scroll_handle(SCROLL s, int e) { - return reinterpret_cast<My_Scroll*>(s)->Fl_Scroll::handle(e); -} - - diff --git a/src/c_fl_scroll.h b/src/c_fl_scroll.h deleted file mode 100644 index a6f3767..0000000 --- a/src/c_fl_scroll.h +++ /dev/null @@ -1,38 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SCROLL_GUARD -#define FL_SCROLL_GUARD - - -typedef void* SCROLL; - - -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_hscrollbar(SCROLL s); -extern "C" void * fl_scroll_scrollbar(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); - - -extern "C" void fl_scroll_draw(SCROLL s); -extern "C" int fl_scroll_handle(SCROLL s, int e); - - -#endif - - diff --git a/src/c_fl_scrollbar.cpp b/src/c_fl_scrollbar.cpp deleted file mode 100644 index ae20a25..0000000 --- a/src/c_fl_scrollbar.cpp +++ /dev/null @@ -1,105 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Scrollbar.H> -#include "c_fl_scrollbar.h" - - - - -// Telprot stopovers - -extern "C" void scrollbar_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); -void fl_scrollbar_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) { - scrollbar_extra_init_hook(adaobj, x, y, w, h, label); -} - -extern "C" void scrollbar_extra_final_hook(void * aobj); -void fl_scrollbar_extra_final(void * adaobj) { - scrollbar_extra_final_hook(adaobj); -} - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Scrollbar : public Fl_Scrollbar { -public: - using Fl_Scrollbar::Fl_Scrollbar; - - friend void fl_scrollbar_draw(SCROLLBAR s); - friend int fl_scrollbar_handle(SCROLLBAR s, int e); - - void draw(); - int handle(int e); -}; - -void My_Scrollbar::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Scrollbar::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_scrollbar_draw(SCROLLBAR s) { - reinterpret_cast<My_Scrollbar*>(s)->Fl_Scrollbar::draw(); -} - -int fl_scrollbar_handle(SCROLLBAR s, int e) { - return reinterpret_cast<My_Scrollbar*>(s)->Fl_Scrollbar::handle(e); -} - - diff --git a/src/c_fl_scrollbar.h b/src/c_fl_scrollbar.h deleted file mode 100644 index 870f256..0000000 --- a/src/c_fl_scrollbar.h +++ /dev/null @@ -1,36 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SCROLLBAR_GUARD -#define FL_SCROLLBAR_GUARD - - -extern "C" void fl_scrollbar_extra_init - (void * adaobj, int x, int y, int w, int h, const char * label); -extern "C" void fl_scrollbar_extra_final(void * adaobj); - - -typedef void* SCROLLBAR; - - -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); - - -extern "C" void fl_scrollbar_draw(SCROLLBAR s); -extern "C" int fl_scrollbar_handle(SCROLLBAR s, int e); - - -#endif - - diff --git a/src/c_fl_secret_input.cpp b/src/c_fl_secret_input.cpp deleted file mode 100644 index 9bf1753..0000000 --- a/src/c_fl_secret_input.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Secret_Input.H> -#include "c_fl_secret_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Secret_Input : public Fl_Secret_Input { -public: - using Fl_Secret_Input::Fl_Secret_Input; - - friend void fl_secret_input_draw(SECRETINPUT i); - friend int fl_secret_input_handle(SECRETINPUT i, int e); - - void draw(); - int handle(int e); -}; - -void My_Secret_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Secret_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label) { - My_Secret_Input *i = new My_Secret_Input(x, y, w, h, label); - return i; -} - -void free_fl_secret_input(SECRETINPUT i) { - delete reinterpret_cast<My_Secret_Input*>(i); -} - - - - -void fl_secret_input_draw(SECRETINPUT i) { - reinterpret_cast<My_Secret_Input*>(i)->Fl_Secret_Input::draw(); -} - -int fl_secret_input_handle(SECRETINPUT i, int e) { - return reinterpret_cast<My_Secret_Input*>(i)->Fl_Secret_Input::handle(e); -} - - diff --git a/src/c_fl_secret_input.h b/src/c_fl_secret_input.h deleted file mode 100644 index ea171d8..0000000 --- a/src/c_fl_secret_input.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SECRET_INPUT_GUARD -#define FL_SECRET_INPUT_GUARD - - -typedef void* SECRETINPUT; - - -extern "C" SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_secret_input(SECRETINPUT i); - - -extern "C" void fl_secret_input_draw(SECRETINPUT i); -extern "C" int fl_secret_input_handle(SECRETINPUT i, int e); - - -#endif - - diff --git a/src/c_fl_select_browser.cpp b/src/c_fl_select_browser.cpp deleted file mode 100644 index 78e7412..0000000 --- a/src/c_fl_select_browser.cpp +++ /dev/null @@ -1,264 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Select_Browser.H> -#include "c_fl_select_browser.h" - - - - -// Exports from Ada - -extern "C" int browser_full_width_hook(void * b); -extern "C" int browser_full_height_hook(void * b); -extern "C" int browser_incr_height_hook(void * b); -extern "C" int browser_item_quick_height_hook(void * b, void * i); - -extern "C" int browser_item_width_hook(void * b, void * i); -extern "C" int browser_item_height_hook(void * b, void * i); -extern "C" void * browser_item_first_hook(void * b); -extern "C" void * browser_item_last_hook(void * b); -extern "C" void * browser_item_next_hook(void * b, void * i); -extern "C" void * browser_item_prev_hook(void * b, void * i); -extern "C" void * browser_item_at_hook(void * b, int n); -extern "C" void browser_item_select_hook(void * b, void * i, int s); -extern "C" int browser_item_selected_hook(void * b, void * i); -extern "C" void browser_item_swap_hook(void * b, void * one, void * two); -extern "C" const char * browser_item_text_hook(void * b, void * i); -extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Select_Browser : public Fl_Select_Browser { -public: - using Fl_Select_Browser::Fl_Select_Browser; - - friend int fl_select_browser_item_width(SELECTBROWSER b, void * item); - friend int fl_select_browser_item_height(SELECTBROWSER b, void * item); - friend void * fl_select_browser_item_first(SELECTBROWSER b); - friend void * fl_select_browser_item_last(SELECTBROWSER b); - friend void * fl_select_browser_item_next(SELECTBROWSER b, void * item); - friend void * fl_select_browser_item_prev(SELECTBROWSER b, void * item); - friend void * fl_select_browser_item_at(SELECTBROWSER b, int index); - friend void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val); - friend int fl_select_browser_item_selected(SELECTBROWSER b, void * item); - friend void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y); - friend const char * fl_select_browser_item_text(SELECTBROWSER b, void * item); - friend void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h); - - friend int fl_select_browser_full_width(SELECTBROWSER c); - friend int fl_select_browser_full_height(SELECTBROWSER c); - friend int fl_select_browser_incr_height(SELECTBROWSER c); - friend int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i); - - friend void fl_select_browser_draw(SELECTBROWSER b); - - int handle(int e); - -protected: - int full_width() const; - int full_height() const; - int incr_height() const; - int item_quick_height(void * item) const; - - int item_width(void * item) const; - int item_height(void * item) const; - void * item_first() const; - void * item_last() const; - void * item_next(void * item) const; - void * item_prev(void * item) const; - void * item_at(int index) const; - void item_select(void * item, int val=1); - int item_selected(void * item) const; - void item_swap(void * a, void * b); - const char * item_text(void * item) const; - void item_draw(void * item, int x, int y, int w, int h) const; - - void draw(); -}; - - -int My_Select_Browser::full_width() const { - return browser_full_width_hook(this->user_data()); -} - -int My_Select_Browser::full_height() const { - return browser_full_height_hook(this->user_data()); -} - -int My_Select_Browser::incr_height() const { - return browser_incr_height_hook(this->user_data()); -} - -int My_Select_Browser::item_quick_height(void * item) const { - return browser_item_quick_height_hook(this->user_data(), item); -} - - -int My_Select_Browser::item_width(void * item) const { - return browser_item_width_hook(this->user_data(), item); -} - -int My_Select_Browser::item_height(void * item) const { - return browser_item_height_hook(this->user_data(), item); -} - -void * My_Select_Browser::item_first() const { - return browser_item_first_hook(this->user_data()); -} - -void * My_Select_Browser::item_last() const { - return browser_item_last_hook(this->user_data()); -} - -void * My_Select_Browser::item_next(void * item) const { - return browser_item_next_hook(this->user_data(), item); -} - -void * My_Select_Browser::item_prev(void * item) const { - return browser_item_prev_hook(this->user_data(), item); -} - -void * My_Select_Browser::item_at(int index) const { - return browser_item_at_hook(this->user_data(), index); -} - -void My_Select_Browser::item_select(void * item, int val) { - browser_item_select_hook(this->user_data(), item, val); -} - -int My_Select_Browser::item_selected(void * item) const { - return browser_item_selected_hook(this->user_data(), item); -} - -void My_Select_Browser::item_swap(void * a, void * b) { - browser_item_swap_hook(this->user_data(), a, b); -} - -const char * My_Select_Browser::item_text(void * item) const { - return browser_item_text_hook(this->user_data(), item); -} - -void My_Select_Browser::item_draw(void * item, int x, int y, int w, int h) const { - browser_item_draw_hook(this->user_data(), item, x, y, w, h); -} - - -void My_Select_Browser::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Select_Browser::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API begins here - -SELECTBROWSER new_fl_select_browser(int x, int y, int w, int h, char * label) { - My_Select_Browser *b = new My_Select_Browser(x, y, w, h, label); - return b; -} - -void free_fl_select_browser(SELECTBROWSER b) { - delete reinterpret_cast<My_Select_Browser*>(b); -} - - - - -// These have to be reimplemented due to relying on custom class extensions - -int fl_select_browser_full_height(SELECTBROWSER c) { - return reinterpret_cast<My_Select_Browser*>(c)->Fl_Select_Browser::full_height(); -} - -int fl_select_browser_incr_height(SELECTBROWSER c) { - return reinterpret_cast<My_Select_Browser*>(c)->Fl_Select_Browser::incr_height(); -} - - - - -int fl_select_browser_item_width(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_width(item); -} - -int fl_select_browser_item_height(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_height(item); -} - -void * fl_select_browser_item_first(SELECTBROWSER b) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_first(); -} - -void * fl_select_browser_item_last(SELECTBROWSER b) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_last(); -} - -void * fl_select_browser_item_next(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_next(item); -} - -void * fl_select_browser_item_prev(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_prev(item); -} - -void * fl_select_browser_item_at(SELECTBROWSER b, int index) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_at(index); -} - -void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val) { - reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_select(item, val); -} - -int fl_select_browser_item_selected(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_selected(item); -} - -void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y) { - reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_swap(x, y); -} - -const char * fl_select_browser_item_text(SELECTBROWSER b, void * item) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_text(item); -} - -void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h) { - reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_draw(item, x, y, w, h); -} - - - - -int fl_select_browser_full_width(SELECTBROWSER c) { - return reinterpret_cast<My_Select_Browser*>(c)->Fl_Select_Browser::full_width(); -} - -int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i) { - return reinterpret_cast<My_Select_Browser*>(c)->Fl_Select_Browser::item_quick_height(i); -} - - - - -void fl_select_browser_draw(SELECTBROWSER b) { - reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::draw(); -} - -int fl_select_browser_handle(SELECTBROWSER b, int e) { - return reinterpret_cast<My_Select_Browser*>(b)->Fl_Select_Browser::handle(e); -} - - diff --git a/src/c_fl_select_browser.h b/src/c_fl_select_browser.h deleted file mode 100644 index f72b8de..0000000 --- a/src/c_fl_select_browser.h +++ /dev/null @@ -1,48 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SELECT_BROWSER_GUARD -#define FL_SELECT_BROWSER_GUARD - - -typedef void* SELECTBROWSER; - - -extern "C" SELECTBROWSER new_fl_select_browser(int x, int y, int w, int h, char * label); -extern "C" void free_fl_select_browser(SELECTBROWSER b); - - -// reimp below here - -extern "C" int fl_select_browser_full_height(SELECTBROWSER c); -extern "C" int fl_select_browser_incr_height(SELECTBROWSER c); - - -extern "C" int fl_select_browser_item_width(SELECTBROWSER b, void * item); -extern "C" int fl_select_browser_item_height(SELECTBROWSER b, void * item); -extern "C" void * fl_select_browser_item_first(SELECTBROWSER b); -extern "C" void * fl_select_browser_item_last(SELECTBROWSER b); -extern "C" void * fl_select_browser_item_next(SELECTBROWSER b, void * item); -extern "C" void * fl_select_browser_item_prev(SELECTBROWSER b, void * item); -extern "C" void * fl_select_browser_item_at(SELECTBROWSER b, int index); -extern "C" void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val=1); -extern "C" int fl_select_browser_item_selected(SELECTBROWSER b, void * item); -extern "C" void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y); -extern "C" const char * fl_select_browser_item_text(SELECTBROWSER b, void * item); -extern "C" void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h); - - -extern "C" int fl_select_browser_full_width(SELECTBROWSER c); -extern "C" int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i); - - -extern "C" void fl_select_browser_draw(SELECTBROWSER b); -extern "C" int fl_select_browser_handle(SELECTBROWSER b, int e); - - -#endif - - diff --git a/src/c_fl_shared_image.cpp b/src/c_fl_shared_image.cpp deleted file mode 100644 index d3338f6..0000000 --- a/src/c_fl_shared_image.cpp +++ /dev/null @@ -1,100 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 bd5b555..0000000 --- a/src/c_fl_shared_image.h +++ /dev/null @@ -1,47 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 891a371..0000000 --- a/src/c_fl_simple_counter.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Simple_Counter.H> -#include "c_fl_simple_counter.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Simple_Counter : public Fl_Simple_Counter { -public: - using Fl_Simple_Counter::Fl_Simple_Counter; - - friend void fl_simple_counter_draw(SIMPLE_COUNTER c); - friend int fl_simple_counter_handle(SIMPLE_COUNTER c, int e); - - void draw(); - int handle(int e); -}; - -void My_Simple_Counter::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Simple_Counter::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_simple_counter_draw(SIMPLE_COUNTER c) { - reinterpret_cast<My_Simple_Counter*>(c)->Fl_Simple_Counter::draw(); -} - -int fl_simple_counter_handle(SIMPLE_COUNTER c, int e) { - return reinterpret_cast<My_Simple_Counter*>(c)->Fl_Simple_Counter::handle(e); -} - - diff --git a/src/c_fl_simple_counter.h b/src/c_fl_simple_counter.h deleted file mode 100644 index 6c45a89..0000000 --- a/src/c_fl_simple_counter.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SIMPLE_COUNTER_GUARD -#define FL_SIMPLE_COUNTER_GUARD - - -typedef void* SIMPLE_COUNTER; - - -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); - - -extern "C" void fl_simple_counter_draw(SIMPLE_COUNTER c); -extern "C" int fl_simple_counter_handle(SIMPLE_COUNTER c, int e); - - -#endif - - diff --git a/src/c_fl_single_window.cpp b/src/c_fl_single_window.cpp deleted file mode 100644 index 974a3c1..0000000 --- a/src/c_fl_single_window.cpp +++ /dev/null @@ -1,94 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Single_Window.H> -#include "c_fl_single_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Single_Window : public Fl_Single_Window { -public: - using Fl_Single_Window::Fl_Single_Window; - - friend void fl_single_window_draw(SINGLEWINDOW n); - friend int fl_single_window_handle(SINGLEWINDOW n, int e); - - void draw(); - int handle(int e); -}; - -void My_Single_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Single_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_show2(SINGLEWINDOW w, int c, void * v) { - reinterpret_cast<Fl_Single_Window*>(w)->show(c, static_cast<char**>(v)); -} - -void fl_single_window_flush(SINGLEWINDOW w) { - reinterpret_cast<Fl_Single_Window*>(w)->flush(); -} - - - - -void fl_single_window_make_current(SINGLEWINDOW w) { - reinterpret_cast<Fl_Single_Window*>(w)->Fl_Window::make_current(); -} - - - - -void fl_single_window_draw(SINGLEWINDOW n) { - reinterpret_cast<My_Single_Window*>(n)->Fl_Single_Window::draw(); -} - -int fl_single_window_handle(SINGLEWINDOW n, int e) { - return reinterpret_cast<My_Single_Window*>(n)->Fl_Single_Window::handle(e); -} - - diff --git a/src/c_fl_single_window.h b/src/c_fl_single_window.h deleted file mode 100644 index 85e6e29..0000000 --- a/src/c_fl_single_window.h +++ /dev/null @@ -1,33 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SINGLE_WINDOW_GUARD -#define FL_SINGLE_WINDOW_GUARD - - -typedef void* SINGLEWINDOW; - - -extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label); -extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y, 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_show2(SINGLEWINDOW w, int c, void * v); -extern "C" void fl_single_window_flush(SINGLEWINDOW w); - - -extern "C" void fl_single_window_make_current(SINGLEWINDOW w); - - -extern "C" void fl_single_window_draw(SINGLEWINDOW n); -extern "C" int fl_single_window_handle(SINGLEWINDOW n, int e); - - -#endif - - diff --git a/src/c_fl_slider.cpp b/src/c_fl_slider.cpp deleted file mode 100644 index fcdd32d..0000000 --- a/src/c_fl_slider.cpp +++ /dev/null @@ -1,121 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Slider.H> -#include "c_fl_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Slider : Fl_Slider { -public: - // Really only needed for the (int,int,int,int) versions - using Fl_Slider::draw; - using Fl_Slider::handle; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Slider : public Fl_Slider { -public: - using Fl_Slider::Fl_Slider; - - friend void fl_slider_draw(SLIDER s); - friend int fl_slider_handle(SLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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; -} - -SLIDER new_fl_slider2(unsigned char k, int x, int y, int w, int h, char * label) { - My_Slider *s = new My_Slider(k, x, y, w, h, label); - return s; -} - -void free_fl_slider(SLIDER s) { - delete reinterpret_cast<My_Slider*>(s); -} - - - - -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, double 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); -} - - - - -void fl_slider_draw(SLIDER s) { - reinterpret_cast<My_Slider*>(s)->Fl_Slider::draw(); -} - -void fl_slider_draw2(SLIDER s, int x, int y, int w, int h) { - void (Fl_Slider::*mydraw)(int,int,int,int) = &Friend_Slider::draw; - (reinterpret_cast<Fl_Slider*>(s)->*mydraw)(x, y, w, h); -} - -int fl_slider_handle(SLIDER s, int e) { - return reinterpret_cast<My_Slider*>(s)->Fl_Slider::handle(e); -} - -int fl_slider_handle2(SLIDER s, int e, int x, int y, int w, int h) { - int (Fl_Slider::*myhandle)(int,int,int,int,int) = &Friend_Slider::handle; - return (reinterpret_cast<Fl_Slider*>(s)->*myhandle)(e, x, y, w, h); -} - - diff --git a/src/c_fl_slider.h b/src/c_fl_slider.h deleted file mode 100644 index 63c6ac3..0000000 --- a/src/c_fl_slider.h +++ /dev/null @@ -1,35 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SLIDER_GUARD -#define FL_SLIDER_GUARD - - -typedef void* SLIDER; - - -extern "C" SLIDER new_fl_slider(int x, int y, int w, int h, char* label); -extern "C" SLIDER new_fl_slider2(unsigned char k, int x, int y, int w, int h, char * label); -extern "C" void free_fl_slider(SLIDER s); - - -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, double t); -extern "C" int fl_slider_scrollvalue(SLIDER s, int p, int z, int f, int t); - - -extern "C" void fl_slider_draw(SLIDER s); -extern "C" void fl_slider_draw2(SLIDER s, int x, int y, int w, int h); -extern "C" int fl_slider_handle(SLIDER s, int e); -extern "C" int fl_slider_handle2(SLIDER s, int e, int x, int y, int w, int h); - - -#endif - - diff --git a/src/c_fl_spinner.cpp b/src/c_fl_spinner.cpp deleted file mode 100644 index 71d86f8..0000000 --- a/src/c_fl_spinner.cpp +++ /dev/null @@ -1,175 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Spinner.H> -#include "c_fl_spinner.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all hooks and friends - -class My_Spinner : public Fl_Spinner { -public: - using Fl_Spinner::Fl_Spinner; - - friend void fl_spinner_draw(SPINNER n); - friend int fl_spinner_handle(SPINNER n, int e); - - void draw(); - int handle(int e); -}; - -void My_Spinner::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Spinner::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - -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); -} - - - - -const char * fl_spinner_get_format(SPINNER n) { - return reinterpret_cast<Fl_Spinner*>(n)->format(); -} - -void fl_spinner_set_format(SPINNER n, const char * f) { - reinterpret_cast<Fl_Spinner*>(n)->format(f); -} - -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); -} - - - - -void fl_spinner_resize(SPINNER n, int x, int y, int w, int h) { - reinterpret_cast<Fl_Spinner*>(n)->resize(x, y, w, h); -} - - - - -void fl_spinner_draw(SPINNER n) { - reinterpret_cast<My_Spinner*>(n)->Fl_Spinner::draw(); -} - -int fl_spinner_handle(SPINNER n, int e) { - return reinterpret_cast<My_Spinner*>(n)->Fl_Spinner::handle(e); -} - - diff --git a/src/c_fl_spinner.h b/src/c_fl_spinner.h deleted file mode 100644 index d92e6e1..0000000 --- a/src/c_fl_spinner.h +++ /dev/null @@ -1,56 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SPINNER_GUARD -#define FL_SPINNER_GUARD - - -typedef void* SPINNER; - - -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" double fl_spinner_get_value(SPINNER n); -extern "C" void fl_spinner_set_value(SPINNER n, double t); - - -extern "C" const char * fl_spinner_get_format(SPINNER n); -extern "C" void fl_spinner_set_format(SPINNER n, const char * f); -extern "C" int fl_spinner_get_type(SPINNER n); -extern "C" void fl_spinner_set_type(SPINNER n, int t); - - -extern "C" void fl_spinner_resize(SPINNER n, int x, int y, int w, int h); - - -extern "C" void fl_spinner_draw(SPINNER n); -extern "C" int fl_spinner_handle(SPINNER n, int e); - - -#endif - - diff --git a/src/c_fl_static.cpp b/src/c_fl_static.cpp deleted file mode 100644 index 9639364..0000000 --- a/src/c_fl_static.cpp +++ /dev/null @@ -1,303 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 f357494..0000000 --- a/src/c_fl_static.h +++ /dev/null @@ -1,108 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_device.cpp b/src/c_fl_surface_device.cpp deleted file mode 100644 index 50088cf..0000000 --- a/src/c_fl_surface_device.cpp +++ /dev/null @@ -1,58 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Device.H> -#include "c_fl_surface_device.h" - - - - -// Adding relevant friends - -class My_Surface_Device : public Fl_Surface_Device { -public: - using Fl_Surface_Device::Fl_Surface_Device; - friend SURFACEDEVICE new_fl_surface_device(void * g); -}; - - - - -// Flattened C API - -SURFACEDEVICE new_fl_surface_device(void * g) { - My_Surface_Device *s = new My_Surface_Device(reinterpret_cast<Fl_Graphics_Driver*>(g)); - return s; -} - -void free_fl_surface_device(SURFACEDEVICE s) { - delete reinterpret_cast<My_Surface_Device*>(s); -} - - - - -void fl_surface_device_set_current(SURFACEDEVICE s) { - // virtual so disable dispatch - reinterpret_cast<Fl_Surface_Device*>(s)->Fl_Surface_Device::set_current(); -} - -SURFACEDEVICE fl_surface_device_get_surface(void) { - return Fl_Surface_Device::surface(); -} - - - - -void * fl_surface_device_get_driver(SURFACEDEVICE s) { - return reinterpret_cast<Fl_Surface_Device*>(s)->driver(); -} - -void fl_surface_device_set_driver(SURFACEDEVICE s, void * g) { - reinterpret_cast<Fl_Surface_Device*>(s)->driver(reinterpret_cast<Fl_Graphics_Driver*>(g)); -} - - diff --git a/src/c_fl_surface_device.h b/src/c_fl_surface_device.h deleted file mode 100644 index 97096c6..0000000 --- a/src/c_fl_surface_device.h +++ /dev/null @@ -1,28 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SURFACE_DEVICE_GUARD -#define FL_SURFACE_DEVICE_GUARD - - -typedef void* SURFACEDEVICE; - - -extern "C" SURFACEDEVICE new_fl_surface_device(void * g); -extern "C" void free_fl_surface_device(SURFACEDEVICE s); - - -extern "C" void fl_surface_device_set_current(SURFACEDEVICE s); -extern "C" SURFACEDEVICE fl_surface_device_get_surface(void); - - -extern "C" void * fl_surface_device_get_driver(SURFACEDEVICE s); -extern "C" void fl_surface_device_set_driver(SURFACEDEVICE s, void * g); - - -#endif - - diff --git a/src/c_fl_tabs.cpp b/src/c_fl_tabs.cpp deleted file mode 100644 index a3e8581..0000000 --- a/src/c_fl_tabs.cpp +++ /dev/null @@ -1,111 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Tabs.H> -#include "c_fl_tabs.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Tabs : Fl_Tabs { -public: - using Fl_Tabs::redraw_tabs; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Tabs : public Fl_Tabs { -public: - using Fl_Tabs::Fl_Tabs; - - friend void fl_tabs_draw(TABS t); - friend int fl_tabs_handle(TABS t, int e); - - void draw(); - int handle(int e); -}; - -void My_Tabs::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Tabs::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_tabs_draw(TABS t) { - reinterpret_cast<My_Tabs*>(t)->Fl_Tabs::draw(); -} - -void fl_tabs_redraw_tabs(TABS t) { - (reinterpret_cast<Fl_Tabs*>(t)->*(&Friend_Tabs::redraw_tabs))(); -} - -int fl_tabs_handle(TABS t, int e) { - return reinterpret_cast<My_Tabs*>(t)->Fl_Tabs::handle(e); -} - - diff --git a/src/c_fl_tabs.h b/src/c_fl_tabs.h deleted file mode 100644 index 3226b2d..0000000 --- a/src/c_fl_tabs.h +++ /dev/null @@ -1,35 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TABS_GUARD -#define FL_TABS_GUARD - - -typedef void* TABS; - - -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); - - -extern "C" void fl_tabs_draw(TABS t); -extern "C" void fl_tabs_redraw_tabs(TABS t); -extern "C" int fl_tabs_handle(TABS t, int e); - - -#endif - - diff --git a/src/c_fl_text_buffer.cpp b/src/c_fl_text_buffer.cpp deleted file mode 100644 index 7efb0a3..0000000 --- a/src/c_fl_text_buffer.cpp +++ /dev/null @@ -1,294 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Text_Buffer.H> -#include "c_fl_text_buffer.h" - - - - -class My_Text_Buffer : public Fl_Text_Buffer { - public: - using Fl_Text_Buffer::Fl_Text_Buffer; - int reference_count = 0; -}; - - - - -TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { - My_Text_Buffer *tb = new My_Text_Buffer(rs, pgs); - return tb; -} - -void upref_fl_text_buffer(TEXTBUFFER tb) { - reinterpret_cast<My_Text_Buffer*>(tb)->reference_count += 1; -} - -void free_fl_text_buffer(TEXTBUFFER tb) { - if (reinterpret_cast<My_Text_Buffer*>(tb)->reference_count <= 0) { - delete reinterpret_cast<My_Text_Buffer*>(tb); - } else { - reinterpret_cast<My_Text_Buffer*>(tb)->reference_count -= 1; - } -} - - - - -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 1e55bc1..0000000 --- a/src/c_fl_text_buffer.h +++ /dev/null @@ -1,101 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 upref_fl_text_buffer(TEXTBUFFER tb); -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 7323049..0000000 --- a/src/c_fl_text_display.cpp +++ /dev/null @@ -1,339 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Text_Display.H> -#include <FL/Fl_Text_Buffer.H> -#include "c_fl_text_display.h" -#include "c_fl_text_buffer.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Text_Display : public Fl_Text_Display { -public: - using Fl_Text_Display::Fl_Text_Display; - - friend void fl_text_display_draw(TEXTDISPLAY td); - friend int fl_text_display_handle(TEXTDISPLAY td, int e); - - void draw(); - int handle(int e); -}; - -void My_Text_Display::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Text_Display::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_text_display_draw(TEXTDISPLAY td) { - reinterpret_cast<My_Text_Display*>(td)->Fl_Text_Display::draw(); -} - -int fl_text_display_handle(TEXTDISPLAY td, int e) { - return reinterpret_cast<My_Text_Display*>(td)->Fl_Text_Display::handle(e); -} - - diff --git a/src/c_fl_text_display.h b/src/c_fl_text_display.h deleted file mode 100644 index ece9a6a..0000000 --- a/src/c_fl_text_display.h +++ /dev/null @@ -1,107 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TEXT_DISPLAY_GUARD -#define FL_TEXT_DISPLAY_GUARD - -#include "c_fl_text_buffer.h" - - -typedef void* TEXTDISPLAY; - - -extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_display(TEXTDISPLAY td); - - -extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); -extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); - - -extern "C" 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); - - -extern "C" void fl_text_display_draw(TEXTDISPLAY td); -extern "C" int fl_text_display_handle(TEXTDISPLAY td, int e); - - -#endif - - diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp deleted file mode 100644 index b7e3f3e..0000000 --- a/src/c_fl_text_editor.cpp +++ /dev/null @@ -1,311 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Text_Editor.H> -#include "c_fl_text_editor.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Text_Editor : public Fl_Text_Editor { -public: - using Fl_Text_Editor::Fl_Text_Editor; - - friend void fl_text_editor_draw(TEXTEDITOR te); - friend int fl_text_editor_handle(TEXTEDITOR te, int e); - - void draw(); - int handle(int e); -}; - -void My_Text_Editor::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Text_Editor::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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) { -#if FLTK_ABI_VERSION >= 10304 - return reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(); -#else - (void)(te); - return 0; -#endif -} - -void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t) { -#if FLTK_ABI_VERSION >= 10304 - reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(t); -#else - (void)(te); - (void)(t); -#endif -} - - - - -void fl_text_editor_draw(TEXTEDITOR te) { - reinterpret_cast<My_Text_Editor*>(te)->Fl_Text_Editor::draw(); -} - -int fl_text_editor_handle(TEXTEDITOR te, int e) { - return reinterpret_cast<My_Text_Editor*>(te)->Fl_Text_Editor::handle(e); -} - - diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h deleted file mode 100644 index e25922f..0000000 --- a/src/c_fl_text_editor.h +++ /dev/null @@ -1,95 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TEXT_EDITOR_GUARD -#define FL_TEXT_EDITOR_GUARD - - -typedef void* TEXTEDITOR; - - -extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_editor(TEXTEDITOR te); - - -extern "C" void fl_text_editor_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); - - -extern "C" void fl_text_editor_draw(TEXTEDITOR te); -extern "C" int fl_text_editor_handle(TEXTEDITOR te, int e); - - -#endif - - diff --git a/src/c_fl_tile.cpp b/src/c_fl_tile.cpp deleted file mode 100644 index 2708d55..0000000 --- a/src/c_fl_tile.cpp +++ /dev/null @@ -1,78 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Tile.H> -#include "c_fl_tile.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Tile : public Fl_Tile { -public: - using Fl_Tile::Fl_Tile; - - friend void fl_tile_draw(TILE n); - friend int fl_tile_handle(TILE n, int e); - - void draw(); - int handle(int e); -}; - -void My_Tile::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Tile::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - -void fl_tile_resize(TILE t, int x, int y, int w, int h) { - reinterpret_cast<Fl_Tile*>(t)->resize(x, y, w, h); -} - - - - -void fl_tile_draw(TILE n) { - reinterpret_cast<My_Tile*>(n)->Fl_Tile::draw(); -} - -int fl_tile_handle(TILE n, int e) { - return reinterpret_cast<My_Tile*>(n)->Fl_Tile::handle(e); -} - - diff --git a/src/c_fl_tile.h b/src/c_fl_tile.h deleted file mode 100644 index 3254558..0000000 --- a/src/c_fl_tile.h +++ /dev/null @@ -1,28 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TILE_GUARD -#define FL_TILE_GUARD - - -typedef void* TILE; - - -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); -extern "C" void fl_tile_resize(TILE t, int x, int y, int w, int h); - - -extern "C" void fl_tile_draw(TILE n); -extern "C" int fl_tile_handle(TILE n, int e); - - -#endif - - diff --git a/src/c_fl_tiled_image.cpp b/src/c_fl_tiled_image.cpp deleted file mode 100644 index 7cae644..0000000 --- a/src/c_fl_tiled_image.cpp +++ /dev/null @@ -1,64 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 95d202b..0000000 --- a/src/c_fl_tiled_image.h +++ /dev/null @@ -1,38 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 631fc21..0000000 --- a/src/c_fl_toggle_button.cpp +++ /dev/null @@ -1,67 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Toggle_Button.H> -#include "c_fl_toggle_button.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Toggle_Button : public Fl_Toggle_Button { -public: - using Fl_Toggle_Button::Fl_Toggle_Button; - - friend void fl_toggle_button_draw(TOGGLEBUTTON b); - friend int fl_toggle_button_handle(TOGGLEBUTTON b, int e); - - void draw(); - int handle(int e); -}; - -void My_Toggle_Button::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Toggle_Button::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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); -} - - - - -void fl_toggle_button_draw(TOGGLEBUTTON b) { - reinterpret_cast<My_Toggle_Button*>(b)->Fl_Toggle_Button::draw(); -} - -int fl_toggle_button_handle(TOGGLEBUTTON b, int e) { - return reinterpret_cast<My_Toggle_Button*>(b)->Fl_Toggle_Button::handle(e); -} - - diff --git a/src/c_fl_toggle_button.h b/src/c_fl_toggle_button.h deleted file mode 100644 index bdb86b1..0000000 --- a/src/c_fl_toggle_button.h +++ /dev/null @@ -1,24 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_TOGGLE_BUTTON_GUARD -#define FL_TOGGLE_BUTTON_GUARD - - -typedef void* TOGGLEBUTTON; - - -extern "C" TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_toggle_button(TOGGLEBUTTON b); - - -extern "C" void fl_toggle_button_draw(TOGGLEBUTTON b); -extern "C" int fl_toggle_button_handle(TOGGLEBUTTON b, int e); - - -#endif - - diff --git a/src/c_fl_tooltip.cpp b/src/c_fl_tooltip.cpp deleted file mode 100644 index 768b357..0000000 --- a/src/c_fl_tooltip.cpp +++ /dev/null @@ -1,131 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_disable() { - Fl_Tooltip::disable(); -} - -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) { -#if FLTK_ABI_VERSION >= 10301 - Fl_Tooltip::margin_height(v); -#else - (void)(v); -#endif -} - -int fl_tooltip_get_margin_width(void) { - return Fl_Tooltip::margin_width(); -} - -void fl_tooltip_set_margin_width(int v) { -#if FLTK_ABI_VERSION >= 10301 - Fl_Tooltip::margin_width(v); -#else - (void)(v); -#endif -} - -int fl_tooltip_get_wrap_width(void) { - return Fl_Tooltip::wrap_width(); -} - -void fl_tooltip_set_wrap_width(int v) { -#if FLTK_ABI_VERSION >= 10301 - Fl_Tooltip::wrap_width(v); -#else - (void)(v); -#endif -} - - - - -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 055a11f..0000000 --- a/src/c_fl_tooltip.h +++ /dev/null @@ -1,45 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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_disable(); -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_valuator.cpp b/src/c_fl_valuator.cpp deleted file mode 100644 index f70e6dd..0000000 --- a/src/c_fl_valuator.cpp +++ /dev/null @@ -1,156 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Valuator.H> -#include "c_fl_valuator.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Valuator : Fl_Valuator { -public: - using Fl_Valuator::value_damage; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Valuator : public Fl_Valuator { -public: - using Fl_Valuator::Fl_Valuator; - friend VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label); - - friend void fl_valuator_draw(VALUATOR v); - friend int fl_valuator_handle(VALUATOR v, int e); - - void draw(); - int handle(int e); -}; - -void My_Valuator::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Valuator::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_top(VALUATOR v, double t) { - reinterpret_cast<Fl_Valuator*>(v)->step(t); -} - -void fl_valuator_set_step_bottom(VALUATOR v, int b) { - reinterpret_cast<Fl_Valuator*>(v)->step(b); -} - -void fl_valuator_set_step(VALUATOR v, double t, int b) { - reinterpret_cast<Fl_Valuator*>(v)->step(t, b); -} - -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); -} - - - - -void fl_valuator_value_damage(VALUATOR v) { - (reinterpret_cast<Fl_Valuator*>(v)->*(&Friend_Valuator::value_damage))(); -} - -void fl_valuator_draw(VALUATOR v) { - // The Fl_Valuator draw method doesn't technically exist, so... - (void)(v); - // It is more convenient for this function to exist, however, - // even though it will likely never be called, because it simplifies - // and makes uniform the implementation of the Ada Valuator Draw subprogram. -} - -int fl_valuator_handle(VALUATOR v, int e) { - return reinterpret_cast<My_Valuator*>(v)->Fl_Valuator::handle(e); -} - - diff --git a/src/c_fl_valuator.h b/src/c_fl_valuator.h deleted file mode 100644 index e3c6959..0000000 --- a/src/c_fl_valuator.h +++ /dev/null @@ -1,45 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_VALUATOR_GUARD -#define FL_VALUATOR_GUARD - - -typedef void* VALUATOR; - - -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_top(VALUATOR v, double t); -extern "C" void fl_valuator_set_step_bottom(VALUATOR v, int b); -extern "C" void fl_valuator_set_step(VALUATOR v, double t, int b); -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); - - -extern "C" void fl_valuator_value_damage(VALUATOR v); -extern "C" void fl_valuator_draw(VALUATOR v); -extern "C" int fl_valuator_handle(VALUATOR v, int e); - - -#endif - - diff --git a/src/c_fl_value_input.cpp b/src/c_fl_value_input.cpp deleted file mode 100644 index 37273a7..0000000 --- a/src/c_fl_value_input.cpp +++ /dev/null @@ -1,141 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Value_Input.H> -#include "c_fl_value_input.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Value_Input : public Fl_Value_Input { -public: - using Fl_Value_Input::Fl_Value_Input; - - friend void fl_value_input_draw(VALUEINPUT a); - friend int fl_value_input_handle(VALUEINPUT a, int e); - - void draw(); - int handle(int e); -}; - -void My_Value_Input::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Value_Input::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -VALUEINPUT 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(VALUEINPUT a) { - delete reinterpret_cast<My_Value_Input*>(a); -} - - - - -void * fl_value_input_get_input(VALUEINPUT v) { - return &(reinterpret_cast<Fl_Value_Input*>(v)->input); -} - - - - -unsigned int fl_value_input_get_cursor_color(VALUEINPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->cursor_color(); -} - -void fl_value_input_set_cursor_color(VALUEINPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Input*>(v)->cursor_color(c); -} - - - - -int fl_value_input_get_shortcut(VALUEINPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut(); -} - -void fl_value_input_set_shortcut(VALUEINPUT v, int k) { - reinterpret_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut(k); -} - - - - -int fl_value_input_is_soft(VALUEINPUT a) { - return reinterpret_cast<Fl_Value_Input*>(a)->soft(); -} - -void fl_value_input_set_soft(VALUEINPUT a, int t) { - reinterpret_cast<Fl_Value_Input*>(a)->soft(t); -} - - - - -unsigned int fl_value_input_get_text_color(VALUEINPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textcolor(); -} - -void fl_value_input_set_text_color(VALUEINPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Input*>(v)->textcolor(static_cast<Fl_Color>(c)); -} - -int fl_value_input_get_text_font(VALUEINPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textfont(); -} - -void fl_value_input_set_text_font(VALUEINPUT v, int f) { - reinterpret_cast<Fl_Value_Input*>(v)->textfont(static_cast<Fl_Font>(f)); -} - -int fl_value_input_get_text_size(VALUEINPUT v) { - return reinterpret_cast<Fl_Value_Input*>(v)->textsize(); -} - -void fl_value_input_set_text_size(VALUEINPUT v, int s) { - reinterpret_cast<Fl_Value_Input*>(v)->textsize(static_cast<Fl_Fontsize>(s)); -} - - - - -void fl_value_input_resize(VALUEINPUT v, int x, int y, int w, int h) { - reinterpret_cast<Fl_Value_Input*>(v)->resize(x, y, w, h); -} - - - - -void fl_value_input_draw(VALUEINPUT a) { - reinterpret_cast<My_Value_Input*>(a)->Fl_Value_Input::draw(); -} - -int fl_value_input_handle(VALUEINPUT a, int e) { - return reinterpret_cast<My_Value_Input*>(a)->Fl_Value_Input::handle(e); -} - - diff --git a/src/c_fl_value_input.h b/src/c_fl_value_input.h deleted file mode 100644 index f9eeff2..0000000 --- a/src/c_fl_value_input.h +++ /dev/null @@ -1,50 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_VALUE_INPUT_GUARD -#define FL_VALUE_INPUT_GUARD - - -typedef void* VALUEINPUT; - - -extern "C" VALUEINPUT new_fl_value_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_input(VALUEINPUT a); - - -extern "C" void * fl_value_input_get_input(VALUEINPUT v); - - -extern "C" unsigned int fl_value_input_get_cursor_color(VALUEINPUT v); -extern "C" void fl_value_input_set_cursor_color(VALUEINPUT v, unsigned int c); - - -extern "C" int fl_value_input_get_shortcut(VALUEINPUT v); -extern "C" void fl_value_input_set_shortcut(VALUEINPUT v, int k); - - -extern "C" int fl_value_input_is_soft(VALUEINPUT a); -extern "C" void fl_value_input_set_soft(VALUEINPUT a, int t); - - -extern "C" unsigned int fl_value_input_get_text_color(VALUEINPUT v); -extern "C" void fl_value_input_set_text_color(VALUEINPUT v, unsigned int c); -extern "C" int fl_value_input_get_text_font(VALUEINPUT v); -extern "C" void fl_value_input_set_text_font(VALUEINPUT v, int f); -extern "C" int fl_value_input_get_text_size(VALUEINPUT v); -extern "C" void fl_value_input_set_text_size(VALUEINPUT v, int s); - - -extern "C" void fl_value_input_resize(VALUEINPUT v, int x, int y, int w, int h); - - -extern "C" void fl_value_input_draw(VALUEINPUT a); -extern "C" int fl_value_input_handle(VALUEINPUT a, int e); - - -#endif - - diff --git a/src/c_fl_value_output.cpp b/src/c_fl_value_output.cpp deleted file mode 100644 index b7cc1d6..0000000 --- a/src/c_fl_value_output.cpp +++ /dev/null @@ -1,105 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Value_Output.H> -#include "c_fl_value_output.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Value_Output : public Fl_Value_Output { -public: - using Fl_Value_Output::Fl_Value_Output; - - friend void fl_value_output_draw(VALUEOUTPUT a); - friend int fl_value_output_handle(VALUEOUTPUT a, int e); - - void draw(); - int handle(int e); -}; - -void My_Value_Output::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Value_Output::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -VALUEOUTPUT 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(VALUEOUTPUT a) { - delete reinterpret_cast<My_Value_Output*>(a); -} - - - - -int fl_value_output_is_soft(VALUEOUTPUT a) { - return reinterpret_cast<Fl_Value_Output*>(a)->soft(); -} - -void fl_value_output_set_soft(VALUEOUTPUT a, int t) { - reinterpret_cast<Fl_Value_Output*>(a)->soft(t); -} - - - - -unsigned int fl_value_output_get_text_color(VALUEOUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textcolor(); -} - -void fl_value_output_set_text_color(VALUEOUTPUT v, unsigned int c) { - reinterpret_cast<Fl_Value_Output*>(v)->textcolor(static_cast<Fl_Color>(c)); -} - -int fl_value_output_get_text_font(VALUEOUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textfont(); -} - -void fl_value_output_set_text_font(VALUEOUTPUT v, int f) { - reinterpret_cast<Fl_Value_Output*>(v)->textfont(static_cast<Fl_Font>(f)); -} - -int fl_value_output_get_text_size(VALUEOUTPUT v) { - return reinterpret_cast<Fl_Value_Output*>(v)->textsize(); -} - -void fl_value_output_set_text_size(VALUEOUTPUT v, int s) { - reinterpret_cast<Fl_Value_Output*>(v)->textsize(static_cast<Fl_Fontsize>(s)); -} - - - - -void fl_value_output_draw(VALUEOUTPUT a) { - reinterpret_cast<My_Value_Output*>(a)->Fl_Value_Output::draw(); -} - -int fl_value_output_handle(VALUEOUTPUT a, int e) { - return reinterpret_cast<My_Value_Output*>(a)->Fl_Value_Output::handle(e); -} - - diff --git a/src/c_fl_value_output.h b/src/c_fl_value_output.h deleted file mode 100644 index e333ff8..0000000 --- a/src/c_fl_value_output.h +++ /dev/null @@ -1,36 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_VALUE_OUTPUT_GUARD -#define FL_VALUE_OUTPUT_GUARD - - -typedef void* VALUEOUTPUT; - - -extern "C" VALUEOUTPUT new_fl_value_output(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_output(VALUEOUTPUT a); - - -extern "C" int fl_value_output_is_soft(VALUEOUTPUT a); -extern "C" void fl_value_output_set_soft(VALUEOUTPUT a, int t); - - -extern "C" unsigned int fl_value_output_get_text_color(VALUEOUTPUT v); -extern "C" void fl_value_output_set_text_color(VALUEOUTPUT v, unsigned int c); -extern "C" int fl_value_output_get_text_font(VALUEOUTPUT v); -extern "C" void fl_value_output_set_text_font(VALUEOUTPUT v, int f); -extern "C" int fl_value_output_get_text_size(VALUEOUTPUT v); -extern "C" void fl_value_output_set_text_size(VALUEOUTPUT v, int s); - - -extern "C" void fl_value_output_draw(VALUEOUTPUT a); -extern "C" int fl_value_output_handle(VALUEOUTPUT a, int e); - - -#endif - - diff --git a/src/c_fl_value_slider.cpp b/src/c_fl_value_slider.cpp deleted file mode 100644 index b79d7f5..0000000 --- a/src/c_fl_value_slider.cpp +++ /dev/null @@ -1,94 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Value_Slider.H> -#include "c_fl_value_slider.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Value_Slider : public Fl_Value_Slider { -public: - using Fl_Value_Slider::Fl_Value_Slider; - - friend void fl_value_slider_draw(VALUESLIDER s); - friend int fl_value_slider_handle(VALUESLIDER s, int e); - - void draw(); - int handle(int e); -}; - -void My_Value_Slider::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Value_Slider::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -VALUESLIDER 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(VALUESLIDER s) { - delete reinterpret_cast<My_Value_Slider*>(s); -} - - - - -unsigned int fl_value_slider_get_textcolor(VALUESLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textcolor(); -} - -void fl_value_slider_set_textcolor(VALUESLIDER s, unsigned int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textcolor(t); -} - -int fl_value_slider_get_textfont(VALUESLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textfont(); -} - -void fl_value_slider_set_textfont(VALUESLIDER s, int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textfont(t); -} - -int fl_value_slider_get_textsize(VALUESLIDER s) { - return reinterpret_cast<Fl_Value_Slider*>(s)->textsize(); -} - -void fl_value_slider_set_textsize(VALUESLIDER s, int t) { - reinterpret_cast<Fl_Value_Slider*>(s)->textsize(t); -} - - - - -void fl_value_slider_draw(VALUESLIDER s) { - reinterpret_cast<My_Value_Slider*>(s)->Fl_Value_Slider::draw(); -} - -int fl_value_slider_handle(VALUESLIDER s, int e) { - return reinterpret_cast<My_Value_Slider*>(s)->Fl_Value_Slider::handle(e); -} - - diff --git a/src/c_fl_value_slider.h b/src/c_fl_value_slider.h deleted file mode 100644 index b07a827..0000000 --- a/src/c_fl_value_slider.h +++ /dev/null @@ -1,32 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_VALUE_SLIDER_GUARD -#define FL_VALUE_SLIDER_GUARD - - -typedef void* VALUESLIDER; - - -extern "C" VALUESLIDER new_fl_value_slider(int x, int y, int w, int h, char* label); -extern "C" void free_fl_value_slider(VALUESLIDER s); - - -extern "C" unsigned int fl_value_slider_get_textcolor(VALUESLIDER s); -extern "C" void fl_value_slider_set_textcolor(VALUESLIDER s, unsigned int t); -extern "C" int fl_value_slider_get_textfont(VALUESLIDER s); -extern "C" void fl_value_slider_set_textfont(VALUESLIDER s, int t); -extern "C" int fl_value_slider_get_textsize(VALUESLIDER s); -extern "C" void fl_value_slider_set_textsize(VALUESLIDER s, int t); - - -extern "C" void fl_value_slider_draw(VALUESLIDER s); -extern "C" int fl_value_slider_handle(VALUESLIDER s, int e); - - -#endif - - diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp deleted file mode 100644 index db7312d..0000000 --- a/src/c_fl_widget.cpp +++ /dev/null @@ -1,400 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Widget.H> -#include <FL/Fl_Image.H> -#include "c_fl_widget.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Non-friend protected access - -class Friend_Widget : Fl_Widget { -public: - // probably expand this later when doing a pass for protected methods - using Fl_Widget::draw_box; -}; - - - - -// Attaching all relevant hooks and friends - -class My_Widget : public Fl_Widget { -public: - using Fl_Widget::Fl_Widget; - friend WIDGET new_fl_widget(int x, int y, int w, int h, char* label); - - friend void fl_widget_draw(WIDGET w); - friend int fl_widget_handle(WIDGET w, int e); - - void draw(); - int handle(int e); -}; - -void My_Widget::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Widget::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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)); -} - - - - -unsigned char fl_widget_get_type(WIDGET w) { - return reinterpret_cast<Fl_Widget*>(w)->type(); -} - -void fl_widget_set_type(WIDGET w, unsigned char t) { - reinterpret_cast<Fl_Widget*>(w)->type(t); -} - - - - -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(WIDGET w) { - // The Fl_Widget draw method doesn't technically exist, so... - (void)(w); - // It is more convenient for this function to exist, however, - // even though it will likely never be called, because it simplifies - // and makes uniform the implementation of the Ada Widget Draw subprogram. -} - -void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a) { - reinterpret_cast<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(); -} - -int fl_widget_handle(WIDGET w, int e) { - return reinterpret_cast<My_Widget*>(w)->Fl_Widget::handle(e); -} - - diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h deleted file mode 100644 index 9634ba4..0000000 --- a/src/c_fl_widget.h +++ /dev/null @@ -1,116 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_WIDGET_GUARD -#define FL_WIDGET_GUARD - - -typedef void* WIDGET; - - -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" unsigned char fl_widget_get_type(WIDGET w); -extern "C" void fl_widget_set_type(WIDGET w, unsigned char t); - - -extern "C" int fl_widget_damage(WIDGET w); -extern "C" void fl_widget_set_damage(WIDGET w, int t); -extern "C" void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h); -extern "C" void fl_widget_draw(WIDGET w); -extern "C" void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a); -extern "C" void fl_widget_redraw(WIDGET w); -extern "C" void fl_widget_redraw_label(WIDGET w); -extern "C" int fl_widget_handle(WIDGET w, int e); - - -#endif - - diff --git a/src/c_fl_window.cpp b/src/c_fl_window.cpp deleted file mode 100644 index 631c98b..0000000 --- a/src/c_fl_window.cpp +++ /dev/null @@ -1,249 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Window.H> -#include <FL/Fl_RGB_Image.H> -#include "c_fl_window.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Window : public Fl_Window { -public: - using Fl_Window::Fl_Window; - - friend void fl_window_draw(WINDOW n); - friend int fl_window_handle(WINDOW n, int e); - - void draw(); - int handle(int e); -}; - -void My_Window::draw() { - widget_draw_hook(this->user_data()); -} - -int My_Window::handle(int e) { - return widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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_show2(WINDOW n, int c, void * v) { - reinterpret_cast<Fl_Window*>(n)->show(c, static_cast<char**>(v)); -} - -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(); -} - - - - -void fl_window_draw(WINDOW n) { - reinterpret_cast<My_Window*>(n)->Fl_Window::draw(); -} - -int fl_window_handle(WINDOW n, int e) { - return reinterpret_cast<My_Window*>(n)->Fl_Window::handle(e); -} - - diff --git a/src/c_fl_window.h b/src/c_fl_window.h deleted file mode 100644 index ed6ebdd..0000000 --- a/src/c_fl_window.h +++ /dev/null @@ -1,76 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_WINDOW_GUARD -#define FL_WINDOW_GUARD - - -typedef void* WINDOW; - - -extern "C" WINDOW new_fl_window(int x, int y, int w, int h, char* label); -extern "C" WINDOW new_fl_window2(int w, int h, char* label); -extern "C" void free_fl_window(WINDOW n); - - -extern "C" void fl_window_show(WINDOW n); -extern "C" void fl_window_show2(WINDOW n, int c, void * v); -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); - - -extern "C" void fl_window_draw(WINDOW n); -extern "C" int fl_window_handle(WINDOW n, int e); - - -#endif - - diff --git a/src/c_fl_wizard.cpp b/src/c_fl_wizard.cpp deleted file mode 100644 index d826ca6..0000000 --- a/src/c_fl_wizard.cpp +++ /dev/null @@ -1,106 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include <FL/Fl_Wizard.H> -#include "c_fl_wizard.h" - - - - -// Exports from Ada - -extern "C" void widget_draw_hook(void * ud); -extern "C" int widget_handle_hook(void * ud, int e); - - - - -// Attaching all relevant hooks and friends - -class My_Wizard : public Fl_Wizard { -public: - using Fl_Wizard::Fl_Wizard; - - friend void fl_wizard_draw(WIZARD w); - friend int fl_wizard_handle(WIZARD w, int e); - - void draw(); - void real_draw(); - int handle(int e); -}; - -void My_Wizard::draw() { - widget_draw_hook(this->user_data()); -} - -void My_Wizard::real_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 widget_handle_hook(this->user_data(), e); -} - - - - -// Flattened C API - -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)); -} - - - - -void fl_wizard_draw(WIZARD w) { - reinterpret_cast<My_Wizard*>(w)->real_draw(); -} - -int fl_wizard_handle(WIZARD w, int e) { - return reinterpret_cast<My_Wizard*>(w)->Fl_Wizard::handle(e); -} - - diff --git a/src/c_fl_wizard.h b/src/c_fl_wizard.h deleted file mode 100644 index fb710ec..0000000 --- a/src/c_fl_wizard.h +++ /dev/null @@ -1,32 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_WIZARD_GUARD -#define FL_WIZARD_GUARD - - -typedef void* WIZARD; - - -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); - - -extern "C" void fl_wizard_draw(WIZARD w); -extern "C" int fl_wizard_handle(WIZARD w, int e); - - -#endif - - diff --git a/src/c_fl_xbm_image.cpp b/src/c_fl_xbm_image.cpp deleted file mode 100644 index 7bb6ccf..0000000 --- a/src/c_fl_xbm_image.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 c7ed8ca..0000000 --- a/src/c_fl_xbm_image.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 7902020..0000000 --- a/src/c_fl_xpm_image.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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 d1ac6eb..0000000 --- a/src/c_fl_xpm_image.h +++ /dev/null @@ -1,23 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#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-asks.adb b/src/fltk-asks.adb deleted file mode 100644 index bd09fac..0000000 --- a/src/fltk-asks.adb +++ /dev/null @@ -1,659 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Asks is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function fl_ask_get_cancel - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_get_cancel, "fl_ask_get_cancel"); - pragma Inline (fl_ask_get_cancel); - - procedure fl_ask_set_cancel - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_set_cancel, "fl_ask_set_cancel"); - pragma Inline (fl_ask_set_cancel); - - function fl_ask_get_close - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_get_close, "fl_ask_get_close"); - pragma Inline (fl_ask_get_close); - - procedure fl_ask_set_close - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_set_close, "fl_ask_set_close"); - pragma Inline (fl_ask_set_close); - - function fl_ask_get_no - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_get_no, "fl_ask_get_no"); - pragma Inline (fl_ask_get_no); - - procedure fl_ask_set_no - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_set_no, "fl_ask_set_no"); - pragma Inline (fl_ask_set_no); - - function fl_ask_get_ok - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_get_ok, "fl_ask_get_ok"); - pragma Inline (fl_ask_get_ok); - - procedure fl_ask_set_ok - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_set_ok, "fl_ask_set_ok"); - pragma Inline (fl_ask_set_ok); - - function fl_ask_get_yes - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_get_yes, "fl_ask_get_yes"); - pragma Inline (fl_ask_get_yes); - - procedure fl_ask_set_yes - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_set_yes, "fl_ask_set_yes"); - pragma Inline (fl_ask_set_yes); - - - - - procedure fl_ask_alert - (M : in Interfaces.C.char_array); - pragma Import (C, fl_ask_alert, "fl_ask_alert"); - pragma Inline (fl_ask_alert); - - procedure fl_ask_beep - (B : in Interfaces.C.int); - pragma Import (C, fl_ask_beep, "fl_ask_beep"); - pragma Inline (fl_ask_beep); - - function fl_ask_choice - (M, A : in Interfaces.C.char_array; - B, C : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.int; - pragma Import (C, fl_ask_choice, "fl_ask_choice"); - pragma Inline (fl_ask_choice); - - function fl_ask_choice_n - (M, A : in Interfaces.C.char_array; - B, C : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.int; - pragma Import (C, fl_ask_choice_n, "fl_ask_choice_n"); - pragma Inline (fl_ask_choice_n); - - function fl_ask_input - (M, D : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_input, "fl_ask_input"); - pragma Inline (fl_ask_input); - - procedure fl_ask_message - (M : in Interfaces.C.char_array); - pragma Import (C, fl_ask_message, "fl_ask_message"); - pragma Inline (fl_ask_message); - - function fl_ask_password - (M, D : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_password, "fl_ask_password"); - pragma Inline (fl_ask_password); - - - - - function fl_ask_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, fl_ask_color_chooser, "fl_ask_color_chooser"); - pragma Inline (fl_ask_color_chooser); - - function fl_ask_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, fl_ask_color_chooser2, "fl_ask_color_chooser2"); - pragma Inline (fl_ask_color_chooser2); - - function fl_ask_dir_chooser - (M, D : in Interfaces.C.char_array; - R : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_dir_chooser, "fl_ask_dir_chooser"); - pragma Inline (fl_ask_dir_chooser); - - function fl_ask_file_chooser - (M, P, D : in Interfaces.C.char_array; - R : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_ask_file_chooser, "fl_ask_file_chooser"); - pragma Inline (fl_ask_file_chooser); - - procedure fl_ask_file_chooser_callback - (CB : in Storage.Integer_Address); - pragma Import (C, fl_ask_file_chooser_callback, "fl_ask_file_chooser_callback"); - pragma Inline (fl_ask_file_chooser_callback); - - procedure fl_ask_file_chooser_ok_label - (L : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_ask_file_chooser_ok_label, "fl_ask_file_chooser_ok_label"); - pragma Inline (fl_ask_file_chooser_ok_label); - - - - - function fl_ask_get_message_hotspot - return Interfaces.C.int; - pragma Import (C, fl_ask_get_message_hotspot, "fl_ask_get_message_hotspot"); - pragma Inline (fl_ask_get_message_hotspot); - - procedure fl_ask_set_message_hotspot - (V : in Interfaces.C.int); - pragma Import (C, fl_ask_set_message_hotspot, "fl_ask_set_message_hotspot"); - pragma Inline (fl_ask_set_message_hotspot); - - procedure fl_ask_message_font - (F, S : in Interfaces.C.int); - pragma Import (C, fl_ask_message_font, "fl_ask_message_font"); - pragma Inline (fl_ask_message_font); - - function fl_ask_message_icon - return Storage.Integer_Address; - pragma Import (C, fl_ask_message_icon, "fl_ask_message_icon"); - pragma Inline (fl_ask_message_icon); - - procedure fl_ask_message_title - (T : in Interfaces.C.char_array); - pragma Import (C, fl_ask_message_title, "fl_ask_message_title"); - pragma Inline (fl_ask_message_title); - - procedure fl_ask_message_title_default - (T : in Interfaces.C.char_array); - pragma Import (C, fl_ask_message_title_default, "fl_ask_message_title_default"); - pragma Inline (fl_ask_message_title_default); - - - - - --------------------- - -- Callback Hook -- - --------------------- - - procedure File_Chooser_Callback_Hook - (C_Str : in Interfaces.C.Strings.chars_ptr); - - pragma Convention (C, File_Chooser_Callback_Hook); - - procedure File_Chooser_Callback_Hook - (C_Str : in Interfaces.C.Strings.chars_ptr) is - begin - if Chooser_Func /= null then - Chooser_Func (Interfaces.C.Strings.Value (C_Str)); - end if; - end File_Chooser_Callback_Hook; - - - - - --------------- - -- Cleanup -- - --------------- - - procedure Finalize - (This : in out Dialog_String_Final_Controller) - is - use Interfaces.C.Strings; - begin - Free (Cancel_Str); - Free (Close_Str); - Free (No_Str); - Free (OK_Str); - Free (Yes_Str); - Free (Chooser_OK_Str); - end Finalize; - - - - - ------------------ - -- Attributes -- - ------------------ - - function Get_Cancel_String - return String is - begin - return Interfaces.C.Strings.Value (fl_ask_get_cancel); - end Get_Cancel_String; - - - procedure Set_Cancel_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (Cancel_Str); - Cancel_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_set_cancel (Cancel_Str); - end Set_Cancel_String; - - - function Get_Close_String - return String is - begin - return Interfaces.C.Strings.Value (fl_ask_get_close); - end Get_Close_String; - - - procedure Set_Close_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (Close_Str); - Close_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_set_close (Close_Str); - end Set_Close_String; - - - function Get_No_String - return String is - begin - return Interfaces.C.Strings.Value (fl_ask_get_no); - end Get_No_String; - - - procedure Set_No_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (No_Str); - No_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_set_no (No_Str); - end Set_No_String; - - - function Get_OK_String - return String is - begin - return Interfaces.C.Strings.Value (fl_ask_get_ok); - end Get_OK_String; - - - procedure Set_OK_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (OK_Str); - OK_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_set_ok (OK_Str); - end Set_OK_String; - - - function Get_Yes_String - return String is - begin - return Interfaces.C.Strings.Value (fl_ask_get_yes); - end Get_Yes_String; - - - procedure Set_Yes_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (Yes_Str); - Yes_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_set_yes (Yes_Str); - end Set_Yes_String; - - - - - ---------------------- - -- Common Dialogs -- - ---------------------- - - procedure Alert - (Message : String) is - begin - fl_ask_alert (Interfaces.C.To_C (Message)); - end Alert; - - - procedure Beep - (Kind : in Beep_Kind := Default_Beep) is - begin - fl_ask_beep (Beep_Kind'Pos (Kind)); - end Beep; - - - function Choice - (Message, Button1 : in String) - return Choice_Result - is - Result : Interfaces.C.int := fl_ask_choice - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.Null_Ptr, - Interfaces.C.Strings.Null_Ptr); - begin - return Choice_Result'Val (Result); - end Choice; - - - function Choice - (Message, Button1, Button2 : in String) - return Choice_Result - is - Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Result : Interfaces.C.int := fl_ask_choice - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), - Interfaces.C.Strings.Null_Ptr); - begin - return Choice_Result'Val (Result); - end Choice; - - - function Choice - (Message, Button1, Button2, Button3 : in String) - return Choice_Result - is - Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3); - Result : Interfaces.C.int := fl_ask_choice - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), - Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access)); - begin - return Choice_Result'Val (Result); - end Choice; - - - function Extended_Choice - (Message, Button1 : in String) - return Extended_Choice_Result - is - Result : Interfaces.C.int := fl_ask_choice_n - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.Null_Ptr, - Interfaces.C.Strings.Null_Ptr); - begin - pragma Assert (Result in -3 .. 2); - return Extended_Choice_Result'Val (Result mod 6); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Extended_Choice; - - - function Extended_Choice - (Message, Button1, Button2 : in String) - return Extended_Choice_Result - is - Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Result : Interfaces.C.int := fl_ask_choice_n - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), - Interfaces.C.Strings.Null_Ptr); - begin - pragma Assert (Result in -3 .. 2); - return Extended_Choice_Result'Val (Result mod 6); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Extended_Choice; - - - function Extended_Choice - (Message, Button1, Button2, Button3 : in String) - return Extended_Choice_Result - is - Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2); - Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3); - Result : Interfaces.C.int := fl_ask_choice_n - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), - Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access)); - begin - pragma Assert (Result in -3 .. 2); - return Extended_Choice_Result'Val (Result mod 6); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Extended_Choice; - - - function Text_Input - (Message : in String; - Default : in String := "") - return String - is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_input - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default)); - begin - -- Result 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 - fl_ask_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 := fl_ask_password - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default)); - begin - -- Result 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 Confirm_Result - 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 : Interfaces.C.int := fl_ask_color_chooser - (Interfaces.C.To_C (Title), C_R, C_G, C_B, M); - begin - if Result = 1 then - R := RGB_Float (C_R); - G := RGB_Float (C_G); - B := RGB_Float (C_B); - return Confirm; - else - pragma Assert (Result = 0); - return Cancel; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 Confirm_Result - 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 : Interfaces.C.int := fl_ask_color_chooser2 - (Interfaces.C.To_C (Title), C_R, C_G, C_B, M); - begin - if Result = 1 then - R := RGB_Int (C_R); - G := RGB_Int (C_G); - B := RGB_Int (C_B); - return Confirm; - else - pragma Assert (Result = 0); - return Cancel; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Color_Chooser; - - - function Dir_Chooser - (Message, Default : in String; - Relative : in Boolean := False) - return String - is - Result : Interfaces.C.Strings.chars_ptr := fl_ask_dir_chooser - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Default), - Boolean'Pos (Relative)); - begin - -- Result 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 := fl_ask_file_chooser - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Filter_Pattern), - Interfaces.C.To_C (Default), - Boolean'Pos (Relative)); - begin - -- Result 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; - - - procedure Set_File_Chooser_Callback - (Func : in File_Chooser_Callback) is - begin - Chooser_Func := Func; - end Set_File_Chooser_Callback; - - - procedure Set_File_Chooser_OK_String - (Value : in String) is - begin - Interfaces.C.Strings.Free (Chooser_OK_Str); - Chooser_OK_Str := Interfaces.C.Strings.New_String (Value); - fl_ask_file_chooser_ok_label (Chooser_OK_Str); - end Set_File_Chooser_OK_String; - - - - - function Get_Message_Hotspot - return Boolean is - begin - return fl_ask_get_message_hotspot /= 0; - end Get_Message_Hotspot; - - - procedure Set_Message_Hotspot - (To : in Boolean) is - begin - fl_ask_set_message_hotspot (Boolean'Pos (To)); - end Set_Message_Hotspot; - - - procedure Set_Message_Font - (Font : in Font_Kind; - Size : in Font_Size) is - begin - fl_ask_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 - fl_ask_message_title (Interfaces.C.To_C (To)); - end Set_Message_Title; - - - procedure Set_Message_Title_Default - (To : in String) is - begin - fl_ask_message_title_default (Interfaces.C.To_C (To)); - end Set_Message_Title_Default; - - - - -begin - - - Wrapper (Icon_Box).Void_Ptr := fl_ask_message_icon; - Wrapper (Icon_Box).Needs_Dealloc := False; - - fl_ask_file_chooser_callback (Storage.To_Integer (File_Chooser_Callback_Hook'Address)); - - -end FLTK.Asks; - diff --git a/src/fltk-asks.ads b/src/fltk-asks.ads deleted file mode 100644 index fc6e150..0000000 --- a/src/fltk-asks.ads +++ /dev/null @@ -1,220 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Boxes, - FLTK.Widgets.Groups.Color_Choosers; - -private with - - Ada.Finalization, - Interfaces.C.Strings; - - -package FLTK.Asks is - - - type Beep_Kind is - (Default_Beep, Message_Beep, Error_Beep, - Question_Beep, Password_Beep, Notification_Beep); - - type Confirm_Result is (Cancel, Confirm); - - type Choice_Result is (First, Second, Third); - - type Extended_Choice_Result is (First, Second, Third, Blocked, Closed, Escaped); - - type RGB_Float is new Long_Float range 0.0 .. 1.0; - - type RGB_Int is mod 256; - - type File_Chooser_Callback is access procedure - (Item : in String); - - - - - function Get_Cancel_String - return String; - - procedure Set_Cancel_String - (Value : in String); - - function Get_Close_String - return String; - - procedure Set_Close_String - (Value : in String); - - function Get_No_String - return String; - - procedure Set_No_String - (Value : in String); - - function Get_OK_String - return String; - - procedure Set_OK_String - (Value : in String); - - function Get_Yes_String - return String; - - procedure Set_Yes_String - (Value : in String); - - - - - procedure Alert - (Message : String); - - procedure Beep - (Kind : in Beep_Kind := Default_Beep); - - function Choice - (Message, Button1 : in String) - return Choice_Result; - - function Choice - (Message, Button1, Button2 : in String) - return Choice_Result; - - function Choice - (Message, Button1, Button2, Button3 : in String) - return Choice_Result; - - function Extended_Choice - (Message, Button1 : in String) - return Extended_Choice_Result; - - function Extended_Choice - (Message, Button1, Button2 : in String) - return Extended_Choice_Result; - - function Extended_Choice - (Message, Button1, Button2, Button3 : in String) - return Extended_Choice_Result; - - 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 Confirm_Result; - - 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 Confirm_Result; - - 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; - - procedure Set_File_Chooser_Callback - (Func : in File_Chooser_Callback); - - procedure Set_File_Chooser_OK_String - (Value : in String); - - - - - function Get_Message_Hotspot - return Boolean; - - procedure Set_Message_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; - - - Cancel_Str, Close_Str, No_Str, OK_Str, Yes_Str : Interfaces.C.Strings.chars_ptr; - - Chooser_OK_Str : Interfaces.C.Strings.chars_ptr; - Chooser_Func : File_Chooser_Callback; - - - pragma Inline (Get_Cancel_String); - pragma Inline (Get_Close_String); - pragma Inline (Get_No_String); - pragma Inline (Get_OK_String); - pragma Inline (Get_Yes_String); - - pragma Inline (Alert); - pragma Inline (Beep); - 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 (Set_File_Chooser_Callback); - - pragma Inline (Get_Message_Hotspot); - pragma Inline (Set_Message_Hotspot); - pragma Inline (Set_Message_Font); - pragma Inline (Get_Message_Icon); - pragma Inline (Set_Message_Title); - pragma Inline (Set_Message_Title_Default); - - - -- Needed to ensure chars_ptr storage is properly cleaned up - type Dialog_String_Final_Controller is new Ada.Finalization.Controlled with null record; - - overriding procedure Finalize - (This : in out Dialog_String_Final_Controller); - - Cleanup : Dialog_String_Final_Controller; - - -end FLTK.Asks; - diff --git a/src/fltk-devices-graphics.adb b/src/fltk-devices-graphics.adb deleted file mode 100644 index f97cebe..0000000 --- a/src/fltk-devices-graphics.adb +++ /dev/null @@ -1,171 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Devices.Graphics is - - - function fl_graphics_driver_color - (G : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 f9d1a7c..0000000 --- a/src/fltk-devices-graphics.ads +++ /dev/null @@ -1,93 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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-surface-copy.adb b/src/fltk-devices-surface-copy.adb deleted file mode 100644 index 7bb1c66..0000000 --- a/src/fltk-devices-surface-copy.adb +++ /dev/null @@ -1,156 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Devices.Surface.Copy is - - - function new_fl_copy_surface - (W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_copy_surface (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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; - - pragma Inline (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); - This.Set_Current_Bookkeep; - end Set_Current; - - -end FLTK.Devices.Surface.Copy; - - diff --git a/src/fltk-devices-surface-copy.ads b/src/fltk-devices-surface-copy.ads deleted file mode 100644 index 41d331b..0000000 --- a/src/fltk-devices-surface-copy.ads +++ /dev/null @@ -1,89 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surface.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; - - - - - -- The initial Graphics_Driver this is supposed to have upon construction - -- is not currently implemented properly. Please wait warmly until the - -- binding for the Graphics sub-hierarchy is done. - - - - - 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.Surface.Copy; - - diff --git a/src/fltk-devices-surface-display.adb b/src/fltk-devices-surface-display.adb deleted file mode 100644 index ad35012..0000000 --- a/src/fltk-devices-surface-display.adb +++ /dev/null @@ -1,118 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package body FLTK.Devices.Surface.Display is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_display_device - (G : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, new_fl_display_device, "new_fl_display_device"); - pragma Inline (new_fl_display_device); - - procedure free_fl_display_device - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_display_device, "free_fl_display_device"); - pragma Inline (free_fl_display_device); - - - - - function fl_display_device_display_device - return Storage.Integer_Address; - pragma Import (C, fl_display_device_display_device, "fl_display_device_display_device"); - pragma Inline (fl_display_device_display_device); - - - - - function fl_surface_device_get_driver - (S : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_surface_device_get_driver, "fl_surface_device_get_driver"); - pragma Inline (fl_surface_device_get_driver); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out Display_Device) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_display_device (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) - return Display_Device is - begin - return This : Display_Device do - This.Void_Ptr := new_fl_display_device (Wrapper (Graphics).Void_Ptr); - This.My_Driver := Graphics'Unchecked_Access; - end return; - end Create; - - end Forge; - - - - - ------------------------- - -- Static Attributes -- - ------------------------- - - Platform_Display : aliased Display_Device; - Platform_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Platform_Display - return Display_Device_Reference is - begin - return Ref : Display_Device_Reference (Data => Platform_Display'Access); - end Get_Platform_Display; - - -begin - - - Platform_Display.Void_Ptr := fl_display_device_display_device; - Platform_Display.Needs_Dealloc := False; - - Wrapper (Platform_Graphics).Void_Ptr := - fl_surface_device_get_driver (Platform_Display.Void_Ptr); - Wrapper (Platform_Graphics).Needs_Dealloc := False; - - Platform_Display.My_Driver := Platform_Graphics'Access; - - -end FLTK.Devices.Surface.Display; - - diff --git a/src/fltk-devices-surface-display.ads b/src/fltk-devices-surface-display.ads deleted file mode 100644 index b581be7..0000000 --- a/src/fltk-devices-surface-display.ads +++ /dev/null @@ -1,53 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Devices.Graphics; - - -package FLTK.Devices.Surface.Display is - - - type Display_Device is new Surface_Device with private; - - type Display_Device_Reference (Data : not null access Display_Device'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - -- Docs say you shouldn't ever need to use this, but it's here anyway. - function Create - (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) - return Display_Device; - - end Forge; - - - - - function Get_Platform_Display - return Display_Device_Reference; - - -private - - - type Display_Device is new Surface_Device with null record; - - overriding procedure Finalize - (This : in out Display_Device); - - - pragma Inline (Get_Platform_Display); - - -end FLTK.Devices.Surface.Display; - - diff --git a/src/fltk-devices-surface-image.adb b/src/fltk-devices-surface-image.adb deleted file mode 100644 index e9e7de4..0000000 --- a/src/fltk-devices-surface-image.adb +++ /dev/null @@ -1,171 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Devices.Surface.Image is - - - function new_fl_image_surface - (W, H, R : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_image_surface (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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); - This.Set_Current_Bookkeep; - end Set_Current; - - -end FLTK.Devices.Surface.Image; - - diff --git a/src/fltk-devices-surface-image.ads b/src/fltk-devices-surface-image.ads deleted file mode 100644 index 961a9b2..0000000 --- a/src/fltk-devices-surface-image.ads +++ /dev/null @@ -1,96 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Images.RGB, - FLTK.Images.Shared, - FLTK.Widgets.Groups.Windows; - - -package FLTK.Devices.Surface.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.Surface.Image; - - diff --git a/src/fltk-devices-surface-paged-postscript.adb b/src/fltk-devices-surface-paged-postscript.adb deleted file mode 100644 index fa9f66d..0000000 --- a/src/fltk-devices-surface-paged-postscript.adb +++ /dev/null @@ -1,505 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Devices.Surface.Paged.Postscript is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function fopen - (Name, Mode : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, fopen, "fopen"); - - function fclose - (Handle : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fclose, "fclose"); - - - - - function new_fl_postscript_file_device - return Storage.Integer_Address; - pragma Import (C, new_fl_postscript_file_device, "new_fl_postscript_file_device"); - pragma Inline (new_fl_postscript_file_device); - - procedure free_fl_postscript_file_device - (P : in Storage.Integer_Address); - pragma Import (C, free_fl_postscript_file_device, "free_fl_postscript_file_device"); - pragma Inline (free_fl_postscript_file_device); - - - - - function fl_postscript_file_device_get_file_chooser_title - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_postscript_file_device_get_file_chooser_title, - "fl_postscript_file_device_get_file_chooser_title"); - pragma Inline (fl_postscript_file_device_get_file_chooser_title); - - procedure fl_postscript_file_device_set_file_chooser_title - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_postscript_file_device_set_file_chooser_title, - "fl_postscript_file_device_set_file_chooser_title"); - pragma Inline (fl_postscript_file_device_set_file_chooser_title); - - - - - function fl_postscript_file_device_get_driver - (D : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_postscript_file_device_get_driver, "fl_postscript_file_device_get_driver"); - pragma Inline (fl_postscript_file_device_get_driver); - - - - - function fl_postscript_file_device_start_job - (D : in Storage.Integer_Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_start_job, "fl_postscript_file_device_start_job"); - pragma Inline (fl_postscript_file_device_start_job); - - function fl_postscript_file_device_start_job2 - (D : in Storage.Integer_Address; - C : in Interfaces.C.int; - F, T : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_start_job2, "fl_postscript_file_device_start_job2"); - pragma Inline (fl_postscript_file_device_start_job2); - - function fl_postscript_file_device_start_job3 - (D, O : in Storage.Integer_Address; - C, F, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_start_job3, "fl_postscript_file_device_start_job3"); - pragma Inline (fl_postscript_file_device_start_job3); - - function fl_postscript_file_device_start_job4 - (D : in Storage.Integer_Address; - C, F, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_start_job4, "fl_postscript_file_device_start_job4"); - pragma Inline (fl_postscript_file_device_start_job4); - - procedure fl_postscript_file_device_end_job - (D : in Storage.Integer_Address); - pragma Import (C, fl_postscript_file_device_end_job, "fl_postscript_file_device_end_job"); - pragma Inline (fl_postscript_file_device_end_job); - - function fl_postscript_file_device_start_page - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_start_page, "fl_postscript_file_device_start_page"); - pragma Inline (fl_postscript_file_device_start_page); - - function fl_postscript_file_device_end_page - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_end_page, "fl_postscript_file_device_end_page"); - pragma Inline (fl_postscript_file_device_end_page); - - - - - procedure fl_postscript_file_device_margins - (D : in Storage.Integer_Address; - L, T, R, B : out Interfaces.C.int); - pragma Import (C, fl_postscript_file_device_margins, "fl_postscript_file_device_margins"); - pragma Inline (fl_postscript_file_device_margins); - - function fl_postscript_file_device_printable_rect - (D : in Storage.Integer_Address; - W, H : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_postscript_file_device_printable_rect, - "fl_postscript_file_device_printable_rect"); - pragma Inline (fl_postscript_file_device_printable_rect); - - procedure fl_postscript_file_device_get_origin - (D : in Storage.Integer_Address; - X, Y : out Interfaces.C.int); - pragma Import (C, fl_postscript_file_device_get_origin, "fl_postscript_file_device_get_origin"); - pragma Inline (fl_postscript_file_device_get_origin); - - procedure fl_postscript_file_device_set_origin - (D : in Storage.Integer_Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_postscript_file_device_set_origin, "fl_postscript_file_device_set_origin"); - pragma Inline (fl_postscript_file_device_set_origin); - - procedure fl_postscript_file_device_rotate - (D : in Storage.Integer_Address; - R : in Interfaces.C.C_float); - pragma Import (C, fl_postscript_file_device_rotate, "fl_postscript_file_device_rotate"); - pragma Inline (fl_postscript_file_device_rotate); - - procedure fl_postscript_file_device_scale - (D : in Storage.Integer_Address; - X, Y : in Interfaces.C.C_float); - pragma Import (C, fl_postscript_file_device_scale, "fl_postscript_file_device_scale"); - pragma Inline (fl_postscript_file_device_scale); - - procedure fl_postscript_file_device_translate - (D : in Storage.Integer_Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_postscript_file_device_translate, "fl_postscript_file_device_translate"); - pragma Inline (fl_postscript_file_device_translate); - - procedure fl_postscript_file_device_untranslate - (D : in Storage.Integer_Address); - pragma Import (C, fl_postscript_file_device_untranslate, - "fl_postscript_file_device_untranslate"); - pragma Inline (fl_postscript_file_device_untranslate); - - - - - ----------------------------- - -- Auxiliary Subprograms -- - ----------------------------- - - procedure Open - (File : in out File_Type; - Name : in String) - is - Result : Storage.Integer_Address; - begin - File.Close; - Result := fopen - (Interfaces.C.To_C (Name), - Interfaces.C.To_C ("w")); - if Result = Null_Pointer then - raise File_Open_Error; - else - File.C_File := Result; - File.Open_State := True; - end if; - end Open; - - - function Is_Open - (File : in File_Type) - return Boolean is - begin - return File.Open_State; - end Is_Open; - - - procedure Close - (File : in out File_Type) - is - Result : Interfaces.C.int; - begin - if File.Is_Open then - Result := fclose (File.C_File); - if Result /= 0 then - raise File_Close_Error; - end if; - File.Open_State := False; - end if; - end Close; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out File_Type) is - begin - This.Close; - end Finalize; - - - procedure Finalize - (This : in out Postscript_File_Device) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_postscript_file_device (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - procedure Finalize - (This : in out Postscript_File_Device_Final_Controller) is - begin - Interfaces.C.Strings.Free (File_Chooser_Title); - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - return Postscript_File_Device is - begin - return This : Postscript_File_Device do - This.Void_Ptr := new_fl_postscript_file_device; - end return; - end Create; - - end Forge; - - - - - ------------------------- - -- Static Attributes -- - ------------------------- - - function Get_File_Chooser_Title - return String is - begin - return Interfaces.C.Strings.Value (fl_postscript_file_device_get_file_chooser_title); - end Get_File_Chooser_Title; - - - procedure Set_File_Chooser_Title - (Value : in String) is - begin - Interfaces.C.Strings.Free (File_Chooser_Title); - File_Chooser_Title := Interfaces.C.Strings.New_String (Value); - fl_postscript_file_device_set_file_chooser_title (File_Chooser_Title); - end Set_File_Chooser_Title; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Postscript_Driver - (This : in out Postscript_File_Device) - return FLTK.Devices.Graphics.Graphics_Driver_Reference is - begin - return raise Program_Error with "Get_Postscript_Driver unimplemented"; - end Get_Postscript_Driver; - - - - - procedure Start_Job - (This : in out Postscript_File_Device; - Count : in Natural := 0) is - begin - if fl_postscript_file_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 Postscript_File_Device; - Count : in Natural := 0; - From, To : out Positive) is - begin - if fl_postscript_file_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 Start_Job - (This : in out Postscript_File_Device; - Output : in File_Type'Class; - Count : in Natural := 0; - Format : in Page_Format := A4; - Layout : in Page_Layout := Portrait) - is - Code : Interfaces.C.int := fl_postscript_file_device_start_job3 - (This.Void_Ptr, - Output.C_File, - Interfaces.C.int (Count), - To_Cint (Format), - To_Cint (Layout)); - begin - pragma Assert (Code = 0); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Start_Job; - - - procedure Start_Job - (This : in out Postscript_File_Device; - Count : in Natural := 0; - Format : in Page_Format := A4; - Layout : in Page_Layout := Portrait) - is - Code : Interfaces.C.int := fl_postscript_file_device_start_job4 - (This.Void_Ptr, - Interfaces.C.int (Count), - To_Cint (Format), - To_Cint (Layout)); - begin - case Code is - when 1 => raise User_Cancel_Error; - when 2 => raise File_Open_Error; - when others => pragma Assert (Code = 0); - end case; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Start_Job; - - - procedure End_Job - (This : in out Postscript_File_Device) is - begin - fl_postscript_file_device_end_job (This.Void_Ptr); - end End_Job; - - - procedure Start_Page - (This : in out Postscript_File_Device) is - begin - if fl_postscript_file_device_start_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end Start_Page; - - - procedure End_Page - (This : in out Postscript_File_Device) is - begin - if fl_postscript_file_device_end_page (This.Void_Ptr) /= 0 then - raise Page_Error; - end if; - end End_Page; - - - - - procedure Get_Margins - (This : in Postscript_File_Device; - Left, Top, Right, Bottom : out Integer) is - begin - fl_postscript_file_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 Postscript_File_Device; - W, H : out Integer) is - begin - if fl_postscript_file_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 Postscript_File_Device; - X, Y : out Integer) is - begin - fl_postscript_file_device_get_origin - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Get_Origin; - - - procedure Set_Origin - (This : in out Postscript_File_Device; - X, Y : in Integer) is - begin - fl_postscript_file_device_set_origin - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Set_Origin; - - - procedure Rotate - (This : in out Postscript_File_Device; - Degrees : in Float) is - begin - fl_postscript_file_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); - end Rotate; - - - procedure Scale - (This : in out Postscript_File_Device; - Factor : in Float) is - begin - fl_postscript_file_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); - end Scale; - - - procedure Scale - (This : in out Postscript_File_Device; - Factor_X, Factor_Y : in Float) is - begin - fl_postscript_file_device_scale - (This.Void_Ptr, - Interfaces.C.C_float (Factor_X), - Interfaces.C.C_float (Factor_Y)); - end Scale; - - - procedure Translate - (This : in out Postscript_File_Device; - Delta_X, Delta_Y : in Integer) is - begin - fl_postscript_file_device_translate - (This.Void_Ptr, - Interfaces.C.int (Delta_X), - Interfaces.C.int (Delta_Y)); - end Translate; - - - procedure Untranslate - (This : in out Postscript_File_Device) is - begin - fl_postscript_file_device_untranslate (This.Void_Ptr); - end Untranslate; - - -end FLTK.Devices.Surface.Paged.Postscript; - - diff --git a/src/fltk-devices-surface-paged-postscript.ads b/src/fltk-devices-surface-paged-postscript.ads deleted file mode 100644 index a7ea51c..0000000 --- a/src/fltk-devices-surface-paged-postscript.ads +++ /dev/null @@ -1,214 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Devices.Graphics; - -private with - - Ada.Finalization, - Interfaces.C.Strings; - - -package FLTK.Devices.Surface.Paged.Postscript is - - - type Postscript_File_Device is new Paged_Device with private; - - type Postscript_File_Device_Reference (Data : not null access Postscript_File_Device'Class) is - limited null record with Implicit_Dereference => Data; - - - -- This will autoclose when it goes out of scope. - type File_Type is tagged limited private; - - -- Calling this on a file already open will close it then open the new name. - procedure Open - (File : in out File_Type; - Name : in String); - - function Is_Open - (File : in File_Type) - return Boolean; - - -- Calling this on a file already closed will have no effect. - procedure Close - (File : in out File_Type); - - - File_Open_Error : exception; - - File_Close_Error : exception; - - User_Cancel_Error : exception; - - - - - -- The initial Graphics_Driver this is supposed to have upon construction - -- is not currently implemented properly. Please wait warmly until the - -- binding for the Graphics sub-hierarchy is done. - - - - - package Forge is - - function Create - return Postscript_File_Device; - - end Forge; - - - - - function Get_File_Chooser_Title - return String; - - procedure Set_File_Chooser_Title - (Value : in String); - - - - - -- Not currently implemented, - -- will return a Postscript_Graphics_Driver when done. - function Get_Postscript_Driver - (This : in out Postscript_File_Device) - return FLTK.Devices.Graphics.Graphics_Driver_Reference; - - - - - -- Docs say don't use this version. - procedure Start_Job - (This : in out Postscript_File_Device; - Count : in Natural := 0); - - -- Docs say don't use this version. - procedure Start_Job - (This : in out Postscript_File_Device; - Count : in Natural := 0; - From, To : out Positive); - - procedure Start_Job - (This : in out Postscript_File_Device; - Output : in File_Type'Class; - Count : in Natural := 0; - Format : in Page_Format := A4; - Layout : in Page_Layout := Portrait) - with Pre => Output.Is_Open; - - procedure Start_Job - (This : in out Postscript_File_Device; - Count : in Natural := 0; - Format : in Page_Format := A4; - Layout : in Page_Layout := Portrait); - - procedure End_Job - (This : in out Postscript_File_Device); - - procedure Start_Page - (This : in out Postscript_File_Device); - - procedure End_Page - (This : in out Postscript_File_Device); - - - - - procedure Get_Margins - (This : in Postscript_File_Device; - Left, Top, Right, Bottom : out Integer); - - procedure Get_Printable_Rect - (This : in Postscript_File_Device; - W, H : out Integer); - - procedure Get_Origin - (This : in Postscript_File_Device; - X, Y : out Integer); - - procedure Set_Origin - (This : in out Postscript_File_Device; - X, Y : in Integer); - - procedure Rotate - (This : in out Postscript_File_Device; - Degrees : in Float); - - procedure Scale - (This : in out Postscript_File_Device; - Factor : in Float); - - procedure Scale - (This : in out Postscript_File_Device; - Factor_X, Factor_Y : in Float); - - procedure Translate - (This : in out Postscript_File_Device; - Delta_X, Delta_Y : in Integer); - - procedure Untranslate - (This : in out Postscript_File_Device); - - -private - - - type File_Type is new Ada.Finalization.Limited_Controlled with record - C_File : Storage.Integer_Address; - Open_State : Boolean := False; - end record; - - overriding procedure Finalize - (This : in out File_Type); - - - type Postscript_File_Device is new Paged_Device with null record; - - overriding procedure Finalize - (This : in out Postscript_File_Device); - - - File_Chooser_Title : Interfaces.C.Strings.chars_ptr; - - - pragma Inline (Is_Open); - - pragma Inline (Get_File_Chooser_Title); - - pragma Inline (Get_Postscript_Driver); - - 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); - - - -- Needed to ensure chars_ptr storage is properly cleaned up - type Postscript_File_Device_Final_Controller is new Ada.Finalization.Limited_Controlled - with null record; - - overriding procedure Finalize - (This : in out Postscript_File_Device_Final_Controller); - - Cleanup : Postscript_File_Device_Final_Controller; - - -end FLTK.Devices.Surface.Paged.Postscript; - - diff --git a/src/fltk-devices-surface-paged-printers.adb b/src/fltk-devices-surface-paged-printers.adb deleted file mode 100644 index 3e605c8..0000000 --- a/src/fltk-devices-surface-paged-printers.adb +++ /dev/null @@ -1,915 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Devices.Surface.Paged.Printers is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_printer - return Storage.Integer_Address; - pragma Import (C, new_fl_printer, "new_fl_printer"); - pragma Inline (new_fl_printer); - - procedure free_fl_printer - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_printer, "free_fl_printer"); - pragma Inline (free_fl_printer); - - - - - function fl_printer_get_dialog_title - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_title, "fl_printer_get_dialog_title"); - pragma Inline (fl_printer_get_dialog_title); - - procedure fl_printer_set_dialog_title - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_title, "fl_printer_set_dialog_title"); - pragma Inline (fl_printer_set_dialog_title); - - function fl_printer_get_dialog_printer - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_printer, "fl_printer_get_dialog_printer"); - pragma Inline (fl_printer_get_dialog_printer); - - procedure fl_printer_set_dialog_printer - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_printer, "fl_printer_set_dialog_printer"); - pragma Inline (fl_printer_set_dialog_printer); - - function fl_printer_get_dialog_range - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_range, "fl_printer_get_dialog_range"); - pragma Inline (fl_printer_get_dialog_range); - - procedure fl_printer_set_dialog_range - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_range, "fl_printer_set_dialog_range"); - pragma Inline (fl_printer_set_dialog_range); - - function fl_printer_get_dialog_copies - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_copies, "fl_printer_get_dialog_copies"); - pragma Inline (fl_printer_get_dialog_copies); - - procedure fl_printer_set_dialog_copies - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_copies, "fl_printer_set_dialog_copies"); - pragma Inline (fl_printer_set_dialog_copies); - - function fl_printer_get_dialog_all - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_all, "fl_printer_get_dialog_all"); - pragma Inline (fl_printer_get_dialog_all); - - procedure fl_printer_set_dialog_all - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_all, "fl_printer_set_dialog_all"); - pragma Inline (fl_printer_set_dialog_all); - - function fl_printer_get_dialog_pages - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_pages, "fl_printer_get_dialog_pages"); - pragma Inline (fl_printer_get_dialog_pages); - - procedure fl_printer_set_dialog_pages - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_pages, "fl_printer_set_dialog_pages"); - pragma Inline (fl_printer_set_dialog_pages); - - function fl_printer_get_dialog_from - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_from, "fl_printer_get_dialog_from"); - pragma Inline (fl_printer_get_dialog_from); - - procedure fl_printer_set_dialog_from - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_from, "fl_printer_set_dialog_from"); - pragma Inline (fl_printer_set_dialog_from); - - function fl_printer_get_dialog_to - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_to, "fl_printer_get_dialog_to"); - pragma Inline (fl_printer_get_dialog_to); - - procedure fl_printer_set_dialog_to - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_to, "fl_printer_set_dialog_to"); - pragma Inline (fl_printer_set_dialog_to); - - function fl_printer_get_dialog_properties - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_properties, "fl_printer_get_dialog_properties"); - pragma Inline (fl_printer_get_dialog_properties); - - procedure fl_printer_set_dialog_properties - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_properties, "fl_printer_set_dialog_properties"); - pragma Inline (fl_printer_set_dialog_properties); - - function fl_printer_get_dialog_copyno - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_copyno, "fl_printer_get_dialog_copyno"); - pragma Inline (fl_printer_get_dialog_copyno); - - procedure fl_printer_set_dialog_copyno - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_copyno, "fl_printer_set_dialog_copyno"); - pragma Inline (fl_printer_set_dialog_copyno); - - function fl_printer_get_dialog_print_button - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_print_button, "fl_printer_get_dialog_print_button"); - pragma Inline (fl_printer_get_dialog_print_button); - - procedure fl_printer_set_dialog_print_button - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_print_button, "fl_printer_set_dialog_print_button"); - pragma Inline (fl_printer_set_dialog_print_button); - - function fl_printer_get_dialog_cancel_button - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_cancel_button, "fl_printer_get_dialog_cancel_button"); - pragma Inline (fl_printer_get_dialog_cancel_button); - - procedure fl_printer_set_dialog_cancel_button - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_cancel_button, "fl_printer_set_dialog_cancel_button"); - pragma Inline (fl_printer_set_dialog_cancel_button); - - function fl_printer_get_dialog_print_to_file - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_dialog_print_to_file, "fl_printer_get_dialog_print_to_file"); - pragma Inline (fl_printer_get_dialog_print_to_file); - - procedure fl_printer_set_dialog_print_to_file - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_dialog_print_to_file, "fl_printer_set_dialog_print_to_file"); - pragma Inline (fl_printer_set_dialog_print_to_file); - - function fl_printer_get_property_title - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_title, "fl_printer_get_property_title"); - pragma Inline (fl_printer_get_property_title); - - procedure fl_printer_set_property_title - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_title, "fl_printer_set_property_title"); - pragma Inline (fl_printer_set_property_title); - - function fl_printer_get_property_pagesize - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_pagesize, "fl_printer_get_property_pagesize"); - pragma Inline (fl_printer_get_property_pagesize); - - procedure fl_printer_set_property_pagesize - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_pagesize, "fl_printer_set_property_pagesize"); - pragma Inline (fl_printer_set_property_pagesize); - - function fl_printer_get_property_mode - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_mode, "fl_printer_get_property_mode"); - pragma Inline (fl_printer_get_property_mode); - - procedure fl_printer_set_property_mode - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_mode, "fl_printer_set_property_mode"); - pragma Inline (fl_printer_set_property_mode); - - function fl_printer_get_property_use - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_use, "fl_printer_get_property_use"); - pragma Inline (fl_printer_get_property_use); - - procedure fl_printer_set_property_use - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_use, "fl_printer_set_property_use"); - pragma Inline (fl_printer_set_property_use); - - function fl_printer_get_property_save - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_save, "fl_printer_get_property_save"); - pragma Inline (fl_printer_get_property_save); - - procedure fl_printer_set_property_save - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_save, "fl_printer_set_property_save"); - pragma Inline (fl_printer_set_property_save); - - function fl_printer_get_property_cancel - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_printer_get_property_cancel, "fl_printer_get_property_cancel"); - pragma Inline (fl_printer_get_property_cancel); - - procedure fl_printer_set_property_cancel - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_printer_set_property_cancel, "fl_printer_set_property_cancel"); - pragma Inline (fl_printer_set_property_cancel); - - - - - function fl_printer_start_job - (D : in Storage.Integer_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 Storage.Integer_Address; - C : in Interfaces.C.int; - F, T : out 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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_printer_untranslate, "fl_printer_untranslate"); - pragma Inline (fl_printer_untranslate); - - - - - procedure fl_printer_print_widget - (D, I : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_printer_set_current, "fl_printer_set_current"); - pragma Inline (fl_printer_set_current); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out Printer) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_printer (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - procedure Finalize - (This : in out Printer_Final_Controller) - is - use Interfaces.C.Strings; - begin - Free (Dialog_Title); - Free (Dialog_Printer); - Free (Dialog_Range); - Free (Dialog_Copies); - Free (Dialog_All); - Free (Dialog_Pages); - Free (Dialog_From); - Free (Dialog_To); - Free (Dialog_Properties); - Free (Dialog_Copyno); - Free (Dialog_Print_Button); - Free (Dialog_Cancel_Button); - Free (Dialog_Print_To_File); - Free (Property_Title); - Free (Property_Pagesize); - Free (Property_Mode); - Free (Property_Use); - Free (Property_Save); - Free (Property_Cancel); - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - 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; - - - - - ------------------------- - -- Static Attributes -- - ------------------------- - - function Get_Dialog_Title - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_title); - end Get_Dialog_Title; - - - procedure Set_Dialog_Title - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Title); - Dialog_Title := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_title (Dialog_Title); - end Set_Dialog_Title; - - - function Get_Dialog_Printer - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_printer); - end Get_Dialog_Printer; - - - procedure Set_Dialog_Printer - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Printer); - Dialog_Printer := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_printer (Dialog_Printer); - end Set_Dialog_Printer; - - - function Get_Dialog_Range - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_range); - end Get_Dialog_Range; - - - procedure Set_Dialog_Range - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Range); - Dialog_Range := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_range (Dialog_Range); - end Set_Dialog_Range; - - - function Get_Dialog_Copies - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_copies); - end Get_Dialog_Copies; - - - procedure Set_Dialog_Copies - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Copies); - Dialog_Copies := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_copies (Dialog_Copies); - end Set_Dialog_Copies; - - - function Get_Dialog_All - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_all); - end Get_Dialog_All; - - - procedure Set_Dialog_All - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_All); - Dialog_All := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_all (Dialog_All); - end Set_Dialog_All; - - - function Get_Dialog_Pages - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_pages); - end Get_Dialog_Pages; - - - procedure Set_Dialog_Pages - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Pages); - Dialog_Pages := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_pages (Dialog_Pages); - end Set_Dialog_Pages; - - - function Get_Dialog_From - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_from); - end Get_Dialog_From; - - - procedure Set_Dialog_From - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_From); - Dialog_From := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_from (Dialog_From); - end Set_Dialog_From; - - - function Get_Dialog_To - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_to); - end Get_Dialog_To; - - - procedure Set_Dialog_To - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_To); - Dialog_To := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_to (Dialog_To); - end Set_Dialog_To; - - - function Get_Dialog_Properties - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_properties); - end Get_Dialog_Properties; - - - procedure Set_Dialog_Properties - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Properties); - Dialog_Properties := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_properties (Dialog_Properties); - end Set_Dialog_Properties; - - - function Get_Dialog_Number_Copies - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_copyno); - end Get_Dialog_Number_Copies; - - - procedure Set_Dialog_Number_Copies - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Copyno); - Dialog_Copyno := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_copyno (Dialog_Copyno); - end Set_Dialog_Number_Copies; - - - function Get_Dialog_Print_Button - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_print_button); - end Get_Dialog_Print_Button; - - - procedure Set_Dialog_Print_Button - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Print_Button); - Dialog_Print_Button := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_print_button (Dialog_Print_Button); - end Set_Dialog_Print_Button; - - - function Get_Dialog_Cancel_Button - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_cancel_button); - end Get_Dialog_Cancel_Button; - - - procedure Set_Dialog_Cancel_Button - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Cancel_Button); - Dialog_Cancel_Button := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_cancel_button (Dialog_Cancel_Button); - end Set_Dialog_Cancel_Button; - - - function Get_Dialog_Print_To_File - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_dialog_print_to_file); - end Get_Dialog_Print_To_File; - - - procedure Set_Dialog_Print_To_File - (Value : in String) is - begin - Interfaces.C.Strings.Free (Dialog_Print_To_File); - Dialog_Print_To_File := Interfaces.C.Strings.New_String (Value); - fl_printer_set_dialog_print_to_file (Dialog_Print_To_File); - end Set_Dialog_Print_To_File; - - - function Get_Property_Title - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_title); - end Get_Property_Title; - - - procedure Set_Property_Title - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Title); - Property_Title := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_title (Property_Title); - end Set_Property_Title; - - - function Get_Property_Page_Size - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_pagesize); - end Get_Property_Page_Size; - - - procedure Set_Property_Page_Size - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Pagesize); - Property_Pagesize := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_pagesize (Property_Pagesize); - end Set_Property_Page_Size; - - - function Get_Property_Mode - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_mode); - end Get_Property_Mode; - - - procedure Set_Property_Mode - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Mode); - Property_Mode := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_mode (Property_Mode); - end Set_Property_Mode; - - - function Get_Property_Use - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_use); - end Get_Property_Use; - - - procedure Set_Property_Use - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Use); - Property_Use := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_use (Property_Use); - end Set_Property_Use; - - - function Get_Property_Save - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_save); - end Get_Property_Save; - - - procedure Set_Property_Save - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Save); - Property_Save := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_save (Property_Save); - end Set_Property_Save; - - - function Get_Property_Cancel - return String is - begin - return Interfaces.C.Strings.Value (fl_printer_get_property_cancel); - end Get_Property_Cancel; - - - procedure Set_Property_Cancel - (Value : in String) is - begin - Interfaces.C.Strings.Free (Property_Cancel); - Property_Cancel := Interfaces.C.Strings.New_String (Value); - fl_printer_set_property_cancel (Property_Cancel); - end Set_Property_Cancel; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Original_Driver - (This : in out Printer) - return FLTK.Devices.Graphics.Graphics_Driver_Reference is - begin - return raise Program_Error with "Won't be implemented until Graphics_Drivers taken care of"; - end Get_Original_Driver; - - - - - procedure Start_Job - (This : in out Printer; - Count : in Natural := 0) 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 := 0; - From, To : out 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); - This.Set_Current_Bookkeep; - end Set_Current; - - -end FLTK.Devices.Surface.Paged.Printers; - - diff --git a/src/fltk-devices-surface-paged-printers.ads b/src/fltk-devices-surface-paged-printers.ads deleted file mode 100644 index c0bc34e..0000000 --- a/src/fltk-devices-surface-paged-printers.ads +++ /dev/null @@ -1,321 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Groups.Windows; - -private with - - Ada.Finalization, - Interfaces.C.Strings; - - -package FLTK.Devices.Surface.Paged.Printers is - - - type Printer is new Paged_Device with private; - - type Printer_Reference (Data : not null access Printer'Class) is limited null record - with Implicit_Dereference => Data; - - - - - -- The initial Graphics_Driver this is supposed to have upon construction - -- is not currently implemented properly. Please wait warmly until the - -- binding for the Graphics sub-hierarchy is done. - - - - - package Forge is - - function Create - return Printer; - - end Forge; - - - - - function Get_Dialog_Title - return String; - - procedure Set_Dialog_Title - (Value : in String); - - function Get_Dialog_Printer - return String; - - procedure Set_Dialog_Printer - (Value : in String); - - function Get_Dialog_Range - return String; - - procedure Set_Dialog_Range - (Value : in String); - - function Get_Dialog_Copies - return String; - - procedure Set_Dialog_Copies - (Value : in String); - - function Get_Dialog_All - return String; - - procedure Set_Dialog_All - (Value : in String); - - function Get_Dialog_Pages - return String; - - procedure Set_Dialog_Pages - (Value : in String); - - function Get_Dialog_From - return String; - - procedure Set_Dialog_From - (Value : in String); - - function Get_Dialog_To - return String; - - procedure Set_Dialog_To - (Value : in String); - - function Get_Dialog_Properties - return String; - - procedure Set_Dialog_Properties - (Value : in String); - - function Get_Dialog_Number_Copies - return String; - - procedure Set_Dialog_Number_Copies - (Value : in String); - - function Get_Dialog_Print_Button - return String; - - procedure Set_Dialog_Print_Button - (Value : in String); - - function Get_Dialog_Cancel_Button - return String; - - procedure Set_Dialog_Cancel_Button - (Value : in String); - - function Get_Dialog_Print_To_File - return String; - - procedure Set_Dialog_Print_To_File - (Value : in String); - - function Get_Property_Title - return String; - - procedure Set_Property_Title - (Value : in String); - - function Get_Property_Page_Size - return String; - - procedure Set_Property_Page_Size - (Value : in String); - - function Get_Property_Mode - return String; - - procedure Set_Property_Mode - (Value : in String); - - function Get_Property_Use - return String; - - procedure Set_Property_Use - (Value : in String); - - function Get_Property_Save - return String; - - procedure Set_Property_Save - (Value : in String); - - function Get_Property_Cancel - return String; - - procedure Set_Property_Cancel - (Value : in String); - - - - - -- Not currently implemented - function Get_Original_Driver - (This : in out Printer) - return FLTK.Devices.Graphics.Graphics_Driver_Reference; - - - - - procedure Start_Job - (This : in out Printer; - Count : in Natural := 0); - - procedure Start_Job - (This : in out Printer; - Count : in Natural := 0; - From, To : out 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_Device with null record; - - overriding procedure Finalize - (This : in out Printer); - - - Dialog_Title, Dialog_Printer, - Dialog_Range, Dialog_Copies, - Dialog_All, Dialog_Pages, - Dialog_From, Dialog_To, - Dialog_Properties, Dialog_Copyno, - Dialog_Print_Button, Dialog_Cancel_Button, - Dialog_Print_To_File, - Property_Title, Property_Pagesize, - Property_Mode, Property_Use, - Property_Save, Property_Cancel : Interfaces.C.Strings.chars_ptr; - - - pragma Inline (Get_Dialog_Title); - pragma Inline (Get_Dialog_Printer); - pragma Inline (Get_Dialog_Range); - pragma Inline (Get_Dialog_Copies); - pragma Inline (Get_Dialog_All); - pragma Inline (Get_Dialog_Pages); - pragma Inline (Get_Dialog_From); - pragma Inline (Get_Dialog_To); - pragma Inline (Get_Dialog_Properties); - pragma Inline (Get_Dialog_Number_Copies); - pragma Inline (Get_Dialog_Print_Button); - pragma Inline (Get_Dialog_Cancel_Button); - pragma Inline (Get_Dialog_Print_To_File); - pragma Inline (Get_Property_Title); - pragma Inline (Get_Property_Page_Size); - pragma Inline (Get_Property_Mode); - pragma Inline (Get_Property_Use); - pragma Inline (Get_Property_Save); - pragma Inline (Get_Property_Cancel); - - pragma Inline (Get_Original_Driver); - - 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); - - - -- Needed to ensure chars_ptr storage is properly cleaned up - type Printer_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; - - overriding procedure Finalize - (This : in out Printer_Final_Controller); - - Cleanup : Printer_Final_Controller; - - -end FLTK.Devices.Surface.Paged.Printers; - - diff --git a/src/fltk-devices-surface-paged.adb b/src/fltk-devices-surface-paged.adb deleted file mode 100644 index 829974a..0000000 --- a/src/fltk-devices-surface-paged.adb +++ /dev/null @@ -1,538 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Ada.Strings.Unbounded, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Devices.Surface.Paged is - - - package Chk renames Ada.Assertions; - package SU renames Ada.Strings.Unbounded; - - - - - ------------------------ - -- Constants From C -- - ------------------------ - - fl_page_format_media : constant Interfaces.C.int; - pragma Import (C, fl_page_format_media); - - fl_page_layout_portrait : constant Interfaces.C.int; - pragma Import (C, fl_page_layout_portrait); - - fl_page_layout_landscape : constant Interfaces.C.int; - pragma Import (C, fl_page_layout_landscape); - - fl_page_layout_reversed : constant Interfaces.C.int; - pragma Import (C, fl_page_layout_reversed); - - fl_page_layout_orientation : constant Interfaces.C.int; - pragma Import (C, fl_page_layout_orientation); - - fl_no_page_formats : constant Interfaces.C.int; - pragma Import (C, fl_no_page_formats); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - procedure fl_paged_device_get_page_format - (Index : in Interfaces.C.int; - Name : out Interfaces.C.Strings.chars_ptr; - Width : out Interfaces.C.int; - Height : out Interfaces.C.int); - pragma Import (C, fl_paged_device_get_page_format, "fl_paged_device_get_page_format"); - pragma Inline (fl_paged_device_get_page_format); - - - - - function new_fl_paged_device - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - C : in Interfaces.C.int; - F, T : out 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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------------ - -- Internal Utility -- - ------------------------ - - function To_Cint - (Value : in Page_Format) - return Interfaces.C.int is - begin - case Value is - when A0 .. Envelope => return Page_Format'Pos (Value); - when Media => return fl_page_format_media; - end case; - end To_Cint; - - - function To_Page_Format - (Value : in Interfaces.C.int) - return Page_Format is - begin - if Value in Page_Format'Pos (A0) .. Page_Format'Pos (Envelope) then - return Page_Format'Val (Value); - else - pragma Assert (Value = fl_page_format_media); - return Media; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end To_Page_Format; - - - function To_Cint - (Value : in Page_Layout) - return Interfaces.C.int is - begin - case Value is - when Portrait => return fl_page_layout_portrait; - when Landscape => return fl_page_layout_landscape; - when Reversed => return fl_page_layout_reversed; - when Orientation => return fl_page_layout_orientation; - end case; - end To_Cint; - - - function To_Page_Layout - (Value : in Interfaces.C.int) - return Page_Layout is - begin - if Value = fl_page_layout_portrait then - return Portrait; - elsif Value = fl_page_layout_landscape then - return Landscape; - elsif Value = fl_page_layout_reversed then - return Reversed; - else - pragma Assert (Value = fl_page_layout_orientation); - return Orientation; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end To_Page_Layout; - - - function Get_Page_Formats - return Page_Format_Info_Array - is - C_Name : Interfaces.C.Strings.chars_ptr; - C_Width : Interfaces.C.int; - C_Height : Interfaces.C.int; - begin - return Data : Page_Format_Info_Array (A0 .. To_Page_Format (fl_no_page_formats - 1)) do - for Index in Data'Range loop - fl_paged_device_get_page_format (To_Cint (Index), C_Name, C_Width, C_Height); - if C_Name = Interfaces.C.Strings.Null_Ptr then - Data (Index).My_Name := SU.To_Unbounded_String (""); - else - Data (Index).My_Name := SU.To_Unbounded_String - (Interfaces.C.Strings.Value (C_Name)); - end if; - Data (Index).My_Width := Natural (C_Width); - Data (Index).My_Height := Natural (C_Height); - end loop; - end return; - end Get_Page_Formats; - - - - - ---------------------------- - -- Datatype Subprograms -- - ---------------------------- - - function Name - (This : in Page_Format_Info) - return String is - begin - return SU.To_String (This.My_Name); - end Name; - - - function Width - (This : in Page_Format_Info) - return Natural is - begin - return This.My_Width; - end Width; - - - function Height - (This : in Page_Format_Info) - return Natural is - begin - return This.My_Height; - end Height; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out Paged_Device) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_paged_device (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - return Paged_Device is - begin - return This : Paged_Device do - This.Void_Ptr := new_fl_paged_device; - end return; - end Create; - - pragma Inline (Create); - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Start_Job - (This : in out Paged_Device; - Count : in Natural := 0) 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_Device; - Count : in Natural := 0; - From, To : out 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_Device) is - begin - fl_paged_device_end_job (This.Void_Ptr); - end End_Job; - - - procedure Start_Page - (This : in out Paged_Device) 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_Device) 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_Device; - 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_Device; - 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_Device; - 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_Device; - 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_Device; - 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_Device; - 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_Device; - 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_Device; - 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_Device) is - begin - fl_paged_device_untranslate (This.Void_Ptr); - end Untranslate; - - - - - procedure Print_Widget - (This : in out Paged_Device; - 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_Device; - 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_Device; - 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.Surface.Paged; - - diff --git a/src/fltk-devices-surface-paged.ads b/src/fltk-devices-surface-paged.ads deleted file mode 100644 index b445c62..0000000 --- a/src/fltk-devices-surface-paged.ads +++ /dev/null @@ -1,217 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Groups.Windows; - -private with - - Ada.Strings.Unbounded; - - -package FLTK.Devices.Surface.Paged is - - - pragma Elaborate_Body (FLTK.Devices.Surface.Paged); - - - type Paged_Device is new Surface_Device with private; - - type Paged_Device_Reference (Data : not null access Paged_Device'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, Media); - - - -- Note that the Name in the format information may not quite - -- correspond to the 'Image of the indexing Page_Format enumeration! - type Page_Format_Info is tagged private; - - function Name - (This : in Page_Format_Info) - return String; - - function Width - (This : in Page_Format_Info) - return Natural; - - function Height - (This : in Page_Format_Info) - return Natural; - - type Page_Format_Info_Array is array (Page_Format range <>) of Page_Format_Info; - - - type Page_Layout is - (Portrait, Landscape, Reversed, Orientation); - - - -- Information for everything except for Media - Page_Formats : constant Page_Format_Info_Array (A0 .. Envelope); - - - Page_Error : exception; - - - - - package Forge is - - -- Docs say there should be no reason to use this but it's here anyway. - function Create - return Paged_Device; - - end Forge; - - - - - procedure Start_Job - (This : in out Paged_Device; - Count : in Natural := 0); - - procedure Start_Job - (This : in out Paged_Device; - Count : in Natural := 0; - From, To : out Positive); - - procedure End_Job - (This : in out Paged_Device); - - procedure Start_Page - (This : in out Paged_Device); - - procedure End_Page - (This : in out Paged_Device); - - - - - procedure Get_Margins - (This : in Paged_Device; - Left, Top, Right, Bottom : out Integer); - - procedure Get_Printable_Rect - (This : in Paged_Device; - W, H : out Integer); - - procedure Get_Origin - (This : in Paged_Device; - X, Y : out Integer); - - procedure Set_Origin - (This : in out Paged_Device; - X, Y : in Integer); - - procedure Rotate - (This : in out Paged_Device; - Degrees : in Float); - - procedure Scale - (This : in out Paged_Device; - Factor : in Float); - - procedure Scale - (This : in out Paged_Device; - Factor_X, Factor_Y : in Float); - - procedure Translate - (This : in out Paged_Device; - Delta_X, Delta_Y : in Integer); - - procedure Untranslate - (This : in out Paged_Device); - - - - - procedure Print_Widget - (This : in out Paged_Device; - Item : in FLTK.Widgets.Widget'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Print_Window - (This : in out Paged_Device; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - Offset_X, Offset_Y : in Integer := 0); - - procedure Print_Window_Part - (This : in out Paged_Device; - Item : in FLTK.Widgets.Groups.Windows.Window'Class; - X, Y, W, H : in Integer; - Offset_X, Offset_Y : in Integer := 0); - - -private - - - type Paged_Device is new Surface_Device with null record; - - overriding procedure Finalize - (This : in out Paged_Device); - - - function To_Cint - (Value : in Page_Format) - return Interfaces.C.int; - - function To_Page_Format - (Value : in Interfaces.C.int) - return Page_Format; - - function To_Cint - (Value : in Page_Layout) - return Interfaces.C.int; - - function To_Page_Layout - (Value : in Interfaces.C.int) - return Page_Layout; - - - type Page_Format_Info is tagged record - My_Name : Ada.Strings.Unbounded.Unbounded_String; - My_Width : Natural; - My_Height : Natural; - end record; - - function Get_Page_Formats - return Page_Format_Info_Array; - - Page_Formats : constant Page_Format_Info_Array (A0 .. Envelope) := Get_Page_Formats; - - - pragma Inline (Name); - pragma Inline (Width); - pragma Inline (Height); - - 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.Surface.Paged; - - diff --git a/src/fltk-devices-surface.adb b/src/fltk-devices-surface.adb deleted file mode 100644 index a6ef6cc..0000000 --- a/src/fltk-devices-surface.adb +++ /dev/null @@ -1,180 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package body FLTK.Devices.Surface is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_surface_device - (G : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, new_fl_surface_device, "new_fl_surface_device"); - pragma Inline (new_fl_surface_device); - - procedure free_fl_surface_device - (S : in Storage.Integer_Address); - pragma Import (C, free_fl_surface_device, "free_fl_surface_device"); - pragma Inline (free_fl_surface_device); - - - - - procedure fl_surface_device_set_current - (S : in Storage.Integer_Address); - pragma Import (C, fl_surface_device_set_current, "fl_surface_device_set_current"); - pragma Inline (fl_surface_device_set_current); - - function fl_surface_device_get_surface - return Storage.Integer_Address; - pragma Import (C, fl_surface_device_get_surface, "fl_surface_device_get_surface"); - pragma Inline (fl_surface_device_get_surface); - - - - - function fl_surface_device_get_driver - (S : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_surface_device_get_driver, "fl_surface_device_get_driver"); - pragma Inline (fl_surface_device_get_driver); - - procedure fl_surface_device_set_driver - (S, G : in Storage.Integer_Address); - pragma Import (C, fl_surface_device_set_driver, "fl_surface_device_set_driver"); - pragma Inline (fl_surface_device_set_driver); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out Surface_Device) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_surface_device (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - 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_device (Wrapper (Graphics).Void_Ptr); - This.My_Driver := Graphics'Unchecked_Access; - end return; - end Create; - - end Forge; - - - - - ------------------------- - -- Static Attributes -- - ------------------------- - - Original_Surface : aliased Surface_Device; - Original_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver; - - Current_Surface : access Surface_Device'Class := Original_Surface'Access; - - - procedure Set_Current_Bookkeep - (Surface : in out Surface_Device'Class) is - begin - Current_Surface := Surface'Unchecked_Access; - end Set_Current_Bookkeep; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Current - return Surface_Device_Reference is - begin - return Ref : Surface_Device_Reference (Data => Current_Surface); - end Get_Current; - - - procedure Set_Current - (This : in out Surface_Device) is - begin - fl_surface_device_set_current (This.Void_Ptr); - This.Set_Current_Bookkeep; - end Set_Current; - - - function Get_Original - return Surface_Device_Reference is - begin - return Ref : Surface_Device_Reference (Data => Original_Surface'Access); - end Get_Original; - - - - - function Has_Driver - (This : in Surface_Device) - return Boolean is - begin - return This.My_Driver /= null and then - Wrapper (This.My_Driver.all).Void_Ptr /= Null_Pointer; - end Has_Driver; - - - function Get_Driver - (This : in out Surface_Device) - return FLTK.Devices.Graphics.Graphics_Driver_Reference is - begin - return Ref : FLTK.Devices.Graphics.Graphics_Driver_Reference (Data => This.My_Driver); - end Get_Driver; - - - procedure Set_Driver - (This : in out Surface_Device; - Driver : in out FLTK.Devices.Graphics.Graphics_Driver'Class) is - begin - fl_surface_device_set_driver (This.Void_Ptr, Wrapper (Driver).Void_Ptr); - This.My_Driver := Driver'Unchecked_Access; - end Set_Driver; - - -begin - - - Original_Surface.Void_Ptr := fl_surface_device_get_surface; - Original_Surface.Needs_Dealloc := False; - - Wrapper (Original_Graphics).Void_Ptr := - fl_surface_device_get_driver (Original_Surface.Void_Ptr); - Wrapper (Original_Graphics).Needs_Dealloc := False; - - Original_Surface.My_Driver := Original_Graphics'Access; - - -end FLTK.Devices.Surface; - - diff --git a/src/fltk-devices-surface.ads b/src/fltk-devices-surface.ads deleted file mode 100644 index f70d1e8..0000000 --- a/src/fltk-devices-surface.ads +++ /dev/null @@ -1,84 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Devices.Graphics; - - -package FLTK.Devices.Surface is - - - 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 Surface_Device_Reference; - - procedure Set_Current - (This : in out Surface_Device); - - function Get_Original - return Surface_Device_Reference; - - - - - function Has_Driver - (This : in Surface_Device) - return Boolean; - - function Get_Driver - (This : in out Surface_Device) - return FLTK.Devices.Graphics.Graphics_Driver_Reference; - - procedure Set_Driver - (This : in out Surface_Device; - Driver : in out FLTK.Devices.Graphics.Graphics_Driver'Class); - - -private - - - type Surface_Device is new Device with record - My_Driver : access FLTK.Devices.Graphics.Graphics_Driver'Class; - end record; - - overriding procedure Finalize - (This : in out Surface_Device); - - - procedure Set_Current_Bookkeep - (Surface : in out Surface_Device'Class) - with Inline; - - - pragma Inline (Get_Current); - pragma Inline (Get_Original); - - pragma Inline (Has_Driver); - pragma Inline (Get_Driver); - - -end FLTK.Devices.Surface; - - diff --git a/src/fltk-devices.ads b/src/fltk-devices.ads deleted file mode 100644 index d9ce5b1..0000000 --- a/src/fltk-devices.ads +++ /dev/null @@ -1,23 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Devices is - - - type Device is new Wrapper with private; - - type Device_Reference (Data : not null access Device'Class) is - limited null record with Implicit_Dereference => Data; - - -private - - - type Device is new Wrapper with null record; - - -end FLTK.Devices; - diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb deleted file mode 100644 index 79d34ff..0000000 --- a/src/fltk-draw.adb +++ /dev/null @@ -1,1897 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Ada.Unchecked_Deallocation, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.size_t; - - -package body FLTK.Draw is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - 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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - Alpha : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - Img : in Storage.Integer_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 Storage.Integer_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); - - -- this function does not yet exist - -- 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), - Null_Pointer); - 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; - else - pragma Assert (Result = 0); - return False; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - (Storage.To_Integer (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 Storage.Integer_Address; - X, Y, W : in Interfaces.C.int; - Buf_Ptr : in Storage.Integer_Address) - is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Storage.To_Address (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 - (Storage.To_Integer (Draw_Image_Hook'Address), - Null_Pointer, - 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 - (Storage.To_Integer (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 Storage.Integer_Address; - X, Y, W : in Interfaces.C.int; - Buf_Ptr : in Storage.Integer_Address) - is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Storage.To_Address (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 - (Storage.To_Integer (Draw_Image_Mono_Hook'Address), - Null_Pointer, - 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 : Storage.Integer_Address; - begin - Buffer := fl_draw_read_image - (Storage.To_Integer (Result (Result'First)'Address), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.int (Alpha)); - pragma Assert (Buffer = Storage.To_Integer (Result (Result'First)'Address)); - return Result; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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), - Storage.To_Integer (Callback.all'Address), - Boolean'Pos (Scalable)); - begin - if Ret_Val = 0 then - raise Draw_Error; - else - pragma Assert (Ret_Val = 1); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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), - Null_Pointer, - 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 Storage.Integer_Address; - N, X0, Y0 : in Interfaces.C.int) - is - Data : String (1 .. Integer (N)); - for Data'Address use Storage.To_Address (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), - Storage.To_Integer (Draw_Text_Hook'Address), - Null_Pointer, - 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), - Storage.To_Integer (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; - else - pragma Assert (Ret_Val = 1); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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), - Storage.To_Integer (Scroll_Hook'Address), - Storage.To_Integer (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 - null; - -- this function does not yet exist - -- 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 cedd4da..0000000 --- a/src/fltk-draw.ads +++ /dev/null @@ -1,621 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 22cf676..0000000 --- a/src/fltk-environment.adb +++ /dev/null @@ -1,1089 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Environment is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Constants From C -- - ------------------------ - - root_fl_prefs_system : constant Interfaces.C.int; - pragma Import (C, root_fl_prefs_system, "root_fl_prefs_system"); - - root_fl_prefs_user : constant Interfaces.C.int; - pragma Import (C, root_fl_prefs_user, "root_fl_prefs_user"); - - const_fl_path_max : constant Interfaces.C.int; - pragma Import (C, const_fl_path_max, "const_fl_path_max"); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function fl_preferences_new_uuid - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_preferences_new_uuid, "fl_preferences_new_uuid"); - pragma Inline (fl_preferences_new_uuid); - - - - - function new_fl_pref_database_path - (P, V, A : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_database_path, "new_fl_pref_database_path"); - pragma Inline (new_fl_pref_database_path); - - function new_fl_pref_database_scope - (S : in Interfaces.C.int; - V, A : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_database_scope, "new_fl_pref_database_scope"); - pragma Inline (new_fl_pref_database_scope); - - procedure upref_fl_pref_database - (P : in Storage.Integer_Address); - pragma Import (C, upref_fl_pref_database, "upref_fl_pref_database"); - pragma Inline (upref_fl_pref_database); - - procedure free_fl_pref_database - (E : in Storage.Integer_Address); - pragma Import (C, free_fl_pref_database, "free_fl_pref_database"); - pragma Inline (free_fl_pref_database); - - - - - function new_fl_pref_group_copy - (D : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_group_copy, "new_fl_pref_group_copy"); - pragma Inline (new_fl_pref_group_copy); - - function new_fl_pref_group_memory - (N : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_group_memory, "new_fl_pref_group_memory"); - pragma Inline (new_fl_pref_group_memory); - - function new_fl_pref_group_name - (G : in Storage.Integer_Address; - N : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_group_name, "new_fl_pref_group_name"); - pragma Inline (new_fl_pref_group_name); - - function new_fl_pref_group_index - (G : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, new_fl_pref_group_index, "new_fl_pref_group_index"); - pragma Inline (new_fl_pref_group_index); - - procedure free_fl_pref_group - (G : in Storage.Integer_Address); - pragma Import (C, free_fl_pref_group, "free_fl_pref_group"); - pragma Inline (free_fl_pref_group); - - - - - procedure fl_preferences_flush - (E : in Storage.Integer_Address); - pragma Import (C, fl_preferences_flush, "fl_preferences_flush"); - pragma Inline (fl_preferences_flush); - - function fl_preferences_getuserdatapath - (E : in Storage.Integer_Address; - P : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_getuserdatapath, "fl_preferences_getuserdatapath"); - pragma Inline (fl_preferences_getuserdatapath); - - - - - function fl_preferences_deleteentry - (E : in Storage.Integer_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 Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries"); - pragma Inline (fl_preferences_deleteallentries); - - function fl_preferences_deletegroup - (P : in Storage.Integer_Address; - G : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_deletegroup, "fl_preferences_deletegroup"); - pragma Inline (fl_preferences_deletegroup); - - function fl_preferences_deleteallgroups - (P : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_deleteallgroups, "fl_preferences_deleteallgroups"); - pragma Inline (fl_preferences_deleteallgroups); - - function fl_preferences_clear - (E : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_clear, "fl_preferences_clear"); - pragma Inline (fl_preferences_clear); - - - - - function fl_preferences_entries - (E : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_groups - (P : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_preferences_groups, "fl_preferences_groups"); - pragma Inline (fl_preferences_groups); - - function fl_preferences_group - (P : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_preferences_group, "fl_preferences_group"); - pragma Inline (fl_preferences_group); - - function fl_preferences_groupexists - (P : in Storage.Integer_Address; - G : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_preferences_groupexists, "fl_preferences_groupexists"); - pragma Inline (fl_preferences_groupexists); - - - - - function fl_preferences_name - (P : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_preferences_name, "fl_preferences_name"); - pragma Inline (fl_preferences_name); - - function fl_preferences_path - (P : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_preferences_path, "fl_preferences_path"); - pragma Inline (fl_preferences_path); - - - - - function fl_preferences_get_int - (E : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_get_str_limit - (E : in Storage.Integer_Address; - K : in Interfaces.C.char_array; - V : in Interfaces.C.char_array; - D : in Interfaces.C.char_array; - M : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_str_limit, "fl_preferences_get_str_limit"); - pragma Inline (fl_preferences_get_str_limit); - - function fl_preferences_get_void - (E : in Storage.Integer_Address; - K : in Interfaces.C.char_array; - V : out Storage.Integer_Address; - D : in Storage.Integer_Address; - DS : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_void, "fl_preferences_get_void"); - pragma Inline (fl_preferences_get_void); - - function fl_preferences_get_void_limit - (E : in Storage.Integer_Address; - K : in Interfaces.C.char_array; - V, D : in Storage.Integer_Address; - DS, MS : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_get_void_limit, "fl_preferences_get_void_limit"); - pragma Inline (fl_preferences_get_void_limit); - - procedure free_fl_preferences_void_data - (V : in Storage.Integer_Address); - pragma Import (C, free_fl_preferences_void_data, "free_fl_preferences_void_data"); - pragma Inline (free_fl_preferences_void_data); - - - - - function fl_preferences_set_int - (E : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_set_void - (E : in Storage.Integer_Address; - K : in Interfaces.C.char_array; - D : in Storage.Integer_Address; - DS : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_preferences_set_void, "fl_preferences_set_void"); - pragma Inline (fl_preferences_set_void); - - - - - ------------------------ - -- Internal Utility -- - ------------------------ - - function To_Cint - (Extent : in Scope) - return Interfaces.C.int is - begin - case Extent is - when Global => - return root_fl_prefs_system; - when User => - return root_fl_prefs_user; - end case; - end To_Cint; - - function To_Scope - (Num : in Interfaces.C.int) - return Scope is - begin - if Num = root_fl_prefs_system then - return Global; - else - pragma Assert (Num = root_fl_prefs_user); - return User; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end To_Scope; - - - - - ----------------------------------- - -- Controlled Type Subprograms -- - ----------------------------------- - - procedure Finalize - (This : in out Database) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_pref_database (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - procedure Finalize - (This : in out Pref_Group) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_pref_group (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - if This.Root_Ptr /= Null_Pointer then - free_fl_pref_database (This.Root_Ptr); - end if; - end if; - end Finalize; - - - - - ----------------------- - -- Preferences API -- - ----------------------- - - function New_UUID - return String - is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_new_uuid; - begin - return Interfaces.C.Strings.Value (Text); - end New_UUID; - - - - - package body Forge is - - - function From_Filesystem - (Directory, Vendor, Application : in String) - return Database is - begin - return This : Database do - This.Void_Ptr := new_fl_pref_database_path - (Interfaces.C.To_C (Directory), - Interfaces.C.To_C (Vendor), - Interfaces.C.To_C (Application)); - end return; - end From_Filesystem; - - - function From_Scope - (Extent : in Scope; - Vendor, Application : in String) - return Database is - begin - return This : Database do - This.Void_Ptr := new_fl_pref_database_scope - (To_Cint (Extent), - Interfaces.C.To_C (Vendor), - Interfaces.C.To_C (Application)); - end return; - end From_Scope; - - - function Root - (From : in Database) - return Pref_Group'Class is - begin - return Result : Pref_Group do - Result.Void_Ptr := new_fl_pref_group_copy (From.Void_Ptr); - Result.Root_Ptr := From.Void_Ptr; - upref_fl_pref_database (Result.Root_Ptr); - end return; - end Root; - - - function In_Memory - (Name : in String) - return Pref_Group is - begin - return Result : Pref_Group do - Result.Void_Ptr := new_fl_pref_group_memory (Interfaces.C.To_C (Name)); - Result.Root_Ptr := Null_Pointer; - end return; - end In_Memory; - - - function By_Name - (From : in Pref_Group; - Name : in String) - return Pref_Group'Class is - begin - return Result : Pref_Group do - Result.Void_Ptr := new_fl_pref_group_name - (From.Void_Ptr, - Interfaces.C.To_C (Name)); - Result.Root_Ptr := From.Root_Ptr; - if Result.Root_Ptr /= Null_Pointer then - upref_fl_pref_database (Result.Root_Ptr); - end if; - end return; - end By_Name; - - - function By_Index - (From : in Pref_Group; - Index : in Positive) - return Pref_Group'Class is - begin - return Result : Pref_Group do - Result.Void_Ptr := new_fl_pref_group_index - (From.Void_Ptr, - Interfaces.C.int (Index - 1)); - Result.Root_Ptr := From.Root_Ptr; - if Result.Root_Ptr /= Null_Pointer then - upref_fl_pref_database (Result.Root_Ptr); - end if; - end return; - end By_Index; - - - end Forge; - - - - - procedure Flush - (This : in Database) is - begin - fl_preferences_flush (This.Void_Ptr); - end Flush; - - - function Userdata_Path - (This : in Database) - return String - is - Buffer : Interfaces.C.char_array := - (1 .. Interfaces.C.size_t (const_fl_path_max + 1) => ' '); - begin - if fl_preferences_getuserdatapath - (This.Void_Ptr, - Buffer, - const_fl_path_max) = 0 - then - raise Preference_Error; - end if; - return Interfaces.C.To_Ada (Buffer); - end Userdata_Path; - - - - - procedure Delete_Entry - (This : in out Pref_Group; - 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 Pref_Group) is - begin - if fl_preferences_deleteallentries (This.Void_Ptr) = 0 then - raise Preference_Error; - end if; - end Delete_All_Entries; - - - procedure Delete_Group - (This : in out Pref_Group; - Name : in String) is - begin - if fl_preferences_deletegroup (This.Void_Ptr, Interfaces.C.To_C (Name)) = 0 then - raise Preference_Error; - end if; - end Delete_Group; - - - procedure Delete_All_Groups - (This : in out Pref_Group) is - begin - if fl_preferences_deleteallgroups (This.Void_Ptr) = 0 then - raise Preference_Error; - end if; - end Delete_All_Groups; - - - procedure Clear - (This : in out Pref_Group) is - begin - if fl_preferences_clear (This.Void_Ptr) = 0 then - raise Preference_Error; - end if; - end Clear; - - - - - function Number_Of_Entries - (This : in Pref_Group) - return Natural is - begin - return Natural (fl_preferences_entries (This.Void_Ptr)); - end Number_Of_Entries; - - - function Entry_Key - (This : in Pref_Group; - Index : in Positive) - return String - is - Key : Interfaces.C.Strings.chars_ptr := - fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index) - 1); - begin - -- no need for dealloc? - if Key = Interfaces.C.Strings.Null_Ptr then - raise Preference_Error; - else - return Interfaces.C.Strings.Value (Key); - end if; - end Entry_Key; - - - function Key_Exists - (This : in Pref_Group; - Key : in String) - return Boolean is - begin - return fl_preferences_entryexists (This.Void_Ptr, Interfaces.C.To_C (Key)) /= 0; - end Key_Exists; - - - function Value_Size - (This : in Pref_Group; - Key : in String) - return Natural is - begin - return Natural (fl_preferences_size (This.Void_Ptr, Interfaces.C.To_C (Key))); - end Value_Size; - - - - - function Number_Of_Groups - (This : in Pref_Group) - return Natural is - begin - return Natural (fl_preferences_groups (This.Void_Ptr)); - end Number_Of_Groups; - - - function Group_Name - (This : in Pref_Group; - Index : in Positive) - return String - is - Name : Interfaces.C.Strings.chars_ptr := - fl_preferences_group (This.Void_Ptr, Interfaces.C.int (Index) - 1); - begin - -- no need for dealloc? - if Name = Interfaces.C.Strings.Null_Ptr then - raise Preference_Error; - else - return Interfaces.C.Strings.Value (Name); - end if; - end Group_Name; - - - function Group_Exists - (This : in Pref_Group; - Name : in String) - return Boolean is - begin - return fl_preferences_groupexists (This.Void_Ptr, Interfaces.C.To_C (Name)) /= 0; - end Group_Exists; - - - - - function At_Name - (This : in Pref_Group) - return String - is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_name (This.Void_Ptr); - begin - if Text = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Text); - end if; - end At_Name; - - - function At_Path - (This : in Pref_Group) - return String - is - Text : Interfaces.C.Strings.chars_ptr := fl_preferences_path (This.Void_Ptr); - begin - if Text = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Text); - end if; - end At_Path; - - - - - function Get - (This : in Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - Key : in String) - return String - is - Text : Interfaces.C.Strings.chars_ptr; - Check : Interfaces.C.int := fl_preferences_get_str - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Text, - Interfaces.C.To_C ("default")); - begin - if Check = 0 then - raise Preference_Error; - end if; - if Text = Interfaces.C.Strings.Null_Ptr then - return ""; - end if; - return Str : String := Interfaces.C.Strings.Value (Text) do - Interfaces.C.Strings.Free (Text); - end return; - end Get; - - - function Get - (This : in Pref_Group; - Key : in String; - Default : in String) - return String - is - Text : Interfaces.C.Strings.chars_ptr; - X : Interfaces.C.int := fl_preferences_get_str - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Text, - Interfaces.C.To_C (Default)); - begin - if Text = Interfaces.C.Strings.Null_Ptr then - return Default; - end if; - return Str : String := Interfaces.C.Strings.Value (Text) do - Interfaces.C.Strings.Free (Text); - end return; - end Get; - - - function Get - (This : in Pref_Group; - Key : in String; - Default : in String; - Max_Length : in Natural) - return String - is - Text : Interfaces.C.char_array := (1 .. Interfaces.C.size_t (Max_Length + 1) => ' '); - Check : Interfaces.C.int := fl_preferences_get_str_limit - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Text, - Interfaces.C.To_C (Default), - Interfaces.C.int (Max_Length)); - begin - if Check = 0 then - return Default; - else - return Interfaces.C.To_Ada (Text); - end if; - end Get; - - - function Get - (This : in Pref_Group; - Key : in String) - return Binary_Data - is - Thing : Storage.Integer_Address; - Dummy : Interfaces.C.int := 42; - Check : Interfaces.C.int := fl_preferences_get_void - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Thing, - Storage.To_Integer (Dummy'Address), - 1); - begin - if Check = 0 then - free_fl_preferences_void_data (Thing); - raise Preference_Error; - end if; - declare - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); - Actual : Binary_Data (1 .. Length); - for Actual'Address use Storage.To_Address (Thing); - pragma Import (Ada, Actual); - begin - return Result : Binary_Data := Actual do - free_fl_preferences_void_data (Thing); - end return; - end; - end Get; - - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Binary_Data) - return Binary_Data - is - Thing : Storage.Integer_Address; - Ignore : Interfaces.C.int := fl_preferences_get_void - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Thing, - Storage.To_Integer (Default'Address), - Default'Length / Interfaces.C.int (c_pointer_size)); - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); - Actual : Binary_Data (1 .. Length); - for Actual'Address use Storage.To_Address (Thing); - pragma Import (Ada, Actual); - begin - return Result : Binary_Data := Actual do - free_fl_preferences_void_data (Thing); - end return; - end Get; - - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Binary_Data; - Max_Length : in Natural) - return Binary_Data - is - Actual : Binary_Data (1 .. Max_Length); - Ignore : Interfaces.C.int := fl_preferences_get_void_limit - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Storage.To_Integer (Actual'Address), - Storage.To_Integer (Default'Address), - Default'Length / Interfaces.C.int (c_pointer_size), - Interfaces.C.int (Max_Length) / Interfaces.C.int (c_pointer_size)); - Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size); - begin - return Actual (1 .. Length); - end Get; - - - - - procedure Set - (This : in out Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Pref_Group; - 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 Set - (This : in out Pref_Group; - Key : in String; - Value : in Binary_Data) is - begin - if fl_preferences_set_void - (This.Void_Ptr, - Interfaces.C.To_C (Key), - Storage.To_Integer (Value'Address), - Value'Length / Interfaces.C.int (c_pointer_size)) = 0 - then - raise Preference_Error; - end if; - end Set; - - -end FLTK.Environment; - diff --git a/src/fltk-environment.ads b/src/fltk-environment.ads deleted file mode 100644 index 4bb807b..0000000 --- a/src/fltk-environment.ads +++ /dev/null @@ -1,344 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces; - -private with - - Interfaces.C; - - -package FLTK.Environment is - - - type Database is new Wrapper with private; - - type Database_Reference (Data : not null access Database'Class) is - limited null record with Implicit_Dereference => Data; - - type Pref_Group is new Wrapper with private; - - type Pref_Group_Reference (Data : not null access Pref_Group'Class) is - limited null record with Implicit_Dereference => Data; - - type Scope is (Global, User); - - type Binary_Data is array (Positive range <>) of Interfaces.Unsigned_8; - - - Preference_Error : exception; - - - - - function New_UUID - return String; - - - - - package Forge is - - function From_Filesystem - (Directory, Vendor, Application : in String) - return Database; - - function From_Scope - (Extent : in Scope; - Vendor, Application : in String) - return Database; - - function Root - (From : in Database) - return Pref_Group'Class; - - function In_Memory - (Name : in String) - return Pref_Group; - - function By_Name - (From : in Pref_Group; - Name : in String) - return Pref_Group'Class; - - function By_Index - (From : in Pref_Group; - Index : in Positive) - return Pref_Group'Class; - - end Forge; - - - - - procedure Flush - (This : in Database); - - function Userdata_Path - (This : in Database) - return String; - - - - - procedure Delete_Entry - (This : in out Pref_Group; - Key : in String) - with Post => This.Key_Exists (Key) = False; - - procedure Delete_All_Entries - (This : in out Pref_Group) - with Post => This.Number_Of_Entries = 0; - - procedure Delete_Group - (This : in out Pref_Group; - Name : in String) - with Post => This.Group_Exists (Name) = False; - - procedure Delete_All_Groups - (This : in out Pref_Group) - with Post => This.Number_Of_Groups = 0; - - procedure Clear - (This : in out Pref_Group) - with Post => This.Number_Of_Entries = 0 and - This.Number_Of_Groups = 0; - - - - - function Number_Of_Entries - (This : in Pref_Group) - return Natural; - - function Entry_Key - (This : in Pref_Group; - Index : in Positive) - return String - with Pre => Index in 1 .. This.Number_Of_Entries; - - function Key_Exists - (This : in Pref_Group; - Key : in String) - return Boolean; - - function Value_Size - (This : in Pref_Group; - Key : in String) - return Natural; - - - - - function Number_Of_Groups - (This : in Pref_Group) - return Natural; - - function Group_Name - (This : in Pref_Group; - Index : in Positive) - return String - with Pre => Index in 1 .. This.Number_Of_Groups; - - function Group_Exists - (This : in Pref_Group; - Name : in String) - return Boolean; - - - - - function At_Name - (This : in Pref_Group) - return String; - - function At_Path - (This : in Pref_Group) - return String; - - - - - function Get - (This : in Pref_Group; - Key : in String) - return Integer; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Integer) - return Integer; - - function Get - (This : in Pref_Group; - Key : in String) - return Float; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Float) - return Float; - - function Get - (This : in Pref_Group; - Key : in String) - return Long_Float; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Long_Float) - return Long_Float; - - function Get - (This : in Pref_Group; - Key : in String) - return String; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in String) - return String; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in String; - Max_Length : in Natural) - return String - with Post => Get'Result'Length <= Max_Length; - - function Get - (This : in Pref_Group; - Key : in String) - return Binary_Data; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Binary_Data) - return Binary_Data; - - function Get - (This : in Pref_Group; - Key : in String; - Default : in Binary_Data; - Max_Length : in Natural) - return Binary_Data - with Post => Get'Result'Length <= Max_Length; - - - - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Integer) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Float) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Float; - Precision : in Natural) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Long_Float) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Long_Float; - Precision : in Natural) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in String) - with Post => This.Key_Exists (Key); - - procedure Set - (This : in out Pref_Group; - Key : in String; - Value : in Binary_Data) - with Post => This.Key_Exists (Key); - - -private - - - type Database is new Wrapper with null record; - - overriding procedure Finalize - (This : in out Database); - - - type Pref_Group is new Wrapper with record - Root_Ptr : Storage.Integer_Address := Null_Pointer; - end record; - - overriding procedure Finalize - (This : in out Pref_Group); - - - pragma Convention (C, Binary_Data); - pragma Pack (Binary_Data); - for Binary_Data'Component_Size use Interfaces.C.CHAR_BIT; - - - pragma Inline (New_UUID); - - pragma Inline (Flush); - - pragma Inline (Delete_Entry); - pragma Inline (Delete_All_Entries); - pragma Inline (Delete_Group); - pragma Inline (Delete_All_Groups); - pragma Inline (Clear); - - pragma Inline (Number_Of_Entries); - pragma Inline (Entry_Key); - pragma Inline (Key_Exists); - pragma Inline (Value_Size); - - pragma Inline (Number_Of_Groups); - pragma Inline (Group_Name); - pragma Inline (Group_Exists); - - pragma Inline (At_Name); - pragma Inline (At_Path); - - pragma Inline (Set); - - - function To_Cint - (Extent : in Scope) - return Interfaces.C.int; - - function To_Scope - (Num : in Interfaces.C.int) - return Scope; - - -end FLTK.Environment; - - diff --git a/src/fltk-errors.adb b/src/fltk-errors.adb deleted file mode 100644 index ef31002..0000000 --- a/src/fltk-errors.adb +++ /dev/null @@ -1,101 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Errors is - - - procedure fl_error_default_warning - (M : in Interfaces.C.char_array); - pragma Import (C, fl_error_default_warning, "fl_error_default_warning"); - pragma Inline (fl_error_default_warning); - - procedure fl_error_default_error - (M : in Interfaces.C.char_array); - pragma Import (C, fl_error_default_error, "fl_error_default_error"); - pragma Inline (fl_error_default_error); - - procedure fl_error_default_fatal - (M : in Interfaces.C.char_array); - pragma Import (C, fl_error_default_fatal, "fl_error_default_fatal"); - pragma Inline (fl_error_default_fatal); - - procedure fl_error_set_hooks; - pragma Import (C, fl_error_set_hooks, "fl_error_set_hooks"); - pragma Inline (fl_error_set_hooks); - - - - - procedure Warning_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, Warning_Hook, "error_warning_hook"); - - procedure Warning_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr) is - begin - Current_Warning (Interfaces.C.Strings.Value (C_Mess)); - end Warning_Hook; - - - procedure Error_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, Error_Hook, "error_error_hook"); - - procedure Error_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr) is - begin - Current_Error (Interfaces.C.Strings.Value (C_Mess)); - end Error_Hook; - - - procedure Fatal_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, Fatal_Hook, "error_fatal_hook"); - - procedure Fatal_Hook - (C_Mess : in Interfaces.C.Strings.chars_ptr) is - begin - Current_Fatal (Interfaces.C.Strings.Value (C_Mess)); - end Fatal_Hook; - - - - - procedure Default_Warning - (Message : in String) is - begin - fl_error_default_warning (Interfaces.C.To_C (Message)); - end Default_Warning; - - - procedure Default_Error - (Message : in String) is - begin - fl_error_default_error (Interfaces.C.To_C (Message)); - end Default_Error; - - - procedure Default_Fatal - (Message : in String) is - begin - fl_error_default_fatal (Interfaces.C.To_C (Message)); - end Default_Fatal; - - -begin - - - fl_error_set_hooks; - - -end FLTK.Errors; - - diff --git a/src/fltk-errors.ads b/src/fltk-errors.ads deleted file mode 100644 index 6cdea54..0000000 --- a/src/fltk-errors.ads +++ /dev/null @@ -1,39 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Errors is - - - type Error_Function is not null access procedure - (Message : in String); - - - procedure Default_Warning - (Message : in String); - - procedure Default_Error - (Message : in String); - - procedure Default_Fatal - (Message : in String); - - - Current_Warning : Error_Function := Default_Warning'Access; - Current_Error : Error_Function := Default_Error'Access; - Current_Fatal : Error_Function := Default_Fatal'Access; - - -private - - - pragma Inline (Default_Warning); - pragma Inline (Default_Error); - pragma Inline (Default_Fatal); - - -end FLTK.Errors; - - diff --git a/src/fltk-event.adb b/src/fltk-event.adb deleted file mode 100644 index c4933b4..0000000 --- a/src/fltk-event.adb +++ /dev/null @@ -1,696 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Event is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - procedure fl_event_add_handler - (F : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_event_set_grab, "fl_event_set_grab"); - pragma Inline (fl_event_set_grab); - - function fl_event_get_pushed - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_event_set_pushed, "fl_event_set_pushed"); - pragma Inline (fl_event_set_pushed); - - function fl_event_get_belowmouse - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_event_set_belowmouse, "fl_event_set_belowmouse"); - pragma Inline (fl_event_set_belowmouse); - - function fl_event_get_focus - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - -- return Interfaces.C.int - -- is - -- Ret_Val : Event_Outcome; - -- Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - -- begin - -- if Ptr /= Null_Pointer then - -- Actual_Window := Window_Convert.To_Pointer - -- (Storage.To_Address (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), Null_Pointer)); - -- 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 - Grab_Ptr : Storage.Integer_Address := fl_event_get_grab; - Actual_Grab : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Grab_Ptr /= Null_Pointer then - Grab_Ptr := fl_widget_get_user_data (Grab_Ptr); - pragma Assert (Grab_Ptr /= Null_Pointer); - Actual_Grab := Window_Convert.To_Pointer (Storage.To_Address (Grab_Ptr)); - end if; - return Actual_Grab; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 (Null_Pointer); - end Release_Grab; - - - function Get_Pushed - return access FLTK.Widgets.Widget'Class - is - Pushed_Ptr : Storage.Integer_Address := fl_event_get_pushed; - Actual_Pushed : access FLTK.Widgets.Widget'Class; - begin - if Pushed_Ptr /= Null_Pointer then - Pushed_Ptr := fl_widget_get_user_data (Pushed_Ptr); - pragma Assert (Pushed_Ptr /= Null_Pointer); - Actual_Pushed := Widget_Convert.To_Pointer (Storage.To_Address (Pushed_Ptr)); - end if; - return Actual_Pushed; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Below_Ptr : Storage.Integer_Address := fl_event_get_belowmouse; - Actual_Below : access FLTK.Widgets.Widget'Class; - begin - if Below_Ptr /= Null_Pointer then - Below_Ptr := fl_widget_get_user_data (Below_Ptr); - pragma Assert (Below_Ptr /= Null_Pointer); - Actual_Below := Widget_Convert.To_Pointer (Storage.To_Address (Below_Ptr)); - end if; - return Actual_Below; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Focus_Ptr : Storage.Integer_Address := fl_event_get_focus; - Actual_Focus : access FLTK.Widgets.Widget'Class; - begin - if Focus_Ptr /= Null_Pointer then - Focus_Ptr := fl_widget_get_user_data (Focus_Ptr); - pragma Assert (Focus_Ptr /= Null_Pointer); - Actual_Focus := Widget_Convert.To_Pointer (Storage.To_Address (Focus_Ptr)); - end if; - return Actual_Focus; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 (Storage.To_Integer (Event_Handler_Hook'Address)); - -- fl_event_set_event_dispatch (Storage.To_Integer (Dispatch_Hook'Address)); - - -end FLTK.Event; - diff --git a/src/fltk-event.ads b/src/fltk-event.ads deleted file mode 100644 index 3b0dec9..0000000 --- a/src/fltk-event.ads +++ /dev/null @@ -1,267 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Storage.Integer_Address) - return Storage.Integer_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-file_choosers.adb b/src/fltk-file_choosers.adb deleted file mode 100644 index 3eee496..0000000 --- a/src/fltk-file_choosers.adb +++ /dev/null @@ -1,1306 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.File_Choosers is - - - package Chk renames Ada.Assertions; - - package File_Chooser_Convert is new System.Address_To_Access_Conversions (File_Chooser'Class); - package Widget_Convert is new System.Address_To_Access_Conversions (Widgets.Widget'Class); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function fl_widget_get_user_data - (W : in Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); - pragma Inline (fl_widget_set_user_data); - - function fl_file_chooser_get_user_data - (F : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_get_user_data, "fl_file_chooser_get_user_data"); - pragma Inline (fl_file_chooser_get_user_data); - - procedure fl_file_chooser_set_user_data - (F, U : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_set_user_data, "fl_file_chooser_set_user_data"); - pragma Inline (fl_file_chooser_set_user_data); - - - - - procedure file_chooser_setup_sort_hook; - pragma Import (C, file_chooser_setup_sort_hook, "file_chooser_setup_sort_hook"); - pragma Inline (file_chooser_setup_sort_hook); - - - - - function new_fl_file_chooser - (N, P : in Interfaces.C.char_array; - K : in Interfaces.C.int; - T : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_file_chooser, "new_fl_file_chooser"); - pragma Inline (new_fl_file_chooser); - - procedure free_fl_file_chooser - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_file_chooser, "free_fl_file_chooser"); - pragma Inline (free_fl_file_chooser); - - - - - function fl_file_chooser_newbutton - (F : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_newbutton, "fl_file_chooser_newbutton"); - pragma Inline (fl_file_chooser_newbutton); - - function fl_file_chooser_previewbutton - (F : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_previewbutton, "fl_file_chooser_previewbutton"); - pragma Inline (fl_file_chooser_previewbutton); - - function fl_file_chooser_showhiddenbutton - (F : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_showhiddenbutton, "fl_file_chooser_showhiddenbutton"); - pragma Inline (fl_file_chooser_showhiddenbutton); - - - - - function fl_file_chooser_get_add_favorites_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_add_favorites_label, - "fl_file_chooser_get_add_favorites_label"); - pragma Inline (fl_file_chooser_get_add_favorites_label); - - procedure fl_file_chooser_set_add_favorites_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_add_favorites_label, - "fl_file_chooser_set_add_favorites_label"); - pragma Inline (fl_file_chooser_set_add_favorites_label); - - function fl_file_chooser_get_all_files_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_all_files_label, "fl_file_chooser_get_all_files_label"); - pragma Inline (fl_file_chooser_get_all_files_label); - - procedure fl_file_chooser_set_all_files_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_all_files_label, "fl_file_chooser_set_all_files_label"); - pragma Inline (fl_file_chooser_set_all_files_label); - - function fl_file_chooser_get_custom_filter_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_custom_filter_label, - "fl_file_chooser_get_custom_filter_label"); - pragma Inline (fl_file_chooser_get_custom_filter_label); - - procedure fl_file_chooser_set_custom_filter_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_custom_filter_label, - "fl_file_chooser_set_custom_filter_label"); - pragma Inline (fl_file_chooser_set_custom_filter_label); - - function fl_file_chooser_get_existing_file_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_existing_file_label, - "fl_file_chooser_get_existing_file_label"); - pragma Inline (fl_file_chooser_get_existing_file_label); - - procedure fl_file_chooser_set_existing_file_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_existing_file_label, - "fl_file_chooser_set_existing_file_label"); - pragma Inline (fl_file_chooser_set_existing_file_label); - - function fl_file_chooser_get_favorites_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_favorites_label, "fl_file_chooser_get_favorites_label"); - pragma Inline (fl_file_chooser_get_favorites_label); - - procedure fl_file_chooser_set_favorites_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_favorites_label, "fl_file_chooser_set_favorites_label"); - pragma Inline (fl_file_chooser_set_favorites_label); - - function fl_file_chooser_get_filename_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_filename_label, "fl_file_chooser_get_filename_label"); - pragma Inline (fl_file_chooser_get_filename_label); - - procedure fl_file_chooser_set_filename_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_filename_label, "fl_file_chooser_set_filename_label"); - pragma Inline (fl_file_chooser_set_filename_label); - - function fl_file_chooser_get_filesystems_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_filesystems_label, - "fl_file_chooser_get_filesystems_label"); - pragma Inline (fl_file_chooser_get_filesystems_label); - - procedure fl_file_chooser_set_filesystems_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_filesystems_label, - "fl_file_chooser_set_filesystems_label"); - pragma Inline (fl_file_chooser_set_filesystems_label); - - function fl_file_chooser_get_hidden_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_hidden_label, "fl_file_chooser_get_hidden_label"); - pragma Inline (fl_file_chooser_get_hidden_label); - - procedure fl_file_chooser_set_hidden_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_hidden_label, "fl_file_chooser_set_hidden_label"); - pragma Inline (fl_file_chooser_set_hidden_label); - - function fl_file_chooser_get_manage_favorites_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_manage_favorites_label, - "fl_file_chooser_get_manage_favorites_label"); - pragma Inline (fl_file_chooser_get_manage_favorites_label); - - procedure fl_file_chooser_set_manage_favorites_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_manage_favorites_label, - "fl_file_chooser_set_manage_favorites_label"); - pragma Inline (fl_file_chooser_set_manage_favorites_label); - - function fl_file_chooser_get_new_directory_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_new_directory_label, - "fl_file_chooser_get_new_directory_label"); - pragma Inline (fl_file_chooser_get_new_directory_label); - - procedure fl_file_chooser_set_new_directory_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_new_directory_label, - "fl_file_chooser_set_new_directory_label"); - pragma Inline (fl_file_chooser_set_new_directory_label); - - function fl_file_chooser_get_new_directory_tooltip - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_new_directory_tooltip, - "fl_file_chooser_get_new_directory_tooltip"); - pragma Inline (fl_file_chooser_get_new_directory_tooltip); - - procedure fl_file_chooser_set_new_directory_tooltip - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_new_directory_tooltip, - "fl_file_chooser_set_new_directory_tooltip"); - pragma Inline (fl_file_chooser_set_new_directory_tooltip); - - function fl_file_chooser_get_preview_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_preview_label, "fl_file_chooser_get_preview_label"); - pragma Inline (fl_file_chooser_get_preview_label); - - procedure fl_file_chooser_set_preview_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_preview_label, "fl_file_chooser_set_preview_label"); - pragma Inline (fl_file_chooser_set_preview_label); - - function fl_file_chooser_get_save_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_save_label, "fl_file_chooser_get_save_label"); - pragma Inline (fl_file_chooser_get_save_label); - - procedure fl_file_chooser_set_save_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_save_label, "fl_file_chooser_set_save_label"); - pragma Inline (fl_file_chooser_set_save_label); - - function fl_file_chooser_get_show_label - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_show_label, "fl_file_chooser_get_show_label"); - pragma Inline (fl_file_chooser_get_show_label); - - procedure fl_file_chooser_set_show_label - (V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_show_label, "fl_file_chooser_set_show_label"); - pragma Inline (fl_file_chooser_set_show_label); - - - - - function fl_file_chooser_add_extra - (F, W : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_chooser_add_extra, "fl_file_chooser_add_extra"); - pragma Inline (fl_file_chooser_add_extra); - - procedure fl_file_chooser_callback - (F, C, U : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_callback, "fl_file_chooser_callback"); - pragma Inline (fl_file_chooser_callback); - - - - - function fl_file_chooser_get_color - (F : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_file_chooser_get_color, "fl_file_chooser_get_color"); - pragma Inline (fl_file_chooser_get_color); - - procedure fl_file_chooser_set_color - (F : in Storage.Integer_Address; - V : in Interfaces.C.unsigned); - pragma Import (C, fl_file_chooser_set_color, "fl_file_chooser_set_color"); - pragma Inline (fl_file_chooser_set_color); - - function fl_file_chooser_get_iconsize - (F : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_file_chooser_get_iconsize, "fl_file_chooser_get_iconsize"); - pragma Inline (fl_file_chooser_get_iconsize); - - procedure fl_file_chooser_set_iconsize - (F : in Storage.Integer_Address; - V : in Interfaces.C.unsigned_char); - pragma Import (C, fl_file_chooser_set_iconsize, "fl_file_chooser_set_iconsize"); - pragma Inline (fl_file_chooser_set_iconsize); - - function fl_file_chooser_get_label - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_label, "fl_file_chooser_get_label"); - pragma Inline (fl_file_chooser_get_label); - - procedure fl_file_chooser_set_label - (F : in Storage.Integer_Address; - V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_label, "fl_file_chooser_set_label"); - pragma Inline (fl_file_chooser_set_label); - - function fl_file_chooser_get_ok_label - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_ok_label, "fl_file_chooser_get_ok_label"); - pragma Inline (fl_file_chooser_get_ok_label); - - procedure fl_file_chooser_set_ok_label - (F : in Storage.Integer_Address; - V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_ok_label, "fl_file_chooser_set_ok_label"); - pragma Inline (fl_file_chooser_set_ok_label); - - function fl_file_chooser_get_preview - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_get_preview, "fl_file_chooser_get_preview"); - pragma Inline (fl_file_chooser_get_preview); - - procedure fl_file_chooser_set_preview - (F : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_chooser_set_preview, "fl_file_chooser_set_preview"); - pragma Inline (fl_file_chooser_set_preview); - - function fl_file_chooser_get_textcolor - (F : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_file_chooser_get_textcolor, "fl_file_chooser_get_textcolor"); - pragma Inline (fl_file_chooser_get_textcolor); - - procedure fl_file_chooser_set_textcolor - (F : in Storage.Integer_Address; - V : in Interfaces.C.unsigned); - pragma Import (C, fl_file_chooser_set_textcolor, "fl_file_chooser_set_textcolor"); - pragma Inline (fl_file_chooser_set_textcolor); - - function fl_file_chooser_get_textfont - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_get_textfont, "fl_file_chooser_get_textfont"); - pragma Inline (fl_file_chooser_get_textfont); - - procedure fl_file_chooser_set_textfont - (F : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_chooser_set_textfont, "fl_file_chooser_set_textfont"); - pragma Inline (fl_file_chooser_set_textfont); - - function fl_file_chooser_get_textsize - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_get_textsize, "fl_file_chooser_get_textsize"); - pragma Inline (fl_file_chooser_get_textsize); - - procedure fl_file_chooser_set_textsize - (F : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_chooser_set_textsize, "fl_file_chooser_set_textsize"); - pragma Inline (fl_file_chooser_set_textsize); - - function fl_file_chooser_get_type - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_get_type, "fl_file_chooser_get_type"); - pragma Inline (fl_file_chooser_get_type); - - procedure fl_file_chooser_set_type - (F : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_chooser_set_type, "fl_file_chooser_set_type"); - pragma Inline (fl_file_chooser_set_type); - - - - - function fl_file_chooser_count - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_count, "fl_file_chooser_count"); - pragma Inline (fl_file_chooser_count); - - function fl_file_chooser_get_directory - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_directory, "fl_file_chooser_get_directory"); - pragma Inline (fl_file_chooser_get_directory); - - procedure fl_file_chooser_set_directory - (F : in Storage.Integer_Address; - V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_directory, "fl_file_chooser_set_directory"); - pragma Inline (fl_file_chooser_set_directory); - - function fl_file_chooser_get_filter - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_filter, "fl_file_chooser_get_filter"); - pragma Inline (fl_file_chooser_get_filter); - - procedure fl_file_chooser_set_filter - (F : in Storage.Integer_Address; - V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_file_chooser_set_filter, "fl_file_chooser_set_filter"); - pragma Inline (fl_file_chooser_set_filter); - - function fl_file_chooser_get_filter_value - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_get_filter_value, "fl_file_chooser_get_filter_value"); - pragma Inline (fl_file_chooser_get_filter_value); - - procedure fl_file_chooser_set_filter_value - (F : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_chooser_set_filter_value, "fl_file_chooser_set_filter_value"); - pragma Inline (fl_file_chooser_set_filter_value); - - procedure fl_file_chooser_rescan - (F : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_rescan, "fl_file_chooser_rescan"); - pragma Inline (fl_file_chooser_rescan); - - procedure fl_file_chooser_rescan_keep_filename - (F : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_rescan_keep_filename, "fl_file_chooser_rescan_keep_filename"); - pragma Inline (fl_file_chooser_rescan_keep_filename); - - function fl_file_chooser_get_value - (F : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_chooser_get_value, "fl_file_chooser_get_value"); - pragma Inline (fl_file_chooser_get_value); - - procedure fl_file_chooser_set_value - (F : in Storage.Integer_Address; - V : in Interfaces.C.char_array); - pragma Import (C, fl_file_chooser_set_value, "fl_file_chooser_set_value"); - pragma Inline (fl_file_chooser_set_value); - - - - - procedure fl_file_chooser_show - (F : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_show, "fl_file_chooser_show"); - pragma Inline (fl_file_chooser_show); - - procedure fl_file_chooser_hide - (F : in Storage.Integer_Address); - pragma Import (C, fl_file_chooser_hide, "fl_file_chooser_hide"); - pragma Inline (fl_file_chooser_hide); - - function fl_file_chooser_shown - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_shown, "fl_file_chooser_shown"); - pragma Inline (fl_file_chooser_shown); - - function fl_file_chooser_visible - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_chooser_visible, "fl_file_chooser_visible"); - pragma Inline (fl_file_chooser_visible); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - function File_Chooser_Sort_Hook - (A, B : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.int; - - pragma Export (C, File_Chooser_Sort_Hook, "file_chooser_sort_hook"); - - function File_Chooser_Sort_Hook - (A, B : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.int is - begin - return Filenames.Comparison'Pos (Sort_Method - (Interfaces.C.Strings.Value (A), - Interfaces.C.Strings.Value (B))) - 1; - end File_Chooser_Sort_Hook; - - - procedure File_Chooser_Callback_Hook - (C_Addr, User_Data : in Storage.Integer_Address); - - pragma Convention (C, File_Chooser_Callback_Hook); - - procedure File_Chooser_Callback_Hook - (C_Addr, User_Data : in Storage.Integer_Address) - is - Ada_Obj : access File_Chooser'Class := - File_Chooser_Convert.To_Pointer (Storage.To_Address (User_Data)); - begin - if Ada_Obj.My_Callback /= null then - Ada_Obj.My_Callback (Ada_Obj.all); - end if; - end File_Chooser_Callback_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Releasing carrier pigeon - procedure fl_button_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_button_extra_final, "fl_button_extra_final"); - pragma Inline (fl_button_extra_final); - - - -- Entering wormhole - procedure fl_check_button_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_check_button_extra_final, "fl_check_button_extra_final"); - pragma Inline (fl_check_button_extra_final); - - - procedure Extra_Final - (This : in out File_Chooser) - is - use Interfaces.C.Strings; - begin - fl_button_extra_final (Storage.To_Integer (This.New_Butt'Address)); - fl_check_button_extra_final (Storage.To_Integer (This.Preview_Butt'Address)); - fl_check_button_extra_final (Storage.To_Integer (This.Hidden_Butt'Address)); - Free (This.My_Label); - Free (This.My_OK_Label); - end Extra_Final; - - - procedure Finalize - (This : in out File_Chooser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_file_chooser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - procedure Finalize - (This : in out File_Chooser_Final_Controller) - is - use Interfaces.C.Strings; - begin - Free (Add_Favorites_Label); - Free (All_Files_Label); - Free (Custom_Filter_Label); - Free (Existing_File_Label); - Free (Favorites_Label); - Free (Filename_Label); - Free (Filesystems_Label); - Free (Hidden_Label); - Free (Manage_Favorites_Label); - Free (New_Directory_Label); - Free (New_Directory_Tooltip); - Free (Preview_Label); - Free (Save_Label); - Free (Show_Label); - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Bypassing border checkpoints - procedure fl_button_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_button_extra_init, "fl_button_extra_init"); - pragma Inline (fl_button_extra_init); - - - -- Refracting off language boundaries - procedure fl_check_button_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_check_button_extra_init, "fl_check_button_extra_init"); - pragma Inline (fl_check_button_extra_init); - - - procedure Extra_Init - (This : in out File_Chooser) is - begin - Wrapper (This.New_Butt).Void_Ptr := fl_file_chooser_newbutton (This.Void_Ptr); - Wrapper (This.New_Butt).Needs_Dealloc := False; - fl_button_extra_init - (Storage.To_Integer (This.New_Butt'Address), - Interfaces.C.int (This.New_Butt.Get_X), - Interfaces.C.int (This.New_Butt.Get_Y), - Interfaces.C.int (This.New_Butt.Get_W), - Interfaces.C.int (This.New_Butt.Get_H), - Interfaces.C.To_C (This.New_Butt.Get_Label)); - - Wrapper (This.Preview_Butt).Void_Ptr := fl_file_chooser_previewbutton (This.Void_Ptr); - Wrapper (This.Preview_Butt).Needs_Dealloc := False; - fl_check_button_extra_init - (Storage.To_Integer (This.Preview_Butt'Address), - Interfaces.C.int (This.Preview_Butt.Get_X), - Interfaces.C.int (This.Preview_Butt.Get_Y), - Interfaces.C.int (This.Preview_Butt.Get_W), - Interfaces.C.int (This.Preview_Butt.Get_H), - Interfaces.C.To_C (This.Preview_Butt.Get_Label)); - - Wrapper (This.Hidden_Butt).Void_Ptr := fl_file_chooser_showhiddenbutton (This.Void_Ptr); - Wrapper (This.Hidden_Butt).Needs_Dealloc := False; - fl_check_button_extra_init - (Storage.To_Integer (This.Hidden_Butt'Address), - Interfaces.C.int (This.Hidden_Butt.Get_X), - Interfaces.C.int (This.Hidden_Butt.Get_Y), - Interfaces.C.int (This.Hidden_Butt.Get_W), - Interfaces.C.int (This.Hidden_Butt.Get_H), - Interfaces.C.To_C (This.Hidden_Butt.Get_Label)); - - fl_file_chooser_set_user_data - (This.Void_Ptr, - Storage.To_Integer (This'Address)); - fl_file_chooser_callback - (This.Void_Ptr, - Storage.To_Integer (File_Chooser_Callback_Hook'Address), - Storage.To_Integer (This'Address)); - end Extra_Init; - - - package body Forge is - - function Create - (Title : in String; - Pattern : in String; - Pathname : in String; - Kind : in Chooser_Kind := Single) - return File_Chooser is - begin - return This : File_Chooser do - This.Void_Ptr := new_fl_file_chooser - (Interfaces.C.To_C (Pathname), - Interfaces.C.To_C (Pattern), - Chooser_Kind'Pos (Kind), - Interfaces.C.To_C (Title)); - Extra_Init (This); - end return; - end Create; - - end Forge; - - - - - ------------------ - -- Attributes -- - ------------------ - - function New_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Button_Reference is - begin - return (Data => This.New_Butt'Unchecked_Access); - end New_Button; - - - function Preview_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference is - begin - return (Data => This.Preview_Butt'Unchecked_Access); - end Preview_Button; - - - function Show_Hidden_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference is - begin - return (Data => This.Hidden_Butt'Unchecked_Access); - end Show_Hidden_Button; - - - - - ------------------------- - -- Static Attributes -- - ------------------------- - - function Get_Add_Favorites_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_add_favorites_label); - end Get_Add_Favorites_Label; - - - procedure Set_Add_Favorites_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Add_Favorites_Label); - Add_Favorites_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_add_favorites_label (Add_Favorites_Label); - end Set_Add_Favorites_Label; - - - function Get_All_Files_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_all_files_label); - end Get_All_Files_Label; - - - procedure Set_All_Files_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (All_Files_Label); - All_Files_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_all_files_label (All_Files_Label); - end Set_All_Files_Label; - - - function Get_Custom_Filter_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_custom_filter_label); - end Get_Custom_Filter_Label; - - - procedure Set_Custom_Filter_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Custom_Filter_Label); - Custom_Filter_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_custom_filter_label (Custom_Filter_Label); - end Set_Custom_Filter_Label; - - - function Get_Existing_File_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_existing_file_label); - end Get_Existing_File_Label; - - - procedure Set_Existing_File_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Existing_File_Label); - Existing_File_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_existing_file_label (Existing_File_Label); - end Set_Existing_File_Label; - - - function Get_Favorites_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_favorites_label); - end Get_Favorites_Label; - - - procedure Set_Favorites_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Favorites_Label); - Favorites_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_favorites_label (Favorites_Label); - end Set_Favorites_Label; - - - function Get_Filename_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_filename_label); - end Get_Filename_Label; - - - procedure Set_Filename_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Filename_Label); - Filename_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_filename_label (Filename_Label); - end Set_Filename_Label; - - - function Get_Filesystems_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_filesystems_label); - end Get_Filesystems_Label; - - - procedure Set_Filesystems_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Filesystems_Label); - Filesystems_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_filesystems_label (Filesystems_Label); - end Set_Filesystems_Label; - - - function Get_Hidden_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_hidden_label); - end Get_Hidden_Label; - - - procedure Set_Hidden_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Hidden_Label); - Hidden_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_hidden_label (Hidden_Label); - end Set_Hidden_Label; - - - function Get_Manage_Favorites_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_manage_favorites_label); - end Get_Manage_Favorites_Label; - - - procedure Set_Manage_Favorites_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Manage_Favorites_Label); - Manage_Favorites_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_manage_favorites_label (Manage_Favorites_Label); - end Set_Manage_Favorites_Label; - - - function Get_New_Directory_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_new_directory_label); - end Get_New_Directory_Label; - - - procedure Set_New_Directory_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (New_Directory_Label); - New_Directory_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_new_directory_label (New_Directory_Label); - end Set_New_Directory_Label; - - - function Get_New_Directory_Tooltip - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_new_directory_tooltip); - end Get_New_Directory_Tooltip; - - - procedure Set_New_Directory_Tooltip - (Value : in String) is - begin - Interfaces.C.Strings.Free (New_Directory_Tooltip); - New_Directory_Tooltip := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_new_directory_tooltip (New_Directory_Tooltip); - end Set_New_Directory_Tooltip; - - - function Get_Preview_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_preview_label); - end Get_Preview_Label; - - - procedure Set_Preview_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Preview_Label); - Preview_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_preview_label (Preview_Label); - end Set_Preview_Label; - - - function Get_Save_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_save_label); - end Get_Save_Label; - - - procedure Set_Save_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Save_Label); - Save_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_save_label (Save_Label); - end Set_Save_Label; - - - function Get_Show_Label - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_show_label); - end Get_Show_Label; - - procedure Set_Show_Label - (Value : in String) is - begin - Interfaces.C.Strings.Free (Show_Label); - Show_Label := Interfaces.C.Strings.New_String (Value); - fl_file_chooser_set_show_label (Show_Label); - end Set_Show_Label; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Add_Extra - (This : in out File_Chooser; - Item : in out Widgets.Widget'Class) - is - C_Addr : Storage.Integer_Address; - begin - C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr); - end Add_Extra; - - - procedure Remove_Extra - (This : in out File_Chooser) - is - C_Addr : Storage.Integer_Address; - begin - C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Null_Pointer); - end Remove_Extra; - - - function Eject_Extra - (This : in out File_Chooser; - Item : in out Widgets.Widget'Class) - return access Widgets.Widget'Class - is - C_Addr : Storage.Integer_Address := - fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr); - Ada_Obj : access Widgets.Widget'Class; - begin - if C_Addr /= Null_Pointer then - C_Addr := fl_widget_get_user_data (C_Addr); - pragma Assert (C_Addr /= Null_Pointer); - Ada_Obj := Widget_Convert.To_Pointer (Storage.To_Address (C_Addr)); - end if; - return Ada_Obj; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Eject_Extra; - - - procedure Set_Callback - (This : in out File_Chooser; - Func : in Chooser_Callback) is - begin - This.My_Callback := Func; - end Set_Callback; - - - - - function Get_Background_Color - (This : in File_Chooser) - return Color is - begin - return Color (fl_file_chooser_get_color (This.Void_Ptr)); - end Get_Background_Color; - - - procedure Set_Background_Color - (This : in out File_Chooser; - Value : in Color) is - begin - fl_file_chooser_set_color (This.Void_Ptr, Interfaces.C.unsigned (Value)); - end Set_Background_Color; - - - function Get_Icon_Size - (This : in File_Chooser) - return Icon_Size is - begin - return Icon_Size (fl_file_chooser_get_iconsize (This.Void_Ptr)); - end Get_Icon_Size; - - - procedure Set_Icon_Size - (This : in out File_Chooser; - Value : in Icon_Size) is - begin - fl_file_chooser_set_iconsize (This.Void_Ptr, Interfaces.C.unsigned_char (Value)); - end Set_Icon_Size; - - - function Get_Label - (This : in File_Chooser) - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_label (This.Void_Ptr)); - end Get_Label; - - - procedure Set_Label - (This : in out File_Chooser; - Text : in String) is - begin - Interfaces.C.Strings.Free (This.My_Label); - This.My_Label := Interfaces.C.Strings.New_String (Text); - fl_file_chooser_set_label (This.Void_Ptr, This.My_Label); - end Set_Label; - - - function Get_OK_Label - (This : in File_Chooser) - return String is - begin - return Interfaces.C.Strings.Value (fl_file_chooser_get_ok_label (This.Void_Ptr)); - end Get_OK_Label; - - - procedure Set_OK_Label - (This : in out File_Chooser; - Text : in String) is - begin - Interfaces.C.Strings.Free (This.My_OK_Label); - This.My_OK_Label := Interfaces.C.Strings.New_String (Text); - fl_file_chooser_set_ok_label (This.Void_Ptr, This.My_OK_Label); - end Set_OK_Label; - - - function Has_Preview - (This : in File_Chooser) - return Boolean - is - Ret : Interfaces.C.int := fl_file_chooser_get_preview (This.Void_Ptr); - begin - pragma Assert (Ret in 0 .. 1); - return Boolean'Val (Ret); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Has_Preview; - - - procedure Set_Preview - (This : in out File_Chooser; - Value : in Boolean) is - begin - fl_file_chooser_set_preview (This.Void_Ptr, Boolean'Pos (Value)); - end Set_Preview; - - - function Get_Text_Color - (This : in File_Chooser) - return Color is - begin - return Color (fl_file_chooser_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out File_Chooser; - Value : in Color) is - begin - fl_file_chooser_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in File_Chooser) - return Font_Kind is - begin - return Font_Kind'Val (fl_file_chooser_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out File_Chooser; - Font : in Font_Kind) is - begin - fl_file_chooser_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in File_Chooser) - return Font_Size is - begin - return Font_Size (fl_file_chooser_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out File_Chooser; - Size : in Font_Size) is - begin - fl_file_chooser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - function Get_Chooser_Kind - (This : in File_Chooser) - return Chooser_Kind - is - Ret : Interfaces.C.int := fl_file_chooser_get_type (This.Void_Ptr); - begin - pragma Assert (Ret in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last)); - return Chooser_Kind'Val (Ret); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Chooser_Kind; - - - procedure Set_Chooser_Kind - (This : in out File_Chooser; - Kind : in Chooser_Kind) is - begin - fl_file_chooser_set_type (This.Void_Ptr, Chooser_Kind'Pos (Kind)); - end Set_Chooser_Kind; - - - - - function Number_Selected - (This : in File_Chooser) - return Natural is - begin - return Natural (fl_file_chooser_count (This.Void_Ptr)); - end Number_Selected; - - - function Get_Directory - (This : in File_Chooser) - return String - is - C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_directory (This.Void_Ptr); - begin - if C_Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (C_Ptr); - end if; - end Get_Directory; - - - procedure Set_Directory - (This : in out File_Chooser; - Value : in String) - is - use Interfaces.C; - C_Arr : aliased char_array := To_C (Value); - begin - if Value = "" then - fl_file_chooser_set_directory (This.Void_Ptr, Strings.Null_Ptr); - else - fl_file_chooser_set_directory - (This.Void_Ptr, - Strings.To_Chars_Ptr (C_Arr'Unchecked_Access)); - end if; - end Set_Directory; - - - function Get_Filter - (This : in File_Chooser) - return String - is - C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_filter (This.Void_Ptr); - begin - if C_Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (C_Ptr); - end if; - end Get_Filter; - - - procedure Set_Filter - (This : in out File_Chooser; - Value : in String) - is - use Interfaces.C; - C_Arr : aliased char_array := To_C (Value); - begin - if Value = "" then - fl_file_chooser_set_filter (This.Void_Ptr, Strings.Null_Ptr); - else - fl_file_chooser_set_filter - (This.Void_Ptr, - Strings.To_Chars_Ptr (C_Arr'Unchecked_Access)); - end if; - end Set_Filter; - - - function Get_Filter_Index - (This : in File_Chooser) - return Positive is - begin - return Positive (fl_file_chooser_get_filter_value (This.Void_Ptr) + 1); - end Get_Filter_Index; - - - procedure Set_Filter_Index - (This : in out File_Chooser; - Value : in Positive) is - begin - fl_file_chooser_set_filter_value (This.Void_Ptr, Interfaces.C.int (Value) - 1); - end Set_Filter_Index; - - - procedure Rescan - (This : in out File_Chooser) is - begin - fl_file_chooser_rescan (This.Void_Ptr); - end Rescan; - - - procedure Rescan_Keep_Filename - (This : in out File_Chooser) is - begin - fl_file_chooser_rescan_keep_filename (This.Void_Ptr); - end Rescan_Keep_Filename; - - - function Get_Selected - (This : in File_Chooser; - Index : in Positive := 1) - return String - is - C_Ptr : Interfaces.C.Strings.chars_ptr := - fl_file_chooser_get_value (This.Void_Ptr, Interfaces.C.int (Index)); - begin - if C_Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (C_Ptr); - end if; - end Get_Selected; - - - procedure Set_Selected - (This : in out File_Chooser; - Value : in String) is - begin - fl_file_chooser_set_value (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Selected; - - - - - procedure Show - (This : in out File_Chooser) is - begin - fl_file_chooser_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out File_Chooser) is - begin - fl_file_chooser_hide (This.Void_Ptr); - end Hide; - - - function Is_Shown - (This : in File_Chooser) - return Boolean is - begin - return fl_file_chooser_shown (This.Void_Ptr) /= 0; - end Is_Shown; - - - function Is_Visible - (This : in File_Chooser) - return Boolean is - begin - return fl_file_chooser_visible (This.Void_Ptr) /= 0; - end Is_Visible; - - -begin - - file_chooser_setup_sort_hook; - -end FLTK.File_Choosers; - - diff --git a/src/fltk-file_choosers.ads b/src/fltk-file_choosers.ads deleted file mode 100644 index cea7b36..0000000 --- a/src/fltk-file_choosers.ads +++ /dev/null @@ -1,408 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Filenames, - FLTK.Widgets.Buttons.Light.Check; - -private with - - Ada.Finalization, - Interfaces.C.Strings; - - -package FLTK.File_Choosers is - - - type File_Chooser is new Wrapper with private; - - type File_Chooser_Reference (Data : not null access File_Chooser'Class) is - limited null record with Implicit_Dereference => Data; - - type Chooser_Kind is (Single, Multi, Create, Directory); - - type Chooser_Callback is access procedure - (Item : in out File_Chooser'Class); - - type Icon_Size is mod 256; - - - - - package Forge is - - function Create - (Title : in String; - Pattern : in String; - Pathname : in String; - Kind : in Chooser_Kind := Single) - return File_Chooser; - - end Forge; - - - - - Sort_Method : not null FLTK.Filenames.Compare_Function := - FLTK.Filenames.Numeric_Sort'Access; - - - - - function New_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Button_Reference; - - function Preview_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference; - - function Show_Hidden_Button - (This : in out File_Chooser) - return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference; - - - - - function Get_Add_Favorites_Label - return String; - - procedure Set_Add_Favorites_Label - (Value : in String); - - function Get_All_Files_Label - return String; - - procedure Set_All_Files_Label - (Value : in String); - - function Get_Custom_Filter_Label - return String; - - procedure Set_Custom_Filter_Label - (Value : in String); - - function Get_Existing_File_Label - return String; - - procedure Set_Existing_File_Label - (Value : in String); - - function Get_Favorites_Label - return String; - - procedure Set_Favorites_Label - (Value : in String); - - function Get_Filename_Label - return String; - - procedure Set_Filename_Label - (Value : in String); - - function Get_Filesystems_Label - return String; - - procedure Set_Filesystems_Label - (Value : in String); - - function Get_Hidden_Label - return String; - - procedure Set_Hidden_Label - (Value : in String); - - function Get_Manage_Favorites_Label - return String; - - procedure Set_Manage_Favorites_Label - (Value : in String); - - function Get_New_Directory_Label - return String; - - procedure Set_New_Directory_Label - (Value : in String); - - function Get_New_Directory_Tooltip - return String; - - procedure Set_New_Directory_Tooltip - (Value : in String); - - function Get_Preview_Label - return String; - - procedure Set_Preview_Label - (Value : in String); - - function Get_Save_Label - return String; - - procedure Set_Save_Label - (Value : in String); - - function Get_Show_Label - return String; - - procedure Set_Show_Label - (Value : in String); - - - - - procedure Add_Extra - (This : in out File_Chooser; - Item : in out Widgets.Widget'Class); - - procedure Remove_Extra - (This : in out File_Chooser); - - function Eject_Extra - (This : in out File_Chooser; - Item : in out Widgets.Widget'Class) - return access Widgets.Widget'Class; - - procedure Set_Callback - (This : in out File_Chooser; - Func : in Chooser_Callback); - - - - - function Get_Background_Color - (This : in File_Chooser) - return Color; - - procedure Set_Background_Color - (This : in out File_Chooser; - Value : in Color); - - function Get_Icon_Size - (This : in File_Chooser) - return Icon_Size; - - procedure Set_Icon_Size - (This : in out File_Chooser; - Value : in Icon_Size); - - function Get_Label - (This : in File_Chooser) - return String; - - procedure Set_Label - (This : in out File_Chooser; - Text : in String); - - function Get_OK_Label - (This : in File_Chooser) - return String; - - procedure Set_OK_Label - (This : in out File_Chooser; - Text : in String); - - function Has_Preview - (This : in File_Chooser) - return Boolean; - - procedure Set_Preview - (This : in out File_Chooser; - Value : in Boolean); - - function Get_Text_Color - (This : in File_Chooser) - return Color; - - procedure Set_Text_Color - (This : in out File_Chooser; - Value : in Color); - - function Get_Text_Font - (This : in File_Chooser) - return Font_Kind; - - procedure Set_Text_Font - (This : in out File_Chooser; - Font : in Font_Kind); - - function Get_Text_Size - (This : in File_Chooser) - return Font_Size; - - procedure Set_Text_Size - (This : in out File_Chooser; - Size : in Font_Size); - - function Get_Chooser_Kind - (This : in File_Chooser) - return Chooser_Kind; - - procedure Set_Chooser_Kind - (This : in out File_Chooser; - Kind : in Chooser_Kind); - - - - - function Number_Selected - (This : in File_Chooser) - return Natural; - - function Get_Directory - (This : in File_Chooser) - return String; - - procedure Set_Directory - (This : in out File_Chooser; - Value : in String); - - function Get_Filter - (This : in File_Chooser) - return String; - - procedure Set_Filter - (This : in out File_Chooser; - Value : in String); - - function Get_Filter_Index - (This : in File_Chooser) - return Positive; - - procedure Set_Filter_Index - (This : in out File_Chooser; - Value : in Positive); - - procedure Rescan - (This : in out File_Chooser); - - procedure Rescan_Keep_Filename - (This : in out File_Chooser); - - function Get_Selected - (This : in File_Chooser; - Index : in Positive := 1) - return String - with Pre => Index <= This.Number_Selected; - - procedure Set_Selected - (This : in out File_Chooser; - Value : in String); - - - - - procedure Show - (This : in out File_Chooser); - - procedure Hide - (This : in out File_Chooser); - - function Is_Shown - (This : in File_Chooser) - return Boolean; - - function Is_Visible - (This : in File_Chooser) - return Boolean; - - -private - - - type File_Chooser is new Wrapper with record - New_Butt : aliased Widgets.Buttons.Button; - Preview_Butt : aliased Widgets.Buttons.Light.Check.Check_Button; - Hidden_Butt : aliased Widgets.Buttons.Light.Check.Check_Button; - My_Callback : Chooser_Callback; - My_Label : Interfaces.C.Strings.chars_ptr; - My_OK_Label : Interfaces.C.Strings.chars_ptr; - end record; - - overriding procedure Finalize - (This : in out File_Chooser); - - procedure Extra_Init - (This : in out File_Chooser); - - procedure Extra_Final - (This : in out File_Chooser); - - - Add_Favorites_Label, All_Files_Label, - Custom_Filter_Label, Existing_File_Label, - Favorites_Label, Filename_Label, - Filesystems_Label, Hidden_Label, - Manage_Favorites_Label, New_Directory_Label, - New_Directory_Tooltip, Preview_Label, - Save_Label, Show_Label : Interfaces.C.Strings.chars_ptr; - - - pragma Inline (New_Button); - pragma Inline (Preview_Button); - pragma Inline (Show_Hidden_Button); - - pragma Inline (Get_Add_Favorites_Label); - pragma Inline (Get_All_Files_Label); - pragma Inline (Get_Custom_Filter_Label); - pragma Inline (Get_Existing_File_Label); - pragma Inline (Get_Favorites_Label); - pragma Inline (Get_Filename_Label); - pragma Inline (Get_Filesystems_Label); - pragma Inline (Get_Hidden_Label); - pragma Inline (Get_Manage_Favorites_Label); - pragma Inline (Get_New_Directory_Label); - pragma Inline (Get_New_Directory_Tooltip); - pragma Inline (Get_Preview_Label); - pragma Inline (Get_Save_Label); - pragma Inline (Get_Show_Label); - - pragma Inline (Add_Extra); - pragma Inline (Remove_Extra); - pragma Inline (Eject_Extra); - pragma Inline (Set_Callback); - - pragma Inline (Get_Background_Color); - pragma Inline (Set_Background_Color); - pragma Inline (Get_Icon_Size); - pragma Inline (Set_Icon_Size); - pragma Inline (Get_Label); - pragma Inline (Get_OK_Label); - pragma Inline (Set_Preview); - 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 (Set_Chooser_Kind); - - pragma Inline (Number_Selected); - pragma Inline (Get_Filter_Index); - pragma Inline (Set_Filter_Index); - pragma Inline (Rescan); - pragma Inline (Rescan_Keep_Filename); - pragma Inline (Set_Selected); - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Is_Shown); - pragma Inline (Is_Visible); - - - -- Needed to ensure chars_ptr storage is properly cleaned up - type File_Chooser_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; - - overriding procedure Finalize - (This : in out File_Chooser_Final_Controller); - - Cleanup : File_Chooser_Final_Controller; - - -end FLTK.File_Choosers; - - diff --git a/src/fltk-filenames.adb b/src/fltk-filenames.adb deleted file mode 100644 index 7674323..0000000 --- a/src/fltk-filenames.adb +++ /dev/null @@ -1,492 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Filenames is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Constants From C -- - ------------------------ - - error_bsize : constant Interfaces.C.int; - pragma Import (C, error_bsize, "error_bsize"); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - procedure free_filename_file_list - (L : in Storage.Integer_Address; - N : in Interfaces.C.int); - pragma Import (C, free_filename_file_list, "free_filename_file_list"); - pragma Inline (free_filename_file_list); - - function filename_dname - (L : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, filename_dname, "filename_dname"); - pragma Inline (filename_dname); - - - - - procedure filename_decode_uri - (URI : in Interfaces.C.char_array); - pragma Import (C, filename_decode_uri, "filename_decode_uri"); - pragma Inline (filename_decode_uri); - - function filename_absolute - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_absolute, "filename_absolute"); - pragma Inline (filename_absolute); - - function filename_expand - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_expand, "filename_expand"); - pragma Inline (filename_expand); - - function filename_ext - (Buf : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, filename_ext, "filename_ext"); - pragma Inline (filename_ext); - - function filename_isdir - (Name : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_isdir, "filename_isdir"); - pragma Inline (filename_isdir); - - function filename_list - (D : in Interfaces.C.char_array; - L : out Storage.Integer_Address; - F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, filename_list, "filename_list"); - pragma Inline (filename_list); - - function filename_match - (Name, Pattern : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_match, "filename_match"); - pragma Inline (filename_match); - - function filename_name - (Name : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, filename_name, "filename_name"); - pragma Inline (filename_name); - - function filename_relative - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - From : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_relative, "filename_relative"); - pragma Inline (filename_relative); - - function filename_setext - (To : in Interfaces.C.char_array; - Len : in Interfaces.C.int; - Ext : in Interfaces.C.char_array) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, filename_setext, "filename_setext"); - pragma Inline (filename_setext); - - function filename_open_uri - (U, M : in Interfaces.C.char_array; - Len : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, filename_open_uri, "filename_open_uri"); - pragma Inline (filename_open_uri); - - - - - function filename_alphasort - (A, B : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_alphasort, "filename_alphasort"); - - function filename_casealphasort - (A, B : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_casealphasort, "filename_casealphasort"); - - function filename_numericsort - (A, B : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_numericsort, "filename_numericsort"); - - function filename_casenumericsort - (A, B : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, filename_casenumericsort, "filename_casenumericsort"); - - - - - ------------------------------ - -- Comparison Subprograms -- - ------------------------------ - - function Alpha_Sort - (A, B : in String) - return Comparison - is - Result : Interfaces.C.int := - filename_alphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); - begin - pragma Assert - (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); - return Comparison'Val (Result); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Alpha_Sort; - - - function Case_Alpha_Sort - (A, B : in String) - return Comparison - is - Result : Interfaces.C.int := - filename_casealphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); - begin - pragma Assert - (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); - return Comparison'Val (Result); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Case_Alpha_Sort; - - - function Numeric_Sort - (A, B : in String) - return Comparison - is - Result : Interfaces.C.int := - filename_numericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); - begin - pragma Assert - (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); - return Comparison'Val (Result); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Numeric_Sort; - - - function Case_Numeric_Sort - (A, B : in String) - return Comparison - is - Result : Interfaces.C.int := - filename_casenumericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); - begin - pragma Assert - (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); - return Comparison'Val (Result); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Case_Numeric_Sort; - - - - - --------------------------- - -- Listing Subprograms -- - --------------------------- - - procedure Finalize - (This : in out File_List) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_filename_file_list (This.Void_Ptr, This.Entries); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - function Length - (This : in File_List) - return Natural is - begin - return Natural (This.Entries); - end Length; - - - function Item - (This : in File_List; - Index : in Positive) - return Path_String is - begin - return Interfaces.C.Strings.Value - (filename_dname (This.Void_Ptr, Interfaces.C.int (Index) - 1)); - end Item; - - - - - -------------------- - -- Filename API -- - -------------------- - - function Decode_URI - (URI : in Path_String) - return Path_String - is - C_Ptr : Interfaces.C.char_array := Interfaces.C.To_C (URI); - begin - filename_decode_uri (C_Ptr); - return Interfaces.C.To_Ada (C_Ptr); - end Decode_URI; - - - procedure Open_URI - (URI : in Path_String) - is - Message : Interfaces.C.char_array (1 .. Interfaces.C.size_t (error_bsize)) := - (others => Interfaces.C.char'Val (0)); - Result : Interfaces.C.int := filename_open_uri - (Interfaces.C.To_C (URI), - Message, - error_bsize); - begin - if Result = 0 then - raise Open_URI_Error with "Error: " & Interfaces.C.To_Ada (Message); - else - pragma Assert (Result = 1); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Open_URI; - - - - - function Absolute - (Name : in Path_String) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_absolute - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - return Interfaces.C.To_Ada (Result); - end Absolute; - - - function Absolute - (Name : in Path_String; - Changed : out Boolean) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_absolute - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - Changed := Code /= 0; - return Interfaces.C.To_Ada (Result); - end Absolute; - - - function Relative - (Name : in Path_String) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_relative - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - return Interfaces.C.To_Ada (Result); - end Relative; - - - function Relative - (Name : in Path_String; - Changed : out Boolean) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_relative - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - Changed := Code /= 0; - return Interfaces.C.To_Ada (Result); - end Relative; - - - function Expand - (Name : in Path_String) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_expand - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - return Interfaces.C.To_Ada (Result); - end Expand; - - - function Expand - (Name : in Path_String; - Changed : out Boolean) - return Path_String - is - Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Code : Interfaces.C.int := filename_expand - (Result, - Interfaces.C.int (Max_Path_Length), - Interfaces.C.To_C (Name)); - begin - Changed := Code /= 0; - return Interfaces.C.To_Ada (Result); - end Expand; - - - - - function Base_Name - (Name : in Path_String) - return Path_String - is - Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); - begin - return Interfaces.C.Strings.Value (filename_name (Data)); - end Base_Name; - - - function Extension - (Name : in Path_String) - return Path_String - is - Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); - Result : Interfaces.C.Strings.chars_ptr := filename_ext (Data); - begin - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Extension; - - - function Set_Extension - (Name : in Path_String; - Suffix : in String) - return Path_String - is - Data : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := - (others => Interfaces.C.char'Val (0)); - Result : Interfaces.C.Strings.chars_ptr; - begin - Data (1 .. Name'Length) := Interfaces.C.To_C (Name); - Result := filename_setext - (Data, - Data'Length, - Interfaces.C.To_C (Suffix)); - return Interfaces.C.Strings.Value (Result); - end Set_Extension; - - - - - function Is_Directory - (Name : in Path_String) - return Boolean is - begin - return filename_isdir (Interfaces.C.To_C (Name)) /= 0; - end Is_Directory; - - - Current_Sort : Compare_Function; - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int; - - pragma Convention (C, Compare_Hook); - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int - is - Result : Comparison := Current_Sort - (Interfaces.C.Strings.Value (filename_dname (DA, 0)), - Interfaces.C.Strings.Value (filename_dname (DB, 0))); - begin - return Comparison'Pos (Result) - 1; - end Compare_Hook; - - function Get_Listing - (Name : in Path_String; - Sort : in not null Compare_Function := Numeric_Sort'Access) - return File_List is - begin - Current_Sort := Sort; - return This : File_List do - This.Entries := filename_list - (Interfaces.C.To_C (Name), - This.Void_Ptr, - Storage.To_Integer (Compare_Hook'Address)); - end return; - end Get_Listing; - - - - - function Match - (Input, Pattern : in String) - return Boolean is - begin - return filename_match (Interfaces.C.To_C (Input), Interfaces.C.To_C (Pattern)) /= 0; - end Match; - - -end FLTK.Filenames; - - diff --git a/src/fltk-filenames.ads b/src/fltk-filenames.ads deleted file mode 100644 index 2872b8c..0000000 --- a/src/fltk-filenames.ads +++ /dev/null @@ -1,157 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Filenames is - - - Max_Path_Length : constant Natural; - - subtype Path_String is String - with Dynamic_Predicate => Path_String'Length <= Max_Path_Length; - - - type Comparison is (Lesser, Equal, Greater); - - type Compare_Function is access function - (A, B : in String) - return Comparison; - - function Alpha_Sort - (A, B : in String) - return Comparison; - - function Case_Alpha_Sort - (A, B : in String) - return Comparison; - - function Numeric_Sort - (A, B : in String) - return Comparison; - - function Case_Numeric_Sort - (A, B : in String) - return Comparison; - - - type File_List is new Wrapper with private; - - function Length - (This : in File_List) - return Natural; - - function Item - (This : in File_List; - Index : in Positive) - return Path_String - with Pre => Index in 1 .. This.Length; - - - Open_URI_Error : exception; - - - - - function Decode_URI - (URI : in Path_String) - return Path_String; - - procedure Open_URI - (URI : in Path_String); - - - - - function Absolute - (Name : in Path_String) - return Path_String; - - function Absolute - (Name : in Path_String; - Changed : out Boolean) - return Path_String; - - function Relative - (Name : in Path_String) - return Path_String; - - function Relative - (Name : in Path_String; - Changed : out Boolean) - return Path_String; - - function Expand - (Name : in Path_String) - return Path_String; - - function Expand - (Name : in Path_String; - Changed : out Boolean) - return Path_String; - - - - - function Base_Name - (Name : in Path_String) - return Path_String; - - function Extension - (Name : in Path_String) - return Path_String; - - function Set_Extension - (Name : in Path_String; - Suffix : in String) - return Path_String; - - - - - function Is_Directory - (Name : in Path_String) - return Boolean; - - function Get_Listing - (Name : in Path_String; - Sort : in not null Compare_Function := Numeric_Sort'Access) - return File_List; - - - - - function Match - (Input, Pattern : in String) - return Boolean; - - -private - - - type File_List is new Wrapper with record - Entries : Interfaces.C.int := 0; - end record; - - overriding procedure Finalize - (This : in out File_List); - - - fl_path_max : constant Interfaces.C.int; - pragma Import (C, fl_path_max, "fl_path_max"); - - Max_Path_Length : constant Natural := Natural (fl_path_max); - - - pragma Inline (Length); - pragma Inline (Item); - - pragma Inline (Is_Directory); - - pragma Inline (Match); - - -end FLTK.Filenames; - - diff --git a/src/fltk-help_dialogs.adb b/src/fltk-help_dialogs.adb deleted file mode 100644 index fc5ab07..0000000 --- a/src/fltk-help_dialogs.adb +++ /dev/null @@ -1,361 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Show_Argv, - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Help_Dialogs is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_help_dialog - return Storage.Integer_Address; - pragma Import (C, new_fl_help_dialog, "new_fl_help_dialog"); - pragma Inline (new_fl_help_dialog); - - procedure free_fl_help_dialog - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_help_dialog, "free_fl_help_dialog"); - pragma Inline (free_fl_help_dialog); - - - - - procedure fl_help_dialog_show - (D : in Storage.Integer_Address); - pragma Import (C, fl_help_dialog_show, "fl_help_dialog_show"); - pragma Inline (fl_help_dialog_show); - - procedure fl_help_dialog_show2 - (D : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_help_dialog_show2, "fl_help_dialog_show2"); - pragma Inline (fl_help_dialog_show2); - - procedure fl_help_dialog_hide - (D : in Storage.Integer_Address); - pragma Import (C, fl_help_dialog_hide, "fl_help_dialog_hide"); - pragma Inline (fl_help_dialog_hide); - - function fl_help_dialog_visible - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_visible, "fl_help_dialog_visible"); - pragma Inline (fl_help_dialog_visible); - - - - - procedure fl_help_dialog_set_topline_number - (D : in Storage.Integer_Address; - N : in Interfaces.C.int); - pragma Import (C, fl_help_dialog_set_topline_number, "fl_help_dialog_set_topline_number"); - pragma Inline (fl_help_dialog_set_topline_number); - - procedure fl_help_dialog_set_topline_target - (D : in Storage.Integer_Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_help_dialog_set_topline_target, "fl_help_dialog_set_topline_target"); - pragma Inline (fl_help_dialog_set_topline_target); - - - - - procedure fl_help_dialog_load - (D : in Storage.Integer_Address; - N : in Interfaces.C.char_array); - pragma Import (C, fl_help_dialog_load, "fl_help_dialog_load"); - pragma Inline (fl_help_dialog_load); - - function fl_help_dialog_get_value - (D : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_help_dialog_get_value, "fl_help_dialog_get_value"); - pragma Inline (fl_help_dialog_get_value); - - procedure fl_help_dialog_set_value - (D : in Storage.Integer_Address; - V : in Interfaces.C.char_array); - pragma Import (C, fl_help_dialog_set_value, "fl_help_dialog_set_value"); - pragma Inline (fl_help_dialog_set_value); - - - - - function fl_help_dialog_get_textsize - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_get_textsize, "fl_help_dialog_get_textsize"); - pragma Inline (fl_help_dialog_get_textsize); - - procedure fl_help_dialog_set_textsize - (D : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_help_dialog_set_textsize, "fl_help_dialog_set_textsize"); - pragma Inline (fl_help_dialog_set_textsize); - - - - - function fl_help_dialog_get_x - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_get_x, "fl_help_dialog_get_x"); - pragma Inline (fl_help_dialog_get_x); - - function fl_help_dialog_get_y - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_get_y, "fl_help_dialog_get_y"); - pragma Inline (fl_help_dialog_get_y); - - function fl_help_dialog_get_w - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_get_w, "fl_help_dialog_get_w"); - pragma Inline (fl_help_dialog_get_w); - - function fl_help_dialog_get_h - (D : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_dialog_get_h, "fl_help_dialog_get_h"); - pragma Inline (fl_help_dialog_get_h); - - procedure fl_help_dialog_resize - (D : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_help_dialog_resize, "fl_help_dialog_resize"); - pragma Inline (fl_help_dialog_resize); - - procedure fl_help_dialog_position - (D : in Storage.Integer_Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_help_dialog_position, "fl_help_dialog_position"); - pragma Inline (fl_help_dialog_position); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Finalize - (This : in out Help_Dialog) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_help_dialog (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - package body Forge is - - function Create - return Help_Dialog is - begin - return This : Help_Dialog do - This.Void_Ptr := new_fl_help_dialog; - end return; - end Create; - - - function Create - (X, Y, W, H : in Integer) - return Help_Dialog is - begin - return This : Help_Dialog do - This.Void_Ptr := new_fl_help_dialog; - This.Resize (X, Y, W, H); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Show - (This : in out Help_Dialog) is - begin - fl_help_dialog_show (This.Void_Ptr); - end Show; - - - procedure Show_With_Args - (This : in out Help_Dialog) is - begin - FLTK.Show_Argv.Dispatch (fl_help_dialog_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - procedure Hide - (This : in out Help_Dialog) is - begin - fl_help_dialog_hide (This.Void_Ptr); - end Hide; - - - function Is_Visible - (This : in Help_Dialog) - return Boolean is - begin - return fl_help_dialog_visible (This.Void_Ptr) = 1; - end Is_Visible; - - - - - procedure Set_Topline_Number - (This : in out Help_Dialog; - Line : in Positive) is - begin - fl_help_dialog_set_topline_number (This.Void_Ptr, Interfaces.C.int (Line) - 1); - end Set_Topline_Number; - - - procedure Set_Topline_Target - (This : in out Help_Dialog; - Value : in String) is - begin - fl_help_dialog_set_topline_target (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Topline_Target; - - - - - procedure Load - (This : in out Help_Dialog; - Name : in String) is - begin - fl_help_dialog_load (This.Void_Ptr, Interfaces.C.To_C (Name)); - end Load; - - - function Get_Content - (This : in Help_Dialog) - return String - is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_dialog_get_value (This.Void_Ptr); - use type Interfaces.C.Strings.chars_ptr; - begin - if Raw_Chars = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Raw_Chars); - end if; - end Get_Content; - - - procedure Set_Content - (This : in out Help_Dialog; - Value : in String) is - begin - fl_help_dialog_set_value (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Content; - - - - - function Get_Text_Size - (This : in Help_Dialog) - return Font_Size is - begin - return Font_Size (fl_help_dialog_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Help_Dialog; - Size : in Font_Size) is - begin - fl_help_dialog_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - function Get_X - (This : in Help_Dialog) - return Integer is - begin - return Integer (fl_help_dialog_get_x (This.Void_Ptr)); - end Get_X; - - - function Get_Y - (This : in Help_Dialog) - return Integer is - begin - return Integer (fl_help_dialog_get_y (This.Void_Ptr)); - end Get_Y; - - - function Get_W - (This : in Help_Dialog) - return Integer is - begin - return Integer (fl_help_dialog_get_w (This.Void_Ptr)); - end Get_W; - - - function Get_H - (This : in Help_Dialog) - return Integer is - begin - return Integer (fl_help_dialog_get_h (This.Void_Ptr)); - end Get_H; - - - procedure Resize - (This : in out Help_Dialog; - X, Y, W, H : in Integer) is - begin - fl_help_dialog_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - procedure Reposition - (This : in out Help_Dialog; - X, Y : in Integer) is - begin - fl_help_dialog_position - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Reposition; - - -end FLTK.Help_Dialogs; - - diff --git a/src/fltk-help_dialogs.ads b/src/fltk-help_dialogs.ads deleted file mode 100644 index 655e357..0000000 --- a/src/fltk-help_dialogs.ads +++ /dev/null @@ -1,149 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Help_Dialogs is - - - type Help_Dialog is new Wrapper with private; - - type Help_Dialog_Reference (Data : not null access Help_Dialog'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - return Help_Dialog; - - function Create - (X, Y, W, H : in Integer) - return Help_Dialog; - - private - - pragma Inline (Create); - - end Forge; - - - - - procedure Show - (This : in out Help_Dialog); - - procedure Show_With_Args - (This : in out Help_Dialog); - - procedure Hide - (This : in out Help_Dialog); - - function Is_Visible - (This : in Help_Dialog) - return Boolean; - - - - - procedure Set_Topline_Number - (This : in out Help_Dialog; - Line : in Positive); - - procedure Set_Topline_Target - (This : in out Help_Dialog; - Value : in String); - - - - - -- Name here can be either a ftp/http/https/ipp/mailto/news URL or a filename - -- See Load procedure in FLTK.Widgets.Groups.Help_Views - procedure Load - (This : in out Help_Dialog; - Name : in String); - - function Get_Content - (This : in Help_Dialog) - return String; - - procedure Set_Content - (This : in out Help_Dialog; - Value : in String); - - - - - function Get_Text_Size - (This : in Help_Dialog) - return Font_Size; - - procedure Set_Text_Size - (This : in out Help_Dialog; - Size : in Font_Size); - - - - - function Get_X - (This : in Help_Dialog) - return Integer; - - function Get_Y - (This : in Help_Dialog) - return Integer; - - function Get_W - (This : in Help_Dialog) - return Integer; - - function Get_H - (This : in Help_Dialog) - return Integer; - - procedure Resize - (This : in out Help_Dialog; - X, Y, W, H : in Integer); - - procedure Reposition - (This : in out Help_Dialog; - X, Y : in Integer); - - -private - - - type Help_Dialog is new Wrapper with null record; - - overriding procedure Finalize - (This : in out Help_Dialog); - - - pragma Inline (Show); - pragma Inline (Show_With_Args); - pragma Inline (Hide); - pragma Inline (Is_Visible); - - pragma Inline (Set_Topline_Number); - pragma Inline (Set_Topline_Target); - - pragma Inline (Load); - pragma Inline (Set_Content); - - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - pragma Inline (Get_X); - pragma Inline (Get_Y); - pragma Inline (Get_W); - pragma Inline (Get_H); - pragma Inline (Resize); - pragma Inline (Reposition); - - -end FLTK.Help_Dialogs; - - diff --git a/src/fltk-images-bitmaps-xbm.adb b/src/fltk-images-bitmaps-xbm.adb deleted file mode 100644 index eb8c093..0000000 --- a/src/fltk-images-bitmaps-xbm.adb +++ /dev/null @@ -1,72 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Bitmaps.XBM is - - - function new_fl_xbm_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_xbm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 0887666..0000000 --- a/src/fltk-images-bitmaps-xbm.ads +++ /dev/null @@ -1,45 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 90150c9..0000000 --- a/src/fltk-images-bitmaps.adb +++ /dev/null @@ -1,181 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Bitmaps is - - - function new_fl_bitmap - (D : in Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, new_fl_bitmap, "new_fl_bitmap"); - pragma Inline (new_fl_bitmap); - - procedure free_fl_bitmap - (I : in Storage.Integer_Address); - pragma Import (C, free_fl_bitmap, "free_fl_bitmap"); - pragma Inline (free_fl_bitmap); - - function fl_bitmap_copy - (I : in Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_bitmap_copy, "fl_bitmap_copy"); - pragma Inline (fl_bitmap_copy); - - function fl_bitmap_copy2 - (I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_bitmap_copy2, "fl_bitmap_copy2"); - pragma Inline (fl_bitmap_copy2); - - - - - procedure fl_bitmap_uncache - (I : in Storage.Integer_Address); - pragma Import (C, fl_bitmap_uncache, "fl_bitmap_uncache"); - pragma Inline (fl_bitmap_uncache); - - - - - procedure fl_bitmap_draw2 - (I : in Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_bitmap (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 - (Storage.To_Integer (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 d8730a2..0000000 --- a/src/fltk-images-bitmaps.ads +++ /dev/null @@ -1,89 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 535debf..0000000 --- a/src/fltk-images-pixmaps-gif.adb +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Pixmaps.GIF is - - - function new_fl_gif_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_gif_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 7084a13..0000000 --- a/src/fltk-images-pixmaps-gif.ads +++ /dev/null @@ -1,45 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 006c8b4..0000000 --- a/src/fltk-images-pixmaps-xpm.adb +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Pixmaps.XPM is - - - function new_fl_xpm_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_xpm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 d5bae5a..0000000 --- a/src/fltk-images-pixmaps-xpm.ads +++ /dev/null @@ -1,45 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 2e66d2f..0000000 --- a/src/fltk-images-pixmaps.adb +++ /dev/null @@ -1,186 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Pixmaps is - - - procedure free_fl_pixmap - (I : in Storage.Integer_Address); - pragma Import (C, free_fl_pixmap, "free_fl_pixmap"); - pragma Inline (free_fl_pixmap); - - function fl_pixmap_copy - (I : in Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy"); - pragma Inline (fl_pixmap_copy); - - function fl_pixmap_copy2 - (I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2"); - pragma Inline (fl_pixmap_copy2); - - - - - procedure fl_pixmap_color_average - (I : in Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate"); - pragma Inline (fl_pixmap_desaturate); - - - - - procedure fl_pixmap_uncache - (I : in Storage.Integer_Address); - pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache"); - pragma Inline (fl_pixmap_uncache); - - - - - procedure fl_pixmap_draw2 - (I : in Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_pixmap (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 14e3f94..0000000 --- a/src/fltk-images-pixmaps.ads +++ /dev/null @@ -1,98 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 01669eb..0000000 --- a/src/fltk-images-rgb-bmp.adb +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.RGB.BMP is - - - function new_fl_bmp_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_bmp_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 4eb9e1b..0000000 --- a/src/fltk-images-rgb-bmp.ads +++ /dev/null @@ -1,45 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 17debb5..0000000 --- a/src/fltk-images-rgb-jpeg.adb +++ /dev/null @@ -1,92 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.RGB.JPEG is - - - function new_fl_jpeg_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_jpeg_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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), - Storage.To_Integer (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 0349b01..0000000 --- a/src/fltk-images-rgb-jpeg.ads +++ /dev/null @@ -1,50 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 67befe3..0000000 --- a/src/fltk-images-rgb-png.adb +++ /dev/null @@ -1,94 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.RGB.PNG is - - - function new_fl_png_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address; - S : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_png_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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), - Storage.To_Integer (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 23890b3..0000000 --- a/src/fltk-images-rgb-png.ads +++ /dev/null @@ -1,50 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 362b8d6..0000000 --- a/src/fltk-images-rgb-pnm.adb +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.RGB.PNM is - - - function new_fl_pnm_image - (F : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_pnm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 d72706b..0000000 --- a/src/fltk-images-rgb-pnm.ads +++ /dev/null @@ -1,45 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 19a7952..0000000 --- a/src/fltk-images-rgb.adb +++ /dev/null @@ -1,270 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.RGB is - - - function new_fl_rgb_image - (Data : in Storage.Integer_Address; - W, H, D, L : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address; - C : in Interfaces.C.unsigned) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_rgb_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 - (Storage.To_Integer (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 5768b3c..0000000 --- a/src/fltk-images-rgb.ads +++ /dev/null @@ -1,129 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 d475cc3..0000000 --- a/src/fltk-images-shared.adb +++ /dev/null @@ -1,361 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Images.Shared is - - - function fl_shared_image_get - (F : in Interfaces.C.char_array; - W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - fl_shared_image_release (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 = Null_Pointer 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 dce9254..0000000 --- a/src/fltk-images-shared.ads +++ /dev/null @@ -1,157 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 6bed730..0000000 --- a/src/fltk-images-tiled.adb +++ /dev/null @@ -1,229 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Images.Tiled is - - - function new_fl_tiled_image - (T : in Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_tiled_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - 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 a7e775e..0000000 --- a/src/fltk-images-tiled.ads +++ /dev/null @@ -1,116 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 19a1f86..0000000 --- a/src/fltk-images.adb +++ /dev/null @@ -1,489 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Images is - - - function new_fl_image - (W, H, D : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, new_fl_image, "new_fl_image"); - pragma Inline (new_fl_image); - - procedure free_fl_image - (I : in Storage.Integer_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 Storage.Integer_Address; - W, H : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_image_copy, "fl_image_copy"); - pragma Inline (fl_image_copy); - - function fl_image_copy2 - (I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_image_copy2, "fl_image_copy2"); - pragma Inline (fl_image_copy2); - - - - - procedure fl_image_color_average - (I : in Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_image_desaturate, "fl_image_desaturate"); - pragma Inline (fl_image_desaturate); - - - - - procedure fl_image_inactive - (I : in Storage.Integer_Address); - pragma Import (C, fl_image_inactive, "fl_image_inactive"); - pragma Inline (fl_image_inactive); - - procedure fl_image_uncache - (I : in Storage.Integer_Address); - pragma Import (C, fl_image_uncache, "fl_image_uncache"); - pragma Inline (fl_image_uncache); - - - - - function fl_image_w - (I : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - 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 Storage.To_Address (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 Storage.To_Address (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 Storage.To_Address (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 Storage.To_Address (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 9a02f23..0000000 --- a/src/fltk-images.ads +++ /dev/null @@ -1,237 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_image_fail, "fl_image_fail"); - - -end FLTK.Images; - diff --git a/src/fltk-labels.adb b/src/fltk-labels.adb deleted file mode 100644 index 006db6b..0000000 --- a/src/fltk-labels.adb +++ /dev/null @@ -1,355 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Labels is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_label - (V : in Interfaces.C.Strings.chars_ptr; - F : in Interfaces.C.int; - S : in Interfaces.C.int; - H : in Interfaces.C.unsigned; - K : in Interfaces.C.int; - P : in Interfaces.C.unsigned) - return Storage.Integer_Address; - pragma Import (C, new_fl_label, "new_fl_label"); - pragma Inline (new_fl_label); - - procedure free_fl_label - (L : in Storage.Integer_Address); - pragma Import (C, free_fl_label, "free_fl_label"); - pragma Inline (free_fl_label); - - - - - procedure fl_label_set_value - (L : in Storage.Integer_Address; - V : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_label_set_value, "fl_label_set_value"); - pragma Inline (fl_label_set_value); - - function fl_label_get_font - (L : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_label_get_font, "fl_label_get_font"); - pragma Inline (fl_label_get_font); - - procedure fl_label_set_font - (L : in Storage.Integer_Address; - F : in Interfaces.C.int); - pragma Import (C, fl_label_set_font, "fl_label_set_font"); - pragma Inline (fl_label_set_font); - - function fl_label_get_size - (L : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_label_get_size, "fl_label_get_size"); - pragma Inline (fl_label_get_size); - - procedure fl_label_set_size - (L : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_label_set_size, "fl_label_set_size"); - pragma Inline (fl_label_set_size); - - function fl_label_get_color - (L : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_label_get_color, "fl_label_get_color"); - pragma Inline (fl_label_get_color); - - procedure fl_label_set_color - (L : in Storage.Integer_Address; - H : in Interfaces.C.unsigned); - pragma Import (C, fl_label_set_color, "fl_label_set_color"); - pragma Inline (fl_label_set_color); - - function fl_label_get_type - (L : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_label_get_type, "fl_label_get_type"); - pragma Inline (fl_label_get_type); - - procedure fl_label_set_type - (L : in Storage.Integer_Address; - K : in Interfaces.C.int); - pragma Import (C, fl_label_set_type, "fl_label_set_type"); - pragma Inline (fl_label_set_type); - - function fl_label_get_align - (L : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_label_get_align, "fl_label_get_align"); - pragma Inline (fl_label_get_align); - - procedure fl_label_set_align - (L : in Storage.Integer_Address; - P : in Interfaces.C.unsigned); - pragma Import (C, fl_label_set_align, "fl_label_set_align"); - pragma Inline (fl_label_set_align); - - procedure fl_label_set_image - (L, I : in Storage.Integer_Address); - pragma Import (C, fl_label_set_image, "fl_label_set_image"); - pragma Inline (fl_label_set_image); - - procedure fl_label_set_deimage - (L, I : in Storage.Integer_Address); - pragma Import (C, fl_label_set_deimage, "fl_label_set_deimage"); - pragma Inline (fl_label_set_deimage); - - - - - procedure fl_label_draw - (L : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - P : in Interfaces.C.unsigned); - pragma Import (C, fl_label_draw, "fl_label_draw"); - pragma Inline (fl_label_draw); - - procedure fl_label_measure - (L : in Storage.Integer_Address; - W, H : out Interfaces.C.int); - pragma Import (C, fl_label_measure, "fl_label_measure"); - pragma Inline (fl_label_measure); - - - - - ----------------------------------- - -- Controlled Type Subprograms -- - ----------------------------------- - - procedure Finalize - (This : in out Label) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_label (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - Interfaces.C.Strings.Free (This.My_Text); - end if; - end Finalize; - - - - - ----------------- - -- Label API -- - ----------------- - - package body Forge is - - function Create - (Value : in String; - Font : in Font_Kind := Helvetica; - Size : in Font_Size := Normal_Size; - Hue : in Color := Foreground_Color; - Kind : in Label_Kind := Normal_Label; - Place : in Alignment := Align_Center; - Active : access FLTK.Images.Image'Class := null; - Inactive : access FLTK.Images.Image'Class := null) - return Label is - begin - return This : Label do - This.My_Text := Interfaces.C.Strings.New_String (Value); - This.Void_Ptr := new_fl_label - (This.My_Text, -- Interfaces.C.Strings.chars_ptr - Font_Kind'Pos (Font), -- Interfaces.C.int - Interfaces.C.int (Size), - Interfaces.C.unsigned (Hue), - Label_Kind'Pos (Kind), -- Interfaces.C.int - Interfaces.C.unsigned (Place)); - This.Set_Active (Active); - This.Set_Inactive (Inactive); - end return; - end Create; - - end Forge; - - - - - function Get_Value - (This : in Label) - return String is - begin - return Interfaces.C.Strings.Value (This.My_Text); - end Get_Value; - - - procedure Set_Value - (This : in out Label; - Text : in String) is - begin - Interfaces.C.Strings.Free (This.My_Text); - This.My_Text := Interfaces.C.Strings.New_String (Text); - fl_label_set_value (This.Void_Ptr, This.My_Text); - end Set_Value; - - - function Get_Font - (This : in Label) - return Font_Kind is - begin - return Font_Kind'Val (fl_label_get_font (This.Void_Ptr)); - end Get_Font; - - - procedure Set_Font - (This : in out Label; - Font : in Font_Kind) is - begin - fl_label_set_font (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Font; - - - function Get_Size - (This : in Label) - return Font_Size is - begin - return Font_Size (fl_label_get_size (This.Void_Ptr)); - end Get_Size; - - - procedure Set_Size - (This : in out Label; - Size : in Font_Size) is - begin - fl_label_set_size (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Size; - - - function Get_Color - (This : in Label) - return Color is - begin - return Color (fl_label_get_color (This.Void_Ptr)); - end Get_Color; - - - procedure Set_Color - (This : in out Label; - Hue : in Color) is - begin - fl_label_set_color (This.Void_Ptr, Interfaces.C.unsigned (Hue)); - end Set_Color; - - - function Get_Kind - (This : in Label) - return Label_Kind is - begin - return Label_Kind'Val (fl_label_get_type (This.Void_Ptr)); - end Get_Kind; - - - procedure Set_Kind - (This : in out Label; - Kind : in Label_Kind) is - begin - fl_label_set_type (This.Void_Ptr, Label_Kind'Pos (Kind)); - end Set_Kind; - - - function Get_Alignment - (This : in Label) - return Alignment is - begin - return Alignment (fl_label_get_align (This.Void_Ptr)); - end Get_Alignment; - - - procedure Set_Alignment - (This : in out Label; - Place : in Alignment) is - begin - fl_label_set_align (This.Void_Ptr, Interfaces.C.unsigned (Place)); - end Set_Alignment; - - - function Get_Active - (This : in Label) - return access FLTK.Images.Image'Class is - begin - return This.My_Active; - end Get_Active; - - - procedure Set_Active - (This : in out Label; - Pic : access FLTK.Images.Image'Class) is - begin - if Pic /= null then - fl_label_set_image (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr); - else - fl_label_set_image (This.Void_Ptr, Null_Pointer); - end if; - This.My_Active := Pic; - end Set_Active; - - - function Get_Inactive - (This : in Label) - return access FLTK.Images.Image'Class is - begin - return This.My_Inactive; - end Get_Inactive; - - - procedure Set_Inactive - (This : in out Label; - Pic : access FLTK.Images.Image'Class) is - begin - if Pic /= null then - fl_label_set_deimage (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr); - else - fl_label_set_deimage (This.Void_Ptr, Null_Pointer); - end if; - This.My_Inactive := Pic; - end Set_Inactive; - - - - - procedure Draw - (This : in out Label; - X, Y, W, H : in Integer; - Place : in Alignment) is - begin - fl_label_draw - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.unsigned (Place)); - end Draw; - - procedure Measure - (This : in Label; - W, H : out Integer) is - begin - fl_label_measure - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Measure; - - -end FLTK.Labels; - - diff --git a/src/fltk-labels.ads b/src/fltk-labels.ads deleted file mode 100644 index 5e13a2e..0000000 --- a/src/fltk-labels.ads +++ /dev/null @@ -1,155 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Images; - -private with - - Interfaces.C.Strings; - - -package FLTK.Labels is - - - type Label is new Wrapper with private; - - type Label_Reference (Data : not null access Label'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (Value : in String; - Font : in Font_Kind := Helvetica; - Size : in Font_Size := Normal_Size; - Hue : in Color := Foreground_Color; - Kind : in Label_Kind := Normal_Label; - Place : in Alignment := Align_Center; - Active : access FLTK.Images.Image'Class := null; - Inactive : access FLTK.Images.Image'Class := null) - return Label; - - end Forge; - - - - - function Get_Value - (This : in Label) - return String; - - procedure Set_Value - (This : in out Label; - Text : in String); - - function Get_Font - (This : in Label) - return Font_Kind; - - procedure Set_Font - (This : in out Label; - Font : in Font_Kind); - - function Get_Size - (This : in Label) - return Font_Size; - - procedure Set_Size - (This : in out Label; - Size : in Font_Size); - - function Get_Color - (This : in Label) - return Color; - - procedure Set_Color - (This : in out Label; - Hue : in Color); - - function Get_Kind - (This : in Label) - return Label_Kind; - - procedure Set_Kind - (This : in out Label; - Kind : in Label_Kind); - - function Get_Alignment - (This : in Label) - return Alignment; - - procedure Set_Alignment - (This : in out Label; - Place : in Alignment); - - function Get_Active - (This : in Label) - return access FLTK.Images.Image'Class; - - procedure Set_Active - (This : in out Label; - Pic : access FLTK.Images.Image'Class); - - function Get_Inactive - (This : in Label) - return access FLTK.Images.Image'Class; - - procedure Set_Inactive - (This : in out Label; - Pic : access FLTK.Images.Image'Class); - - - - - procedure Draw - (This : in out Label; - X, Y, W, H : in Integer; - Place : in Alignment); - - procedure Measure - (This : in Label; - W, H : out Integer); - - -private - - - type Label is new Wrapper with record - My_Active : access FLTK.Images.Image'Class; - My_Inactive : access FLTK.Images.Image'Class; - My_Text : Interfaces.C.Strings.chars_ptr; - end record; - - overriding procedure Finalize - (This : in out Label); - - - pragma Inline (Get_Value); - pragma Inline (Get_Font); - pragma Inline (Set_Font); - pragma Inline (Get_Size); - pragma Inline (Set_Size); - pragma Inline (Get_Color); - pragma Inline (Set_Color); - pragma Inline (Get_Kind); - pragma Inline (Set_Kind); - pragma Inline (Get_Alignment); - pragma Inline (Set_Alignment); - pragma Inline (Get_Active); - pragma Inline (Get_Inactive); - - pragma Inline (Draw); - pragma Inline (Measure); - - -end FLTK.Labels; - - diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb deleted file mode 100644 index b93f1f5..0000000 --- a/src/fltk-menu_items.adb +++ /dev/null @@ -1,499 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widget_Callback_Conversions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Menu_Items is - - - package Callback_Convert renames FLTK.Widget_Callback_Conversions; - - - - - function new_fl_menu_item - (T : in Interfaces.C.char_array; - C : in Storage.Integer_Address; - S, F : in Interfaces.C.unsigned_long) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_menu_item (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - 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_Access (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 c2a000c..0000000 --- a/src/fltk-menu_items.ads +++ /dev/null @@ -1,215 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 ad25cbe..0000000 --- a/src/fltk-screen.adb +++ /dev/null @@ -1,282 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 be28134..0000000 --- a/src/fltk-screen.ads +++ /dev/null @@ -1,96 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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-show_argv.adb b/src/fltk-show_argv.adb deleted file mode 100644 index 52e22e2..0000000 --- a/src/fltk-show_argv.adb +++ /dev/null @@ -1,50 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Command_Line, - Interfaces.C.Strings; - - -package body FLTK.Show_Argv is - - - package ACom renames Ada.Command_Line; - package IntC renames Interfaces.C; - package ICS renames Interfaces.C.Strings; - - - function Create_Argv - return ICS.chars_ptr_array - is - Result : ICS.chars_ptr_array (0 .. IntC.size_t (ACom.Argument_Count)); - begin - Result (0) := ICS.New_String (ACom.Command_Name); - for Index in Integer range 1 .. ACom.Argument_Count loop - Result (IntC.size_t (Index)) := ICS.New_String (ACom.Argument (Index)); - end loop; - return Result; - end Create_Argv; - - - procedure Dispatch - (Func : in Show_With_Args_Func; - CObj : in Storage.Integer_Address) - is - Argv : ICS.chars_ptr_array := Create_Argv; - begin - Func (CObj, IntC.int (ACom.Argument_Count + 1), - Storage.To_Integer (Argv (Argv'First)'Address)); - for Ptr of Argv loop - ICS.Free (Ptr); - end loop; - end Dispatch; - - -end FLTK.Show_Argv; - - diff --git a/src/fltk-show_argv.ads b/src/fltk-show_argv.ads deleted file mode 100644 index 231b875..0000000 --- a/src/fltk-show_argv.ads +++ /dev/null @@ -1,35 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -private package FLTK.Show_Argv is - - - -- Used for implementing show(argc,argv) - - type Show_With_Args_Func is access procedure - (CObj : in Storage.Integer_Address; - Argc : in Interfaces.C.int; - Argv : in Storage.Integer_Address); - - procedure Dispatch - (Func : in Show_With_Args_Func; - CObj : in Storage.Integer_Address); - - -private - - - pragma Convention (C, Show_With_Args_Func); - - -end FLTK.Show_Argv; - - diff --git a/src/fltk-static.adb b/src/fltk-static.adb deleted file mode 100644 index 56b30c0..0000000 --- a/src/fltk-static.adb +++ /dev/null @@ -1,1055 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Ada.Containers.Vectors, - Interfaces.C.Strings, - System.Address_To_Access_Conversions, - FLTK.Static_Callback_Conversions; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Static is - - - package Chk renames Ada.Assertions; - package Conv renames FLTK.Static_Callback_Conversions; - - - - - procedure fl_static_add_awake_handler - (H, F : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_static_next_window, "fl_static_next_window"); - pragma Inline (fl_static_next_window); - - function fl_static_modal - return Storage.Integer_Address; - pragma Import (C, fl_static_modal, "fl_static_modal"); - pragma Inline (fl_static_modal); - - - - - function fl_static_readqueue - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - - - - - procedure Awake_Hook - (U : in Storage.Integer_Address); - pragma Convention (C, Awake_Hook); - - procedure Awake_Hook - (U : in Storage.Integer_Address) is - begin - Conv.To_Awake_Access (U).all; - end Awake_Hook; - - - procedure Add_Awake_Handler - (Func : in Awake_Handler) is - begin - fl_static_add_awake_handler - (Storage.To_Integer (Awake_Hook'Address), Conv.To_Address (Func)); - end Add_Awake_Handler; - - - function Get_Awake_Handler - return Awake_Handler - is - Hook, Func : Storage.Integer_Address; - begin - fl_static_get_awake_handler (Hook, Func); - return Conv.To_Awake_Access (Func); - end Get_Awake_Handler; - - - - - procedure Timeout_Hook - (U : in Storage.Integer_Address); - pragma Convention (C, Timeout_Hook); - - procedure Timeout_Hook - (U : in Storage.Integer_Address) is - begin - Conv.To_Timeout_Access (U).all; - end Timeout_Hook; - - - procedure Add_Check - (Func : in Timeout_Handler) is - begin - fl_static_add_check - (Storage.To_Integer (Timeout_Hook'Address), Conv.To_Address (Func)); - end Add_Check; - - - function Has_Check - (Func : in Timeout_Handler) - return Boolean is - begin - return fl_static_has_check - (Storage.To_Integer (Timeout_Hook'Address), - Conv.To_Address (Func)) /= 0; - end Has_Check; - - - procedure Remove_Check - (Func : in Timeout_Handler) is - begin - fl_static_remove_check - (Storage.To_Integer (Timeout_Hook'Address), - Conv.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), - Storage.To_Integer (Timeout_Hook'Address), - Conv.To_Address (Func)); - end Add_Timeout; - - - function Has_Timeout - (Func : in Timeout_Handler) - return Boolean is - begin - return fl_static_has_timeout - (Storage.To_Integer (Timeout_Hook'Address), - Conv.To_Address (Func)) /= 0; - end Has_Timeout; - - - procedure Remove_Timeout - (Func : in Timeout_Handler) is - begin - fl_static_remove_timeout - (Storage.To_Integer (Timeout_Hook'Address), - Conv.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), - Storage.To_Integer (Timeout_Hook'Address), - Conv.To_Address (Func)); - end Repeat_Timeout; - - - - - -- This is handled on the Ada side because otherwise there would be - -- no way to specify which callback to remove in FLTK once one was - -- added. The hook is passed during package init. - package Clipboard_Notify_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Clipboard_Notify_Handler); - - Current_Clip_Notes : Clipboard_Notify_Vectors.Vector; - - procedure Clipboard_Notify_Hook - (S : in Interfaces.C.int; - U : in Storage.Integer_Address); - pragma Convention (C, Clipboard_Notify_Hook); - - procedure Clipboard_Notify_Hook - (S : in Interfaces.C.int; - U : in Storage.Integer_Address) is - begin - for Call of Current_Clip_Notes loop - Call.all (Buffer_Kind'Val (S)); - end loop; - end Clipboard_Notify_Hook; - - - procedure Add_Clipboard_Notify - (Func : in Clipboard_Notify_Handler) is - begin - Current_Clip_Notes.Append (Func); - end Add_Clipboard_Notify; - - - procedure Remove_Clipboard_Notify - (Func : in Clipboard_Notify_Handler) is - begin - for Index in Current_Clip_Notes.First_Index .. Current_Clip_Notes.Last_Index loop - if Current_Clip_Notes (Index) = Func then - Current_Clip_Notes.Delete (Index); - return; - end if; - end loop; - end Remove_Clipboard_Notify; - - - - - procedure FD_Hook - (FD : in Interfaces.C.int; - U : in Storage.Integer_Address); - pragma Convention (C, FD_Hook); - - procedure FD_Hook - (FD : in Interfaces.C.int; - U : in Storage.Integer_Address) is - begin - Conv.To_File_Access (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), - Storage.To_Integer (FD_Hook'Address), - Conv.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), - Storage.To_Integer (FD_Hook'Address), - Conv.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; - - - - - procedure Idle_Hook - (U : in Storage.Integer_Address); - pragma Convention (C, Idle_Hook); - - procedure Idle_Hook - (U : in Storage.Integer_Address) is - begin - Conv.To_Idle_Access (U).all; - end Idle_Hook; - - - procedure Add_Idle - (Func : in Idle_Handler) is - begin - fl_static_add_idle - (Storage.To_Integer (Idle_Hook'Address), - Conv.To_Address (Func)); - end Add_Idle; - - - function Has_Idle - (Func : in Idle_Handler) - return Boolean is - begin - return fl_static_has_idle - (Storage.To_Integer (Idle_Hook'Address), - Conv.To_Address (Func)) /= 0; - end Has_Idle; - - - procedure Remove_Idle - (Func : in Idle_Handler) is - begin - fl_static_remove_idle - (Storage.To_Integer (Idle_Hook'Address), - Conv.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 : Storage.Integer_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 - First_Ptr : Storage.Integer_Address := fl_static_get_first_window; - Actual_First : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if First_Ptr /= Null_Pointer then - First_Ptr := fl_widget_get_user_data (First_Ptr); - pragma Assert (First_Ptr /= Null_Pointer); - Actual_First := Window_Convert.To_Pointer (Storage.To_Address (First_Ptr)); - end if; - return Actual_First; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Next_Ptr : Storage.Integer_Address := fl_static_next_window (Wrapper (From).Void_Ptr); - Actual_Next : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Next_Ptr /= Null_Pointer then - Next_Ptr := fl_widget_get_user_data (Next_Ptr); - pragma Assert (Next_Ptr /= Null_Pointer); - Actual_Next := Window_Convert.To_Pointer (Storage.To_Address (Next_Ptr)); - end if; - return Actual_Next; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Next_Window; - - - function Get_Top_Modal - return access FLTK.Widgets.Groups.Windows.Window'Class - is - Modal_Ptr : Storage.Integer_Address := fl_static_modal; - Actual_Modal : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Modal_Ptr /= Null_Pointer then - Modal_Ptr := fl_widget_get_user_data (Modal_Ptr); - pragma Assert (Modal_Ptr /= Null_Pointer); - Actual_Modal := Window_Convert.To_Pointer (Storage.To_Address (Modal_Ptr)); - end if; - return Actual_Modal; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Top_Modal; - - - - - function Read_Queue - return access FLTK.Widgets.Widget'Class - is - Queue_Ptr : Storage.Integer_Address := fl_static_readqueue; - Actual_Queue : access FLTK.Widgets.Widget'Class; - begin - if Queue_Ptr /= Null_Pointer then - Queue_Ptr := fl_widget_get_user_data (Queue_Ptr); - pragma Assert (Queue_Ptr /= Null_Pointer); - Actual_Queue := Widget_Convert.To_Pointer (Storage.To_Address (Queue_Ptr)); - end if; - return Actual_Queue; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - (Storage.To_Integer (Clipboard_Notify_Hook'Address), Null_Pointer); - - -end FLTK.Static; - diff --git a/src/fltk-static.ads b/src/fltk-static.ads deleted file mode 100644 index 98f44ba..0000000 --- a/src/fltk-static.ads +++ /dev/null @@ -1,453 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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-static_callback_conversions.adb b/src/fltk-static_callback_conversions.adb deleted file mode 100644 index ceb0e62..0000000 --- a/src/fltk-static_callback_conversions.adb +++ /dev/null @@ -1,176 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Unchecked_Conversion, - FLTK.Static; - -use type - - FLTK.Static.Awake_Handler, - FLTK.Static.Timeout_Handler, - FLTK.Static.Idle_Handler, - FLTK.Static.Clipboard_Notify_Handler, - FLTK.Static.File_Handler; - - -package body FLTK.Static_Callback_Conversions is - - - function To_Awake_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Awake_Handler - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Static.Awake_Handler); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_Awake_Access; - - - function To_Address - (Call : in FLTK.Static.Awake_Handler) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Static.Awake_Handler, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - - function To_Timeout_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Timeout_Handler - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Static.Timeout_Handler); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_Timeout_Access; - - - function To_Address - (Call : in FLTK.Static.Timeout_Handler) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Static.Timeout_Handler, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - - function To_Idle_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Idle_Handler - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Static.Idle_Handler); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_Idle_Access; - - - function To_Address - (Call : in FLTK.Static.Idle_Handler) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Static.Idle_Handler, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - - function To_Clipboard_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Clipboard_Notify_Handler - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Static.Clipboard_Notify_Handler); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_Clipboard_Access; - - - function To_Address - (Call : in FLTK.Static.Clipboard_Notify_Handler) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Static.Clipboard_Notify_Handler, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - - function To_File_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.File_Handler - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Static.File_Handler); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_File_Access; - - - function To_Address - (Call : in FLTK.Static.File_Handler) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Static.File_Handler, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - -end FLTK.Static_Callback_Conversions; - - diff --git a/src/fltk-static_callback_conversions.ads b/src/fltk-static_callback_conversions.ads deleted file mode 100644 index 1e10c03..0000000 --- a/src/fltk-static_callback_conversions.ads +++ /dev/null @@ -1,58 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -limited with - - FLTK.Static; - - -private package FLTK.Static_Callback_Conversions is - - - function To_Awake_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Awake_Handler; - - function To_Address - (Call : in FLTK.Static.Awake_Handler) - return Storage.Integer_Address; - - function To_Timeout_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Timeout_Handler; - - function To_Address - (Call : in FLTK.Static.Timeout_Handler) - return Storage.Integer_Address; - - function To_Idle_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Idle_Handler; - - function To_Address - (Call : in FLTK.Static.Idle_Handler) - return Storage.Integer_Address; - - function To_Clipboard_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.Clipboard_Notify_Handler; - - function To_Address - (Call : in FLTK.Static.Clipboard_Notify_Handler) - return Storage.Integer_Address; - - function To_File_Access - (Addy : in Storage.Integer_Address) - return FLTK.Static.File_Handler; - - function To_Address - (Call : in FLTK.Static.File_Handler) - return Storage.Integer_Address; - - -end FLTK.Static_Callback_Conversions; - - diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb deleted file mode 100644 index 1afa2a7..0000000 --- a/src/fltk-text_buffers.adb +++ /dev/null @@ -1,1352 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings, - Ada.Strings.Unbounded, - Ada.Containers; - -use - - Ada.Strings.Unbounded; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - Ada.Containers.Count_Type; - - -package body FLTK.Text_Buffers is - - - function strerror - (Errnum : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, strerror, "strerror"); - - - - - function new_fl_text_buffer - (RS, PGS : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 (Storage.To_Address (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 Storage.Integer_Address) - is - Place : Position := Position (Pos); - Length : Natural := Natural (Deleted); - - Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (Storage.To_Address (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 /= Null_Pointer and This.Needs_Dealloc then - free_fl_text_buffer (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - 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)); - fl_text_buffer_add_modify_callback - (This.Void_Ptr, - Storage.To_Integer (Modify_Callback_Hook'Address), - Storage.To_Integer (This'Address)); - fl_text_buffer_add_predelete_callback - (This.Void_Ptr, - Storage.To_Integer (Predelete_Callback_Hook'Address), - Storage.To_Integer (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 with Interfaces.C.Strings.Value (strerror (Err_No)); - 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 with Interfaces.C.Strings.Value (strerror (Err_No)); - 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 with Interfaces.C.Strings.Value (strerror (Err_No)); - 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 with Interfaces.C.Strings.Value (strerror (Err_No)); - 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 with Interfaces.C.Strings.Value (strerror (Err_No)); - 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 53b2692..0000000 --- a/src/fltk-text_buffers.ads +++ /dev/null @@ -1,490 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 := True; - 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 Storage.Integer_Address); - pragma Convention (C, Modify_Callback_Hook); - - procedure Predelete_Callback_Hook - (Pos, Deleted : in Interfaces.C.int; - UD : in Storage.Integer_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 ccdb649..0000000 --- a/src/fltk-tooltips.adb +++ /dev/null @@ -1,372 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int; - - -package body FLTK.Tooltips is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function fl_tooltip_get_current - return Storage.Integer_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 Storage.Integer_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_disable; - pragma Import (C, fl_tooltip_disable, "fl_tooltip_disable"); - pragma Inline (fl_tooltip_disable); - - procedure fl_tooltip_enter_area - (I : in Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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); - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Target - return access FLTK.Widgets.Widget'Class - is - Widget_Ptr : Storage.Integer_Address := fl_tooltip_get_current; - Actual_Widget : access FLTK.Widgets.Widget'Class; - begin - if Widget_Ptr /= Null_Pointer then - Widget_Ptr := fl_widget_get_user_data (Widget_Ptr); - pragma Assert (Widget_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 := True) is - begin - fl_tooltip_enable (Boolean'Pos (To)); - end Set_Enabled; - - - procedure Disable is - begin - fl_tooltip_disable; - end Disable; - - - 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 4162358..0000000 --- a/src/fltk-tooltips.ads +++ /dev/null @@ -1,132 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 := True); - - procedure Disable; - - 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 (Disable); - 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-widget_callback_conversions.adb b/src/fltk-widget_callback_conversions.adb deleted file mode 100644 index 29f920e..0000000 --- a/src/fltk-widget_callback_conversions.adb +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Unchecked_Conversion, - FLTK.Widgets; - -use type - - FLTK.Widgets.Widget_Callback; - - -package body FLTK.Widget_Callback_Conversions is - - - function To_Access - (Addy : in Storage.Integer_Address) - return FLTK.Widgets.Widget_Callback - is - function Raw is new Ada.Unchecked_Conversion - (Storage.Integer_Address, FLTK.Widgets.Widget_Callback); - begin - if Addy = Null_Pointer then - return null; - else - return Raw (Addy); - end if; - end To_Access; - - - function To_Address - (Call : in FLTK.Widgets.Widget_Callback) - return Storage.Integer_Address - is - function Raw is new Ada.Unchecked_Conversion - (FLTK.Widgets.Widget_Callback, Storage.Integer_Address); - begin - if Call = null then - return Null_Pointer; - else - return Raw (Call); - end if; - end To_Address; - - -end FLTK.Widget_Callback_Conversions; - - diff --git a/src/fltk-widget_callback_conversions.ads b/src/fltk-widget_callback_conversions.ads deleted file mode 100644 index 09932b4..0000000 --- a/src/fltk-widget_callback_conversions.ads +++ /dev/null @@ -1,26 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -limited with - - FLTK.Widgets; - - -private package FLTK.Widget_Callback_Conversions is - - - function To_Access - (Addy : in Storage.Integer_Address) - return FLTK.Widgets.Widget_Callback; - - function To_Address - (Call : in FLTK.Widgets.Widget_Callback) - return Storage.Integer_Address; - - -end FLTK.Widget_Callback_Conversions; - - diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb deleted file mode 100644 index 7b4c848..0000000 --- a/src/fltk-widgets-boxes.adb +++ /dev/null @@ -1,165 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Boxes is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_box - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_box, "new_fl_box"); - pragma Inline (new_fl_box); - - function new_fl_box2 - (K, X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_box2, "new_fl_box2"); - pragma Inline (new_fl_box2); - - procedure free_fl_box - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_box, "free_fl_box"); - pragma Inline (free_fl_box); - - - - - procedure fl_box_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_box_draw, "fl_box_draw"); - pragma Inline (fl_box_draw); - - function fl_box_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_box_handle, "fl_box_handle"); - pragma Inline (fl_box_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Box) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Box) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_box (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Box; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Box) is - begin - This.Draw_Ptr := fl_box_draw'Address; - This.Handle_Ptr := fl_box_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - - function Create - (Kind : in Box_Kind; - X, Y, W, H : in Integer; - Text : in String := "") - return Box is - begin - return This : Box do - This.Void_Ptr := new_fl_box2 - (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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Box) is - begin - Widget (This).Draw; - end Draw; - - - function Handle - (This : in out Box; - Event : in Event_Kind) - return Event_Outcome is - begin - return Widget (This).Handle (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 b0a03dc..0000000 --- a/src/fltk-widgets-boxes.ads +++ /dev/null @@ -1,73 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - function Create - (Kind : in Box_Kind; - 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 Initialize - (This : in out Box); - - overriding procedure Finalize - (This : in out Box); - - procedure Extra_Init - (This : in out Box; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Box) - with Inline; - - - 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 0053e53..0000000 --- a/src/fltk-widgets-buttons-enter.adb +++ /dev/null @@ -1,139 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Enter is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_return_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Enter_Button) is - begin - Extra_Final (Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Enter_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_return_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Enter_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Enter_Button) is - begin - This.Draw_Ptr := fl_return_button_draw'Address; - This.Handle_Ptr := fl_return_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Enter_Button) is - begin - Button (This).Draw; - end Draw; - - - function Handle - (This : in out Enter_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Button (This).Handle (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 0180628..0000000 --- a/src/fltk-widgets-buttons-enter.ads +++ /dev/null @@ -1,70 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - --- 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 Initialize - (This : in out Enter_Button); - - overriding procedure Finalize - (This : in out Enter_Button); - - procedure Extra_Init - (This : in out Enter_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Enter_Button) - with Inline; - - - 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 e565461..0000000 --- a/src/fltk-widgets-buttons-light-check.adb +++ /dev/null @@ -1,157 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Buttons.Light.Check is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_check_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Round the world and home again, that's the sailor's way! - procedure check_button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address); - pragma Export (C, check_button_extra_final_hook, "check_button_extra_final_hook"); - - procedure check_button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address) - is - My_Check_Button : Check_Button; - for My_Check_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Check_Button); - begin - Extra_Final (My_Check_Button); - end check_button_extra_final_hook; - - - procedure Extra_Final - (This : in out Check_Button) is - begin - Extra_Final (Light_Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Check_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_check_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Arrived at the flip side - procedure check_button_extra_init_hook - (Ada_Obj : Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, check_button_extra_init_hook, "check_button_extra_init_hook"); - - procedure check_button_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr) - is - My_Check_Button : Check_Button; - for My_Check_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Check_Button); - begin - Extra_Init - (My_Check_Button, - Integer (X), Integer (Y), - Integer (W), Integer (H), - Interfaces.C.Strings.Value (C_Str)); - end check_button_extra_init_hook; - - - procedure Extra_Init - (This : in out Check_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Light_Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Check_Button) is - begin - This.Draw_Ptr := fl_check_button_draw'Address; - This.Handle_Ptr := fl_check_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 b54d0af..0000000 --- a/src/fltk-widgets-buttons-light-check.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Check_Button is new Light_Button with null record; - - overriding procedure Initialize - (This : in out Check_Button); - - overriding procedure Finalize - (This : in out Check_Button); - - procedure Extra_Init - (This : in out Check_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Check_Button) - with Inline; - - -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 754131d..0000000 --- a/src/fltk-widgets-buttons-light-radio.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Light.Radio is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_radio_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Radio_Light_Button) is - begin - Extra_Final (Light_Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Radio_Light_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_radio_light_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Radio_Light_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Light_Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Radio_Light_Button) is - begin - This.Draw_Ptr := fl_radio_light_button_draw'Address; - This.Handle_Ptr := fl_radio_light_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 5120106..0000000 --- a/src/fltk-widgets-buttons-light-radio.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Radio_Light_Button is new Light_Button with null record; - - overriding procedure Initialize - (This : in out Radio_Light_Button); - - overriding procedure Finalize - (This : in out Radio_Light_Button); - - procedure Extra_Init - (This : in out Radio_Light_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Radio_Light_Button) - with Inline; - - -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 f2c7ed8..0000000 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Light.Round.Radio is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_radio_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Radio_Round_Button) is - begin - Extra_Final (Round_Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Radio_Round_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_radio_round_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Radio_Round_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Round_Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Radio_Round_Button) is - begin - This.Draw_Ptr := fl_radio_round_button_draw'Address; - This.Handle_Ptr := fl_radio_round_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 f46f179..0000000 --- a/src/fltk-widgets-buttons-light-round-radio.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Radio_Round_Button is new Round_Button with null record; - - overriding procedure Initialize - (This : in out Radio_Round_Button); - - overriding procedure Finalize - (This : in out Radio_Round_Button); - - procedure Extra_Init - (This : in out Radio_Round_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Radio_Round_Button) - with Inline; - - -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 2e358ea..0000000 --- a/src/fltk-widgets-buttons-light-round.adb +++ /dev/null @@ -1,116 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Light.Round is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Round_Button) is - begin - Extra_Final (Light_Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Round_Button) is - begin - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_round_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Round_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Light_Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Round_Button) is - begin - This.Draw_Ptr := fl_round_button_draw'Address; - This.Handle_Ptr := fl_round_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 606b11d..0000000 --- a/src/fltk-widgets-buttons-light-round.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Round_Button is new Light_Button with null record; - - overriding procedure Initialize - (This : in out Round_Button); - - overriding procedure Finalize - (This : in out Round_Button); - - procedure Extra_Init - (This : in out Round_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Round_Button) - with Inline; - - -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 41b7bd0..0000000 --- a/src/fltk-widgets-buttons-light.adb +++ /dev/null @@ -1,139 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Light is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Light_Button) is - begin - Extra_Final (Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Light_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_light_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Light_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Light_Button) is - begin - This.Draw_Ptr := fl_light_button_draw'Address; - This.Handle_Ptr := fl_light_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Light_Button) is - begin - Button (This).Draw; - end Draw; - - - function Handle - (This : in out Light_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Button (This).Handle (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 4c3ea95..0000000 --- a/src/fltk-widgets-buttons-light.ads +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Light_Button); - - overriding procedure Finalize - (This : in out Light_Button); - - procedure Extra_Init - (This : in out Light_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Light_Button) - with Inline; - - - 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 f29ce90..0000000 --- a/src/fltk-widgets-buttons-radio.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Radio is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_radio_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Radio_Button) is - begin - Extra_Final (Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Radio_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_radio_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Radio_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Radio_Button) is - begin - This.Draw_Ptr := fl_radio_button_draw'Address; - This.Handle_Ptr := fl_radio_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 557266e..0000000 --- a/src/fltk-widgets-buttons-radio.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Radio_Button is new Button with null record; - - overriding procedure Initialize - (This : in out Radio_Button); - - overriding procedure Finalize - (This : in out Radio_Button); - - procedure Extra_Init - (This : in out Radio_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Radio_Button) - with Inline; - - -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 e3d2d69..0000000 --- a/src/fltk-widgets-buttons-repeat.adb +++ /dev/null @@ -1,149 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Repeat is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_repeat_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); - pragma Inline (free_fl_repeat_button); - - - - - procedure fl_repeat_button_deactivate - (B : in Storage.Integer_Address); - pragma Import (C, fl_repeat_button_deactivate, "fl_repeat_button_deactivate"); - pragma Inline (fl_repeat_button_deactivate); - - - - - procedure fl_repeat_button_draw - (W : in Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Repeat_Button) is - begin - Extra_Final (Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Repeat_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_repeat_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Repeat_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Repeat_Button) is - begin - This.Draw_Ptr := fl_repeat_button_draw'Address; - This.Handle_Ptr := fl_repeat_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Deactivate - (This : in out Repeat_Button) is - begin - fl_repeat_button_deactivate (This.Void_Ptr); - end Deactivate; - - - - - function Handle - (This : in out Repeat_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Button (This).Handle (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 5720f8a..0000000 --- a/src/fltk-widgets-buttons-repeat.ads +++ /dev/null @@ -1,71 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Deactivate - (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 Initialize - (This : in out Repeat_Button); - - overriding procedure Finalize - (This : in out Repeat_Button); - - procedure Extra_Init - (This : in out Repeat_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Repeat_Button) - with Inline; - - - pragma Inline (Deactivate); - - 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 6542aae..0000000 --- a/src/fltk-widgets-buttons-toggle.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Buttons.Toggle is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_toggle_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Toggle_Button) is - begin - Extra_Final (Button (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Toggle_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_toggle_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Toggle_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Button (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Toggle_Button) is - begin - This.Draw_Ptr := fl_toggle_button_draw'Address; - This.Handle_Ptr := fl_toggle_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 2e0c967..0000000 --- a/src/fltk-widgets-buttons-toggle.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Toggle_Button is new Button with null record; - - overriding procedure Initialize - (This : in out Toggle_Button); - - overriding procedure Finalize - (This : in out Toggle_Button); - - procedure Extra_Init - (This : in out Toggle_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Toggle_Button) - with Inline; - - -end FLTK.Widgets.Buttons.Toggle; - - diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb deleted file mode 100644 index c024dd1..0000000 --- a/src/fltk-widgets-buttons.adb +++ /dev/null @@ -1,302 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Buttons is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_button, "new_fl_button"); - pragma Inline (new_fl_button); - - procedure free_fl_button - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_button, "free_fl_button"); - pragma Inline (free_fl_button); - - - - - function fl_button_get_state - (B : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_button_draw, "fl_button_draw"); - pragma Inline (fl_button_draw); - - function fl_button_handle - (W : in Storage.Integer_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 fl_button_simulate_key_action - (B : in Storage.Integer_Address); - pragma Import (C, fl_button_simulate_key_action, "fl_button_simulate_key_action"); - pragma Inline (fl_button_simulate_key_action); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Clipper route successfully navigated - procedure button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address); - pragma Export (C, button_extra_final_hook, "button_extra_final_hook"); - - procedure button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address) - is - My_Button : Button; - for My_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Button); - begin - Extra_Final (My_Button); - end button_extra_final_hook; - - - procedure Extra_Final - (This : in out Button) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Mobius strip traversal complete - procedure button_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, button_extra_init_hook, "button_extra_init_hook"); - - procedure button_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr) - is - My_Button : Button; - for My_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Button); - begin - Extra_Init - (My_Button, - Integer (X), Integer (Y), - Integer (W), Integer (H), - Interfaces.C.Strings.Value (C_Str)); - end button_extra_init_hook; - - - procedure Extra_Init - (This : in out Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Button) is - begin - This.Draw_Ptr := fl_button_draw'Address; - This.Handle_Ptr := fl_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Widget (This).Draw; - end Draw; - - - function Handle - (This : in out Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Widget (This).Handle (Event); - end Handle; - - - - - procedure Simulate_Key_Action - (This : in out Button) is - begin - fl_button_simulate_key_action (This.Void_Ptr); - end Simulate_Key_Action; - - -end FLTK.Widgets.Buttons; - - diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads deleted file mode 100644 index d4c864f..0000000 --- a/src/fltk-widgets-buttons.ads +++ /dev/null @@ -1,119 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - - - - procedure Simulate_Key_Action - (This : in out Button); - - -private - - - type Button is new Widget with null record; - - overriding procedure Initialize - (This : in out Button); - - overriding procedure Finalize - (This : in out Button); - - procedure Extra_Init - (This : in out Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Button) - with Inline; - - - 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); - - pragma Inline (Simulate_Key_Action); - - -end FLTK.Widgets.Buttons; - - diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb deleted file mode 100644 index 1c84ece..0000000 --- a/src/fltk-widgets-charts.adb +++ /dev/null @@ -1,440 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Charts is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_chart - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_chart, "new_fl_chart"); - pragma Inline (new_fl_chart); - - procedure free_fl_chart - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_chart, "free_fl_chart"); - pragma Inline (free_fl_chart); - - - - - procedure fl_chart_add - (C : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_chart_clear, "fl_chart_clear"); - pragma Inline (fl_chart_clear); - - - - - function fl_chart_get_autosize - (C : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_chart_draw, "fl_chart_draw"); - pragma Inline (fl_chart_draw); - - function fl_chart_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_chart_handle, "fl_chart_handle"); - pragma Inline (fl_chart_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Chart) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Chart) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_chart (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Chart; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Chart) is - begin - This.Draw_Ptr := fl_chart_draw'Address; - This.Handle_Ptr := fl_chart_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Widget (This).Draw; - end Draw; - - -end FLTK.Widgets.Charts; - - diff --git a/src/fltk-widgets-charts.ads b/src/fltk-widgets-charts.ads deleted file mode 100644 index 1f02dd0..0000000 --- a/src/fltk-widgets-charts.ads +++ /dev/null @@ -1,174 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - -private - - - type Chart is new Widget with null record; - - overriding procedure Initialize - (This : in out Chart); - - overriding procedure Finalize - (This : in out Chart); - - procedure Extra_Init - (This : in out Chart; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Chart) - with Inline; - - - 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); - - -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 effea2c..0000000 --- a/src/fltk-widgets-clocks-updated-round.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Clocks.Updated.Round is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_round_clock - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_round_clock_draw, "fl_round_clock_draw"); - pragma Inline (fl_round_clock_draw); - - function fl_round_clock_handle - (W : in Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Round_Clock) is - begin - Extra_Final (Updated_Clock (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Round_Clock) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_round_clock (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Round_Clock; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Updated_Clock (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Round_Clock) is - begin - This.Draw_Ptr := fl_round_clock_draw'Address; - This.Handle_Ptr := fl_round_clock_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 8576318..0000000 --- a/src/fltk-widgets-clocks-updated-round.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Round_Clock is new Updated_Clock with null record; - - overriding procedure Initialize - (This : in out Round_Clock); - - overriding procedure Finalize - (This : in out Round_Clock); - - procedure Extra_Init - (This : in out Round_Clock; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Round_Clock) - with Inline; - - -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 7a02052..0000000 --- a/src/fltk-widgets-clocks-updated.adb +++ /dev/null @@ -1,159 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Clocks.Updated is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_clock - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address; - pragma Import (C, new_fl_clock2, "new_fl_clock2"); - pragma Inline (new_fl_clock2); - - procedure free_fl_clock - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_clock, "free_fl_clock"); - pragma Inline (free_fl_clock); - - - - - procedure fl_clock_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_clock_draw, "fl_clock_draw"); - pragma Inline (fl_clock_draw); - - function fl_clock_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_clock_handle, "fl_clock_handle"); - pragma Inline (fl_clock_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Updated_Clock) is - begin - Extra_Final (Clock (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Updated_Clock) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_clock (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Updated_Clock; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Clock (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Updated_Clock) is - begin - This.Draw_Ptr := fl_clock_draw'Address; - This.Handle_Ptr := fl_clock_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Handle - (This : in out Updated_Clock; - Event : in Event_Kind) - return Event_Outcome is - begin - return Clock (This).Handle (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 e25ae18..0000000 --- a/src/fltk-widgets-clocks-updated.ads +++ /dev/null @@ -1,69 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - - - - 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 Initialize - (This : in out Updated_Clock); - - overriding procedure Finalize - (This : in out Updated_Clock); - - procedure Extra_Init - (This : in out Updated_Clock; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Updated_Clock) - with Inline; - - - 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 b632336..0000000 --- a/src/fltk-widgets-clocks.adb +++ /dev/null @@ -1,249 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Clocks is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_clock_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Clock) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Clock) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_clock_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Clock; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Clock) is - begin - This.Draw_Ptr := fl_clock_output_draw'Address; - This.Handle_Ptr := fl_clock_output_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Widget (This).Draw; - 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; - - -end FLTK.Widgets.Clocks; - - diff --git a/src/fltk-widgets-clocks.ads b/src/fltk-widgets-clocks.ads deleted file mode 100644 index 33edf37..0000000 --- a/src/fltk-widgets-clocks.ads +++ /dev/null @@ -1,110 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - -private - - - type Clock is new Widget with null record; - - overriding procedure Initialize - (This : in out Clock); - - overriding procedure Finalize - (This : in out Clock); - - procedure Extra_Init - (This : in out Clock; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Clock) - with Inline; - - - pragma Inline (Get_Hour); - pragma Inline (Get_Minute); - pragma Inline (Get_Second); - - pragma Inline (Get_Time); - pragma Inline (Set_Time); - - pragma Inline (Draw); - - -end FLTK.Widgets.Clocks; - - diff --git a/src/fltk-widgets-groups-browsers-check.adb b/src/fltk-widgets-groups-browsers-check.adb deleted file mode 100644 index 81ba06b..0000000 --- a/src/fltk-widgets-groups-browsers-check.adb +++ /dev/null @@ -1,498 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups.Browsers.Check is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_check_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_check_browser, "new_fl_check_browser"); - pragma Inline (new_fl_check_browser); - - procedure free_fl_check_browser - (C : in Storage.Integer_Address); - pragma Import (C, free_fl_check_browser, "free_fl_check_browser"); - pragma Inline (free_fl_check_browser); - - - - - function fl_check_browser_add - (C : in Storage.Integer_Address; - S : in Interfaces.C.char_array; - B : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_add, "fl_check_browser_add"); - pragma Inline (fl_check_browser_add); - - function fl_check_browser_remove - (C : in Storage.Integer_Address; - I : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_remove, "fl_check_browser_remove"); - pragma Inline (fl_check_browser_remove); - - procedure fl_check_browser_clear - (C : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_clear, "fl_check_browser_clear"); - pragma Inline (fl_check_browser_clear); - - function fl_check_browser_nitems - (C : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_nitems, "fl_check_browser_nitems"); - pragma Inline (fl_check_browser_nitems); - - - - - procedure fl_check_browser_check_all - (C : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_check_all, "fl_check_browser_check_all"); - pragma Inline (fl_check_browser_check_all); - - procedure fl_check_browser_check_none - (C : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_check_none, "fl_check_browser_check_none"); - pragma Inline (fl_check_browser_check_none); - - function fl_check_browser_get_checked - (C : in Storage.Integer_Address; - I : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_get_checked, "fl_check_browser_get_checked"); - pragma Inline (fl_check_browser_get_checked); - - procedure fl_check_browser_set_checked - (C : in Storage.Integer_Address; - I, B : in Interfaces.C.int); - pragma Import (C, fl_check_browser_set_checked, "fl_check_browser_set_checked"); - pragma Inline (fl_check_browser_set_checked); - - function fl_check_browser_nchecked - (C : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_nchecked, "fl_check_browser_nchecked"); - pragma Inline (fl_check_browser_nchecked); - - - - - function fl_check_browser_text - (C : in Storage.Integer_Address; - I : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_check_browser_text, "fl_check_browser_text"); - pragma Inline (fl_check_browser_text); - - function fl_check_browser_value - (C : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_value, "fl_check_browser_value"); - pragma Inline (fl_check_browser_value); - - - - - function fl_check_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_full_width, "fl_check_browser_full_width"); - pragma Inline (fl_check_browser_full_width); - - function fl_check_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_full_height, "fl_check_browser_full_height"); - pragma Inline (fl_check_browser_full_height); - - function fl_check_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_incr_height, "fl_check_browser_incr_height"); - pragma Inline (fl_check_browser_incr_height); - - function fl_check_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_item_quick_height, "fl_check_browser_item_quick_height"); - pragma Inline (fl_check_browser_item_quick_height); - - - - - function fl_check_browser_item_width - (C, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_item_width, "fl_check_browser_item_width"); - pragma Inline (fl_check_browser_item_width); - - function fl_check_browser_item_height - (C, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_item_height, "fl_check_browser_item_height"); - pragma Inline (fl_check_browser_item_height); - - function fl_check_browser_item_first - (C : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_item_first, "fl_check_browser_item_first"); - pragma Inline (fl_check_browser_item_first); - - -- Missing item_last - - function fl_check_browser_item_next - (C, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_item_next, "fl_check_browser_item_next"); - pragma Inline (fl_check_browser_item_next); - - function fl_check_browser_item_prev - (C, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_item_prev, "fl_check_browser_item_prev"); - pragma Inline (fl_check_browser_item_prev); - - -- Missing item_at - - procedure fl_check_browser_item_select - (C, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_check_browser_item_select, "fl_check_browser_item_select"); - pragma Inline (fl_check_browser_item_select); - - function fl_check_browser_item_selected - (C, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_item_selected, "fl_check_browser_item_selected"); - pragma Inline (fl_check_browser_item_selected); - - -- Missing item_swap and item_text - - procedure fl_check_browser_item_draw - (C, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_check_browser_item_draw, "fl_check_browser_item_draw"); - pragma Inline (fl_check_browser_item_draw); - - - - - procedure fl_check_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_draw, "fl_check_browser_draw"); - pragma Inline (fl_check_browser_draw); - - function fl_check_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_handle, "fl_check_browser_handle"); - pragma Inline (fl_check_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Check_Browser) is - begin - Extra_Final (Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Check_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_check_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Check_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Check_Browser) is - begin - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_check_browser_full_width'Address, - Full_List_Height_Ptr => fl_check_browser_full_height'Address, - Average_Item_Height_Ptr => fl_check_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_check_browser_item_quick_height'Address); - This.Draw_Ptr := fl_check_browser_draw'Address; - This.Handle_Ptr := fl_check_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Check_Browser is - begin - return This : Check_Browser do - This.Void_Ptr := new_fl_check_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ------------------------- - -- Check_Browser API -- - ------------------------- - - procedure Add - (This : in out Check_Browser; - Text : in String; - Checked : in Boolean := False) - is - Code : Interfaces.C.int := fl_check_browser_add - (This.Void_Ptr, - Interfaces.C.To_C (Text), - Boolean'Pos (Checked)); - begin - null; - end Add; - - - procedure Remove - (This : in out Check_Browser; - Index : in Positive) - is - Code : Interfaces.C.int := fl_check_browser_remove - (This.Void_Ptr, - Interfaces.C.int (Index)); - begin - null; - end Remove; - - - procedure Clear - (This : in out Check_Browser) is - begin - fl_check_browser_clear (This.Void_Ptr); - end Clear; - - - function Number_Of_Items - (This : in Check_Browser) - return Natural is - begin - return Natural (fl_check_browser_nitems (This.Void_Ptr)); - end Number_Of_Items; - - - - - procedure Check_All - (This : in out Check_Browser) is - begin - fl_check_browser_check_all (This.Void_Ptr); - end Check_All; - - - procedure Check_None - (This : in out Check_Browser) is - begin - fl_check_browser_check_none (This.Void_Ptr); - end Check_None; - - - function Is_Checked - (This : in Check_Browser; - Index : in Positive) - return Boolean is - begin - return fl_check_browser_get_checked (This.Void_Ptr, Interfaces.C.int (Index)) /= 0; - end Is_Checked; - - - procedure Set_Checked - (This : in out Check_Browser; - Index : in Positive; - State : in Boolean := True) is - begin - fl_check_browser_set_checked - (This.Void_Ptr, - Interfaces.C.int (Index), - Boolean'Pos (State)); - end Set_Checked; - - - function Number_Checked - (This : in Check_Browser) - return Natural is - begin - return Natural (fl_check_browser_nchecked (This.Void_Ptr)); - end Number_Checked; - - - - - function Item_Text - (This : in Check_Browser; - Index : in Positive) - return String is - begin - return Interfaces.C.Strings.Value - (fl_check_browser_text (This.Void_Ptr, Interfaces.C.int (Index))); - end Item_Text; - - - function Selected_Index - (This : in Check_Browser) - return Positive is - begin - return Positive (fl_check_browser_value (This.Void_Ptr)); - end Selected_Index; - - - - - function Item_Width - (This : in Check_Browser; - Item : in Item_Cursor) - return Integer is - begin - return Integer (fl_check_browser_item_width - (This.Void_Ptr, - Cursor_To_Address (Item))); - end Item_Width; - - - function Item_Height - (This : in Check_Browser; - Item : in Item_Cursor) - return Integer is - begin - return Integer (fl_check_browser_item_height - (This.Void_Ptr, - Cursor_To_Address (Item))); - end Item_Height; - - - function Item_First - (This : in Check_Browser) - return Item_Cursor is - begin - return Address_To_Cursor (fl_check_browser_item_first (This.Void_Ptr)); - end Item_First; - - - -- Note that Item_Last is not implemented - - - function Item_Next - (This : in Check_Browser; - Item : in Item_Cursor) - return Item_Cursor is - begin - return Address_To_Cursor (fl_check_browser_item_next - (This.Void_Ptr, - Cursor_To_Address (Item))); - end Item_Next; - - - function Item_Previous - (This : in Check_Browser; - Item : in Item_Cursor) - return Item_Cursor is - begin - return Address_To_Cursor (fl_check_browser_item_prev - (This.Void_Ptr, - Cursor_To_Address (Item))); - end Item_Previous; - - - -- Note that Item_At is not implemented - - - procedure Item_Select - (This : in out Check_Browser; - Item : in Item_Cursor; - State : in Boolean := True) is - begin - fl_check_browser_item_select - (This.Void_Ptr, - Cursor_To_Address (Item), - Boolean'Pos (State)); - end Item_Select; - - - function Item_Selected - (This : in Check_Browser; - Item : in Item_Cursor) - return Boolean is - begin - return fl_check_browser_item_selected (This.Void_Ptr, Cursor_To_Address (Item)) /= 0; - end Item_Selected; - - - -- Note that Item_Swap and Item_Text are not implemented - - - procedure Item_Draw - (This : in Check_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer) is - begin - fl_check_browser_item_draw - (This.Void_Ptr, - Cursor_To_Address (Item), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Item_Draw; - - -end FLTK.Widgets.Groups.Browsers.Check; - - diff --git a/src/fltk-widgets-groups-browsers-check.ads b/src/fltk-widgets-groups-browsers-check.ads deleted file mode 100644 index 85f8fd0..0000000 --- a/src/fltk-widgets-groups-browsers-check.ads +++ /dev/null @@ -1,201 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Groups.Browsers.Check is - - - -- Since the FLTK 1.3 implementation doesn't provide the following key functions: - -- - -- item_at / Item_At - -- item_last / Item_Last - -- item_swap / Item_Swap - -- item_text / Item_Text - -- - -- You can't use Sort on a Check_Browser unless you want a crash. The item_* - -- methods in C++ are also private which means with the way they had to be bound, - -- if you override those subprograms in Ada the behaviour in FLTK will not change. - -- - -- These problems are fixed in 1.4 so they will go away once I get there. - - - type Check_Browser is new Browser with private; - - type Check_Browser_Reference (Data : not null access Check_Browser'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_Browser; - - end Forge; - - - - - -- Adding and removing - - procedure Add - (This : in out Check_Browser; - Text : in String; - Checked : in Boolean := False); - - procedure Remove - (This : in out Check_Browser; - Index : in Positive); - - procedure Clear - (This : in out Check_Browser); - - function Number_Of_Items - (This : in Check_Browser) - return Natural; - - - - - -- Checking and unchecking - - procedure Check_All - (This : in out Check_Browser); - - procedure Check_None - (This : in out Check_Browser); - - function Is_Checked - (This : in Check_Browser; - Index : in Positive) - return Boolean; - - procedure Set_Checked - (This : in out Check_Browser; - Index : in Positive; - State : in Boolean := True); - - function Number_Checked - (This : in Check_Browser) - return Natural; - - - - - -- Text and selection - - -- Don't confuse this with the missing Item_Cursor version - function Item_Text - (This : in Check_Browser; - Index : in Positive) - return String; - - function Selected_Index - (This : in Check_Browser) - return Positive; - - - - - -- As mentioned at the start, due to issues with FLTK 1.3 if you override - -- these subprograms the behaviour in FLTK will not change. Should be able - -- to bind them properly once 1.4 comes around. - - function Item_Width - (This : in Check_Browser; - Item : in Item_Cursor) - return Integer; - - function Item_Height - (This : in Check_Browser; - Item : in Item_Cursor) - return Integer; - - function Item_First - (This : in Check_Browser) - return Item_Cursor; - - -- Item_Last missing in 1.3 - - function Item_Next - (This : in Check_Browser; - Item : in Item_Cursor) - return Item_Cursor; - - function Item_Previous - (This : in Check_Browser; - Item : in Item_Cursor) - return Item_Cursor; - - -- Item_At missing in 1.3 - - procedure Item_Select - (This : in out Check_Browser; - Item : in Item_Cursor; - State : in Boolean := True); - - function Item_Selected - (This : in Check_Browser; - Item : in Item_Cursor) - return Boolean; - - -- Item_Swap and Item_Text missing in 1.3 - - procedure Item_Draw - (This : in Check_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer); - - -private - - - type Check_Browser is new Browser with null record; - - overriding procedure Initialize - (This : in out Check_Browser); - - overriding procedure Finalize - (This : in out Check_Browser); - - procedure Extra_Init - (This : in out Check_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Check_Browser); - - - pragma Inline (Add); - pragma Inline (Remove); - pragma Inline (Clear); - pragma Inline (Number_Of_Items); - - pragma Inline (Check_All); - pragma Inline (Check_None); - pragma Inline (Is_Checked); - pragma Inline (Set_Checked); - pragma Inline (Number_Checked); - - pragma Inline (Item_Text); - pragma Inline (Selected_Index); - - pragma Inline (Item_Width); - pragma Inline (Item_Height); - pragma Inline (Item_First); - pragma Inline (Item_Next); - pragma Inline (Item_Previous); - pragma Inline (Item_Select); - pragma Inline (Item_Selected); - pragma Inline (Item_Draw); - - -end FLTK.Widgets.Groups.Browsers.Check; - - diff --git a/src/fltk-widgets-groups-browsers-textline-choice.adb b/src/fltk-widgets-groups-browsers-textline-choice.adb deleted file mode 100644 index 24b1317..0000000 --- a/src/fltk-widgets-groups-browsers-textline-choice.adb +++ /dev/null @@ -1,237 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Groups.Browsers.Textline.Choice is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_select_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_select_browser, "new_fl_select_browser"); - pragma Inline (new_fl_select_browser); - - procedure free_fl_select_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_select_browser, "free_fl_select_browser"); - pragma Inline (free_fl_select_browser); - - - - - function fl_select_browser_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_item_width, "fl_select_browser_item_width"); - pragma Inline (fl_select_browser_item_width); - - function fl_select_browser_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_item_height, "fl_select_browser_item_height"); - pragma Inline (fl_select_browser_item_height); - - function fl_select_browser_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_select_browser_item_first, "fl_select_browser_item_first"); - pragma Inline (fl_select_browser_item_first); - - function fl_select_browser_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_select_browser_item_last, "fl_select_browser_item_last"); - pragma Inline (fl_select_browser_item_last); - - function fl_select_browser_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_select_browser_item_next, "fl_select_browser_item_next"); - pragma Inline (fl_select_browser_item_next); - - function fl_select_browser_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_select_browser_item_prev, "fl_select_browser_item_prev"); - pragma Inline (fl_select_browser_item_prev); - - function fl_select_browser_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_select_browser_item_at, "fl_select_browser_item_at"); - pragma Inline (fl_select_browser_item_at); - - procedure fl_select_browser_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_select_browser_item_select, "fl_select_browser_item_select"); - pragma Inline (fl_select_browser_item_select); - - function fl_select_browser_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_item_selected, "fl_select_browser_item_selected"); - pragma Inline (fl_select_browser_item_selected); - - procedure fl_select_browser_item_swap - (B, X, Y : in Storage.Integer_Address); - pragma Import (C, fl_select_browser_item_swap, "fl_select_browser_item_swap"); - pragma Inline (fl_select_browser_item_swap); - - function fl_select_browser_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_select_browser_item_text, "fl_select_browser_item_text"); - pragma Inline (fl_select_browser_item_text); - - procedure fl_select_browser_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_select_browser_item_draw, "fl_select_browser_item_draw"); - pragma Inline (fl_select_browser_item_draw); - - - - - function fl_select_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_full_width, "fl_select_browser_full_width"); - pragma Inline (fl_select_browser_full_width); - - function fl_select_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_full_height, "fl_select_browser_full_height"); - pragma Inline (fl_select_browser_full_height); - - function fl_select_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_incr_height, "fl_select_browser_incr_height"); - pragma Inline (fl_select_browser_incr_height); - - function fl_select_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_item_quick_height, "fl_select_browser_item_quick_height"); - pragma Inline (fl_select_browser_item_quick_height); - - - - - procedure fl_select_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_select_browser_draw, "fl_select_browser_draw"); - pragma Inline (fl_select_browser_draw); - - function fl_select_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_select_browser_handle, "fl_select_browser_handle"); - pragma Inline (fl_select_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Choice_Browser) is - begin - Extra_Final (Textline_Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Choice_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_select_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Choice_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Textline_Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Choice_Browser) is - begin - This.Item_Override_Ptrs := - (Item_Width_Ptr => fl_select_browser_item_width'Address, - Item_Height_Ptr => fl_select_browser_item_height'Address, - Item_First_Ptr => fl_select_browser_item_first'Address, - Item_Last_Ptr => fl_select_browser_item_last'Address, - Item_Next_Ptr => fl_select_browser_item_next'Address, - Item_Previous_Ptr => fl_select_browser_item_prev'Address, - Item_At_Ptr => fl_select_browser_item_at'Address, - Item_Select_Ptr => fl_select_browser_item_select'Address, - Item_Selected_Ptr => fl_select_browser_item_selected'Address, - Item_Swap_Ptr => fl_select_browser_item_swap'Address, - Item_Text_Ptr => fl_select_browser_item_text'Address, - Item_Draw_Ptr => fl_select_browser_item_draw'Address); - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_select_browser_full_width'Address, - Full_List_Height_Ptr => fl_select_browser_full_height'Address, - Average_Item_Height_Ptr => fl_select_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_select_browser_item_quick_height'Address); - This.Draw_Ptr := fl_select_browser_draw'Address; - This.Handle_Ptr := fl_select_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Choice_Browser is - begin - return This : Choice_Browser do - This.Void_Ptr := new_fl_select_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Groups.Browsers.Textline.Choice; - - diff --git a/src/fltk-widgets-groups-browsers-textline-choice.ads b/src/fltk-widgets-groups-browsers-textline-choice.ads deleted file mode 100644 index a1b78af..0000000 --- a/src/fltk-widgets-groups-browsers-textline-choice.ads +++ /dev/null @@ -1,48 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Groups.Browsers.Textline.Choice is - - - type Choice_Browser is new Textline_Browser with private; - - type Choice_Browser_Reference (Data : not null access Choice_Browser'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_Browser; - - end Forge; - - -private - - - type Choice_Browser is new Textline_Browser with null record; - - overriding procedure Initialize - (This : in out Choice_Browser); - - overriding procedure Finalize - (This : in out Choice_Browser); - - procedure Extra_Init - (This : in out Choice_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Choice_Browser); - - -end FLTK.Widgets.Groups.Browsers.Textline.Choice; - - diff --git a/src/fltk-widgets-groups-browsers-textline-file.adb b/src/fltk-widgets-groups-browsers-textline-file.adb deleted file mode 100644 index bd7ce7f..0000000 --- a/src/fltk-widgets-groups-browsers-textline-file.adb +++ /dev/null @@ -1,512 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Groups.Browsers.Textline.File is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function get_error_message - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, get_error_message, "get_error_message"); - pragma Inline (get_error_message); - - function filename_dname - (L : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, filename_dname, "filename_dname"); - pragma Inline (filename_dname); - - - - - function new_fl_file_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_file_browser, "new_fl_file_browser"); - pragma Inline (new_fl_file_browser); - - procedure free_fl_file_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_file_browser, "free_fl_file_browser"); - pragma Inline (free_fl_file_browser); - - - - - function fl_file_browser_load - (B : in Storage.Integer_Address; - D : in Interfaces.C.char_array; - S : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_load, "fl_file_browser_load"); - pragma Inline (fl_file_browser_load); - - - - - function fl_file_browser_get_filetype - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_get_filetype, "fl_file_browser_get_filetype"); - pragma Inline (fl_file_browser_get_filetype); - - procedure fl_file_browser_set_filetype - (B : in Storage.Integer_Address; - F : in Interfaces.C.int); - pragma Import (C, fl_file_browser_set_filetype, "fl_file_browser_set_filetype"); - pragma Inline (fl_file_browser_set_filetype); - - function fl_file_browser_get_filter - (B : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_browser_get_filter, "fl_file_browser_get_filter"); - pragma Inline (fl_file_browser_get_filter); - - procedure fl_file_browser_set_filter - (B : in Storage.Integer_Address; - F : in Interfaces.C.char_array); - pragma Import (C, fl_file_browser_set_filter, "fl_file_browser_set_filter"); - pragma Inline (fl_file_browser_set_filter); - - function fl_file_browser_get_iconsize - (B : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_file_browser_get_iconsize, "fl_file_browser_get_iconsize"); - pragma Inline (fl_file_browser_get_iconsize); - - procedure fl_file_browser_set_iconsize - (B : in Storage.Integer_Address; - I : in Interfaces.C.unsigned_char); - pragma Import (C, fl_file_browser_set_iconsize, "fl_file_browser_set_iconsize"); - pragma Inline (fl_file_browser_set_iconsize); - - function fl_file_browser_get_textsize - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_get_textsize, "fl_file_browser_get_textsize"); - pragma Inline (fl_file_browser_get_textsize); - - procedure fl_file_browser_set_textsize - (B : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_file_browser_set_textsize, "fl_file_browser_set_textsize"); - pragma Inline (fl_file_browser_set_textsize); - - - - - function fl_file_browser_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_item_width, "fl_file_browser_item_width"); - pragma Inline (fl_file_browser_item_width); - - function fl_file_browser_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_item_height, "fl_file_browser_item_height"); - pragma Inline (fl_file_browser_item_height); - - function fl_file_browser_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_browser_item_first, "fl_file_browser_item_first"); - pragma Inline (fl_file_browser_item_first); - - function fl_file_browser_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_browser_item_last, "fl_file_browser_item_last"); - pragma Inline (fl_file_browser_item_last); - - function fl_file_browser_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_browser_item_next, "fl_file_browser_item_next"); - pragma Inline (fl_file_browser_item_next); - - function fl_file_browser_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_file_browser_item_prev, "fl_file_browser_item_prev"); - pragma Inline (fl_file_browser_item_prev); - - function fl_file_browser_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_file_browser_item_at, "fl_file_browser_item_at"); - pragma Inline (fl_file_browser_item_at); - - procedure fl_file_browser_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_file_browser_item_select, "fl_file_browser_item_select"); - pragma Inline (fl_file_browser_item_select); - - function fl_file_browser_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_item_selected, "fl_file_browser_item_selected"); - pragma Inline (fl_file_browser_item_selected); - - procedure fl_file_browser_item_swap - (B, X, Y : in Storage.Integer_Address); - pragma Import (C, fl_file_browser_item_swap, "fl_file_browser_item_swap"); - pragma Inline (fl_file_browser_item_swap); - - function fl_file_browser_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_browser_item_text, "fl_file_browser_item_text"); - pragma Inline (fl_file_browser_item_text); - - procedure fl_file_browser_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_file_browser_item_draw, "fl_file_browser_item_draw"); - pragma Inline (fl_file_browser_item_draw); - - - - - function fl_file_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_full_width, "fl_file_browser_full_width"); - pragma Inline (fl_file_browser_full_width); - - function fl_file_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_full_height, "fl_file_browser_full_height"); - pragma Inline (fl_file_browser_full_height); - - function fl_file_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_incr_height, "fl_file_browser_incr_height"); - pragma Inline (fl_file_browser_incr_height); - - function fl_file_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_item_quick_height, "fl_file_browser_item_quick_height"); - pragma Inline (fl_file_browser_item_quick_height); - - - - - procedure fl_file_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_file_browser_draw, "fl_file_browser_draw"); - pragma Inline (fl_file_browser_draw); - - function fl_file_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_file_browser_handle, "fl_file_browser_handle"); - pragma Inline (fl_file_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out File_Browser) is - begin - Extra_Final (Textline_Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out File_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_file_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out File_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Textline_Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out File_Browser) is - begin - This.Item_Override_Ptrs := - (Item_Width_Ptr => fl_file_browser_item_width'Address, - Item_Height_Ptr => fl_file_browser_item_height'Address, - Item_First_Ptr => fl_file_browser_item_first'Address, - Item_Last_Ptr => fl_file_browser_item_last'Address, - Item_Next_Ptr => fl_file_browser_item_next'Address, - Item_Previous_Ptr => fl_file_browser_item_prev'Address, - Item_At_Ptr => fl_file_browser_item_at'Address, - Item_Select_Ptr => fl_file_browser_item_select'Address, - Item_Selected_Ptr => fl_file_browser_item_selected'Address, - Item_Swap_Ptr => fl_file_browser_item_swap'Address, - Item_Text_Ptr => fl_file_browser_item_text'Address, - Item_Draw_Ptr => fl_file_browser_item_draw'Address); - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_file_browser_full_width'Address, - Full_List_Height_Ptr => fl_file_browser_full_height'Address, - Average_Item_Height_Ptr => fl_file_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_file_browser_item_quick_height'Address); - This.Draw_Ptr := fl_file_browser_draw'Address; - This.Handle_Ptr := fl_file_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Browser is - begin - return This : File_Browser do - This.Void_Ptr := new_fl_file_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - Current_Sort : FLTK.Filenames.Compare_Function; - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int; - - pragma Convention (C, Compare_Hook); - - function Compare_Hook - (DA, DB : in Storage.Integer_Address) - return Interfaces.C.int - is - Result : FLTK.Filenames.Comparison := Current_Sort - (Interfaces.C.Strings.Value (filename_dname (DA, 0)), - Interfaces.C.Strings.Value (filename_dname (DB, 0))); - begin - return FLTK.Filenames.Comparison'Pos (Result) - 1; - end Compare_Hook; - - - function Load - (This : in out File_Browser; - Dir : in String; - Sort : in not null FLTK.Filenames.Compare_Function := - FLTK.Filenames.Numeric_Sort'Access) - return Natural - is - Msg : Interfaces.C.Strings.chars_ptr; - Code : Interfaces.C.int; - begin - Current_Sort := Sort; - Code := fl_file_browser_load - (This.Void_Ptr, - Interfaces.C.To_C (Dir), - Storage.To_Integer (Compare_Hook'Address)); - if Code = 0 then - Msg := get_error_message; - if Msg /= Interfaces.C.Strings.Null_Ptr then - raise Browser_Load_Error with Interfaces.C.Strings.Value (Msg); - end if; - end if; - return Natural (Code); - end Load; - - - procedure Load - (This : in out File_Browser; - Dir : in String; - Sort : in not null FLTK.Filenames.Compare_Function := - FLTK.Filenames.Numeric_Sort'Access) - is - Result : Natural := This.Load (Dir, Sort); - begin - null; - end Load; - - - - - function Get_File_Kind - (This : in File_Browser) - return File_Kind - is - Code : Interfaces.C.int := fl_file_browser_get_filetype (This.Void_Ptr); - begin - pragma Assert (Code in File_Kind'Pos (File_Kind'First) .. File_Kind'Pos (File_Kind'Last)); - return File_Kind'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_File_Kind; - - - procedure Set_File_Kind - (This : in out File_Browser; - Value : in File_Kind) is - begin - fl_file_browser_set_filetype (This.Void_Ptr, File_Kind'Pos (Value)); - end Set_File_Kind; - - - function Get_Filter - (This : in File_Browser) - return String - is - Result : Interfaces.C.Strings.chars_ptr := fl_file_browser_get_filter (This.Void_Ptr); - begin - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Get_Filter; - - - procedure Set_Filter - (This : in out File_Browser; - Value : in String) is - begin - fl_file_browser_set_filter (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Filter; - - - function Get_Icon_Size - (This : in File_Browser) - return Icon_Size is - begin - return Icon_Size (fl_file_browser_get_iconsize (This.Void_Ptr)); - end Get_Icon_Size; - - - procedure Set_Icon_Size - (This : in out File_Browser; - Value : in Icon_Size) is - begin - fl_file_browser_set_iconsize (This.Void_Ptr, Interfaces.C.unsigned_char (Value)); - end Set_Icon_Size; - - - function Get_Text_Size - (This : in File_Browser) - return Font_Size is - begin - return Font_Size (fl_file_browser_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out File_Browser; - Size : in Font_Size) is - begin - fl_file_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - function Full_List_Height - (This : in File_Browser) - return Integer is - begin - return Textline_Browser (This).Full_List_Height; - end Full_List_Height; - - - function Average_Item_Height - (This : in File_Browser) - return Integer is - begin - return Textline_Browser (This).Average_Item_Height; - end Average_Item_Height; - - - - - function Item_Width - (This : in File_Browser; - Item : in Item_Cursor) - return Integer is - begin - return Textline_Browser (This).Item_Width (Item); - end Item_Width; - - - function Item_Height - (This : in File_Browser; - Item : in Item_Cursor) - return Integer is - begin - return Textline_Browser (This).Item_Height (Item); - end Item_Height; - - - procedure Item_Draw - (This : in File_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer) is - begin - Textline_Browser (This).Item_Draw (Item, X, Y, W, H); - end Item_Draw; - - -end FLTK.Widgets.Groups.Browsers.Textline.File; - - diff --git a/src/fltk-widgets-groups-browsers-textline-file.ads b/src/fltk-widgets-groups-browsers-textline-file.ads deleted file mode 100644 index ed5a4a5..0000000 --- a/src/fltk-widgets-groups-browsers-textline-file.ads +++ /dev/null @@ -1,167 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Filenames; - - -package FLTK.Widgets.Groups.Browsers.Textline.File is - - - -- Due to the inherited methods being made private in C++, overriding - -- - -- Item_Width - -- Item_Height - -- Item_Draw - -- Full_List_Height - -- Average_Item_Height - -- - -- will have no effect on the behaviour of this widget in FLTK. - -- - -- This may change in versions beyond 1.3. - - - type File_Browser is new Textline_Browser with private; - - type File_Browser_Reference (Data : not null access File_Browser'Class) is - limited null record with Implicit_Dereference => Data; - - type File_Kind is (Files, Directories); - - type Icon_Size is mod 256; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Browser; - - end Forge; - - - - - function Load - (This : in out File_Browser; - Dir : in String; - Sort : in not null FLTK.Filenames.Compare_Function := - FLTK.Filenames.Numeric_Sort'Access) - return Natural; - - procedure Load - (This : in out File_Browser; - Dir : in String; - Sort : in not null FLTK.Filenames.Compare_Function := - FLTK.Filenames.Numeric_Sort'Access); - - - - - function Get_File_Kind - (This : in File_Browser) - return File_Kind; - - procedure Set_File_Kind - (This : in out File_Browser; - Value : in File_Kind); - - function Get_Filter - (This : in File_Browser) - return String; - - procedure Set_Filter - (This : in out File_Browser; - Value : in String); - - function Get_Icon_Size - (This : in File_Browser) - return Icon_Size; - - procedure Set_Icon_Size - (This : in out File_Browser; - Value : in Icon_Size); - - function Get_Text_Size - (This : in File_Browser) - return Font_Size; - - procedure Set_Text_Size - (This : in out File_Browser; - Size : in Font_Size); - - - - - function Full_List_Height - (This : in File_Browser) - return Integer; - - function Average_Item_Height - (This : in File_Browser) - return Integer; - - - - - function Item_Width - (This : in File_Browser; - Item : in Item_Cursor) - return Integer; - - function Item_Height - (This : in File_Browser; - Item : in Item_Cursor) - return Integer; - - procedure Item_Draw - (This : in File_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer); - - -private - - - type File_Browser is new Textline_Browser with null record; - - overriding procedure Initialize - (This : in out File_Browser); - - overriding procedure Finalize - (This : in out File_Browser); - - procedure Extra_Init - (This : in out File_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out File_Browser); - - - pragma Inline (Set_File_Kind); - pragma Inline (Set_Filter); - pragma Inline (Get_Icon_Size); - pragma Inline (Set_Icon_Size); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - pragma Inline (Full_List_Height); - pragma Inline (Average_Item_Height); - - pragma Inline (Item_Width); - pragma Inline (Item_Height); - pragma Inline (Item_Draw); - - -end FLTK.Widgets.Groups.Browsers.Textline.File; - - diff --git a/src/fltk-widgets-groups-browsers-textline-hold.adb b/src/fltk-widgets-groups-browsers-textline-hold.adb deleted file mode 100644 index 52465ed..0000000 --- a/src/fltk-widgets-groups-browsers-textline-hold.adb +++ /dev/null @@ -1,238 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Groups.Browsers.Textline.Hold is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_hold_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_hold_browser, "new_fl_hold_browser"); - pragma Inline (new_fl_hold_browser); - - procedure free_fl_hold_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_hold_browser, "free_fl_hold_browser"); - pragma Inline (free_fl_hold_browser); - - - - - - function fl_hold_browser_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_item_width, "fl_hold_browser_item_width"); - pragma Inline (fl_hold_browser_item_width); - - function fl_hold_browser_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_item_height, "fl_hold_browser_item_height"); - pragma Inline (fl_hold_browser_item_height); - - function fl_hold_browser_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_hold_browser_item_first, "fl_hold_browser_item_first"); - pragma Inline (fl_hold_browser_item_first); - - function fl_hold_browser_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_hold_browser_item_last, "fl_hold_browser_item_last"); - pragma Inline (fl_hold_browser_item_last); - - function fl_hold_browser_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_hold_browser_item_next, "fl_hold_browser_item_next"); - pragma Inline (fl_hold_browser_item_next); - - function fl_hold_browser_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_hold_browser_item_prev, "fl_hold_browser_item_prev"); - pragma Inline (fl_hold_browser_item_prev); - - function fl_hold_browser_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_hold_browser_item_at, "fl_hold_browser_item_at"); - pragma Inline (fl_hold_browser_item_at); - - procedure fl_hold_browser_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_hold_browser_item_select, "fl_hold_browser_item_select"); - pragma Inline (fl_hold_browser_item_select); - - function fl_hold_browser_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_item_selected, "fl_hold_browser_item_selected"); - pragma Inline (fl_hold_browser_item_selected); - - procedure fl_hold_browser_item_swap - (B, X, Y : in Storage.Integer_Address); - pragma Import (C, fl_hold_browser_item_swap, "fl_hold_browser_item_swap"); - pragma Inline (fl_hold_browser_item_swap); - - function fl_hold_browser_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_hold_browser_item_text, "fl_hold_browser_item_text"); - pragma Inline (fl_hold_browser_item_text); - - procedure fl_hold_browser_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_hold_browser_item_draw, "fl_hold_browser_item_draw"); - pragma Inline (fl_hold_browser_item_draw); - - - - - function fl_hold_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_full_width, "fl_hold_browser_full_width"); - pragma Inline (fl_hold_browser_full_width); - - function fl_hold_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_full_height, "fl_hold_browser_full_height"); - pragma Inline (fl_hold_browser_full_height); - - function fl_hold_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_incr_height, "fl_hold_browser_incr_height"); - pragma Inline (fl_hold_browser_incr_height); - - function fl_hold_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_item_quick_height, "fl_hold_browser_item_quick_height"); - pragma Inline (fl_hold_browser_item_quick_height); - - - - - procedure fl_hold_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_hold_browser_draw, "fl_hold_browser_draw"); - pragma Inline (fl_hold_browser_draw); - - function fl_hold_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_hold_browser_handle, "fl_hold_browser_handle"); - pragma Inline (fl_hold_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Hold_Browser) is - begin - Extra_Final (Textline_Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Hold_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_hold_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Hold_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Textline_Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Hold_Browser) is - begin - This.Item_Override_Ptrs := - (Item_Width_Ptr => fl_hold_browser_item_width'Address, - Item_Height_Ptr => fl_hold_browser_item_height'Address, - Item_First_Ptr => fl_hold_browser_item_first'Address, - Item_Last_Ptr => fl_hold_browser_item_last'Address, - Item_Next_Ptr => fl_hold_browser_item_next'Address, - Item_Previous_Ptr => fl_hold_browser_item_prev'Address, - Item_At_Ptr => fl_hold_browser_item_at'Address, - Item_Select_Ptr => fl_hold_browser_item_select'Address, - Item_Selected_Ptr => fl_hold_browser_item_selected'Address, - Item_Swap_Ptr => fl_hold_browser_item_swap'Address, - Item_Text_Ptr => fl_hold_browser_item_text'Address, - Item_Draw_Ptr => fl_hold_browser_item_draw'Address); - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_hold_browser_full_width'Address, - Full_List_Height_Ptr => fl_hold_browser_full_height'Address, - Average_Item_Height_Ptr => fl_hold_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_hold_browser_item_quick_height'Address); - This.Draw_Ptr := fl_hold_browser_draw'Address; - This.Handle_Ptr := fl_hold_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hold_Browser is - begin - return This : Hold_Browser do - This.Void_Ptr := new_fl_hold_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Groups.Browsers.Textline.Hold; - - diff --git a/src/fltk-widgets-groups-browsers-textline-hold.ads b/src/fltk-widgets-groups-browsers-textline-hold.ads deleted file mode 100644 index 51dbe98..0000000 --- a/src/fltk-widgets-groups-browsers-textline-hold.ads +++ /dev/null @@ -1,48 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Groups.Browsers.Textline.Hold is - - - type Hold_Browser is new Textline_Browser with private; - - type Hold_Browser_Reference (Data : not null access Hold_Browser'Class) is - limited null record with Implicit_Dereference => Data; - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Hold_Browser; - - end Forge; - - -private - - - type Hold_Browser is new Textline_Browser with null record; - - overriding procedure Initialize - (This : in out Hold_Browser); - - overriding procedure Finalize - (This : in out Hold_Browser); - - procedure Extra_Init - (This : in out Hold_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Hold_Browser); - - -end FLTK.Widgets.Groups.Browsers.Textline.Hold; - - diff --git a/src/fltk-widgets-groups-browsers-textline-multi.adb b/src/fltk-widgets-groups-browsers-textline-multi.adb deleted file mode 100644 index 9d3fbf8..0000000 --- a/src/fltk-widgets-groups-browsers-textline-multi.adb +++ /dev/null @@ -1,237 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Groups.Browsers.Textline.Multi is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_multi_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_multi_browser, "new_fl_multi_browser"); - pragma Inline (new_fl_multi_browser); - - procedure free_fl_multi_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_multi_browser, "free_fl_multi_browser"); - pragma Inline (free_fl_multi_browser); - - - - - function fl_multi_browser_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_item_width, "fl_multi_browser_item_width"); - pragma Inline (fl_multi_browser_item_width); - - function fl_multi_browser_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_item_height, "fl_multi_browser_item_height"); - pragma Inline (fl_multi_browser_item_height); - - function fl_multi_browser_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_multi_browser_item_first, "fl_multi_browser_item_first"); - pragma Inline (fl_multi_browser_item_first); - - function fl_multi_browser_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_multi_browser_item_last, "fl_multi_browser_item_last"); - pragma Inline (fl_multi_browser_item_last); - - function fl_multi_browser_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_multi_browser_item_next, "fl_multi_browser_item_next"); - pragma Inline (fl_multi_browser_item_next); - - function fl_multi_browser_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_multi_browser_item_prev, "fl_multi_browser_item_prev"); - pragma Inline (fl_multi_browser_item_prev); - - function fl_multi_browser_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_multi_browser_item_at, "fl_multi_browser_item_at"); - pragma Inline (fl_multi_browser_item_at); - - procedure fl_multi_browser_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_multi_browser_item_select, "fl_multi_browser_item_select"); - pragma Inline (fl_multi_browser_item_select); - - function fl_multi_browser_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_item_selected, "fl_multi_browser_item_selected"); - pragma Inline (fl_multi_browser_item_selected); - - procedure fl_multi_browser_item_swap - (B, X, Y : in Storage.Integer_Address); - pragma Import (C, fl_multi_browser_item_swap, "fl_multi_browser_item_swap"); - pragma Inline (fl_multi_browser_item_swap); - - function fl_multi_browser_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_multi_browser_item_text, "fl_multi_browser_item_text"); - pragma Inline (fl_multi_browser_item_text); - - procedure fl_multi_browser_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_multi_browser_item_draw, "fl_multi_browser_item_draw"); - pragma Inline (fl_multi_browser_item_draw); - - - - - function fl_multi_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_full_width, "fl_multi_browser_full_width"); - pragma Inline (fl_multi_browser_full_width); - - function fl_multi_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_full_height, "fl_multi_browser_full_height"); - pragma Inline (fl_multi_browser_full_height); - - function fl_multi_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_incr_height, "fl_multi_browser_incr_height"); - pragma Inline (fl_multi_browser_incr_height); - - function fl_multi_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_item_quick_height, "fl_multi_browser_item_quick_height"); - pragma Inline (fl_multi_browser_item_quick_height); - - - - - procedure fl_multi_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_multi_browser_draw, "fl_multi_browser_draw"); - pragma Inline (fl_multi_browser_draw); - - function fl_multi_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multi_browser_handle, "fl_multi_browser_handle"); - pragma Inline (fl_multi_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Multi_Browser) is - begin - Extra_Final (Textline_Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Multi_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_multi_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Multi_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Textline_Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Multi_Browser) is - begin - This.Item_Override_Ptrs := - (Item_Width_Ptr => fl_multi_browser_item_width'Address, - Item_Height_Ptr => fl_multi_browser_item_height'Address, - Item_First_Ptr => fl_multi_browser_item_first'Address, - Item_Last_Ptr => fl_multi_browser_item_last'Address, - Item_Next_Ptr => fl_multi_browser_item_next'Address, - Item_Previous_Ptr => fl_multi_browser_item_prev'Address, - Item_At_Ptr => fl_multi_browser_item_at'Address, - Item_Select_Ptr => fl_multi_browser_item_select'Address, - Item_Selected_Ptr => fl_multi_browser_item_selected'Address, - Item_Swap_Ptr => fl_multi_browser_item_swap'Address, - Item_Text_Ptr => fl_multi_browser_item_text'Address, - Item_Draw_Ptr => fl_multi_browser_item_draw'Address); - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_multi_browser_full_width'Address, - Full_List_Height_Ptr => fl_multi_browser_full_height'Address, - Average_Item_Height_Ptr => fl_multi_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_multi_browser_item_quick_height'Address); - This.Draw_Ptr := fl_multi_browser_draw'Address; - This.Handle_Ptr := fl_multi_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multi_Browser is - begin - return This : Multi_Browser do - This.Void_Ptr := new_fl_multi_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Groups.Browsers.Textline.Multi; - - diff --git a/src/fltk-widgets-groups-browsers-textline-multi.ads b/src/fltk-widgets-groups-browsers-textline-multi.ads deleted file mode 100644 index 373e94f..0000000 --- a/src/fltk-widgets-groups-browsers-textline-multi.ads +++ /dev/null @@ -1,48 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Groups.Browsers.Textline.Multi is - - - type Multi_Browser is new Textline_Browser with private; - - type Multi_Browser_Reference (Data : not null access Multi_Browser'Class) is - limited null record with Implicit_Dereference => Data; - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multi_Browser; - - end Forge; - - -private - - - type Multi_Browser is new Textline_Browser with null record; - - overriding procedure Initialize - (This : in out Multi_Browser); - - overriding procedure Finalize - (This : in out Multi_Browser); - - procedure Extra_Init - (This : in out Multi_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Multi_Browser); - - -end FLTK.Widgets.Groups.Browsers.Textline.Multi; - - diff --git a/src/fltk-widgets-groups-browsers-textline.adb b/src/fltk-widgets-groups-browsers-textline.adb deleted file mode 100644 index 2830732..0000000 --- a/src/fltk-widgets-groups-browsers-textline.adb +++ /dev/null @@ -1,1183 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Ada.Unchecked_Deallocation, - FLTK.Images, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Groups.Browsers.Textline is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function get_error_message - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, get_error_message, "get_error_message"); - pragma Inline (get_error_message); - - - - - function new_fl_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_browser, "new_fl_browser"); - pragma Inline (new_fl_browser); - - procedure free_fl_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_browser, "free_fl_browser"); - pragma Inline (free_fl_browser); - - - - - procedure fl_browser_add - (B : in Storage.Integer_Address; - T : in Interfaces.C.char_array; - D : in Storage.Integer_Address); - pragma Import (C, fl_browser_add, "fl_browser_add"); - pragma Inline (fl_browser_add); - - procedure fl_browser_insert - (B : in Storage.Integer_Address; - L : in Interfaces.C.int; - T : in Interfaces.C.char_array; - D : in Storage.Integer_Address); - pragma Import (C, fl_browser_insert, "fl_browser_insert"); - pragma Inline (fl_browser_insert); - - procedure fl_browser_move - (B : in Storage.Integer_Address; - T, F : in Interfaces.C.int); - pragma Import (C, fl_browser_move, "fl_browser_move"); - pragma Inline (fl_browser_move); - - procedure fl_browser_swap - (B : in Storage.Integer_Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_browser_swap, "fl_browser_swap"); - pragma Inline (fl_browser_swap); - - procedure fl_browser_remove - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_remove, "fl_browser_remove"); - pragma Inline (fl_browser_remove); - - procedure fl_browser_clear - (B : in Storage.Integer_Address); - pragma Import (C, fl_browser_clear, "fl_browser_clear"); - pragma Inline (fl_browser_clear); - - function fl_browser_size - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_size, "fl_browser_size"); - pragma Inline (fl_browser_size); - - - - - function fl_browser_load - (B : in Storage.Integer_Address; - F : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_browser_load, "fl_browser_load"); - pragma Inline (fl_browser_load); - - function fl_browser_get_text - (B : in Storage.Integer_Address; - L : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_browser_get_text, "fl_browser_get_text"); - pragma Inline (fl_browser_get_text); - - procedure fl_browser_set_text - (B : in Storage.Integer_Address; - L : in Interfaces.C.int; - T : in Interfaces.C.char_array); - pragma Import (C, fl_browser_set_text, "fl_browser_set_text"); - pragma Inline (fl_browser_set_text); - - function fl_browser_get_textsize - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_get_textsize, "fl_browser_get_textsize"); - pragma Inline (fl_browser_get_textsize); - - procedure fl_browser_set_textsize - (B : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_browser_set_textsize, "fl_browser_set_textsize"); - pragma Inline (fl_browser_set_textsize); - - - - - function fl_browser_get_column_char - (B : in Storage.Integer_Address) - return Interfaces.C.char; - pragma Import (C, fl_browser_get_column_char, "fl_browser_get_column_char"); - pragma Inline (fl_browser_get_column_char); - - procedure fl_browser_set_column_char - (B : in Storage.Integer_Address; - C : in Interfaces.C.char); - pragma Import (C, fl_browser_set_column_char, "fl_browser_set_column_char"); - pragma Inline (fl_browser_set_column_char); - - procedure fl_browser_set_column_widths - (B, W : in Storage.Integer_Address); - pragma Import (C, fl_browser_set_column_widths, "fl_browser_set_column_widths"); - pragma Inline (fl_browser_set_column_widths); - - function fl_browser_get_format_char - (B : in Storage.Integer_Address) - return Interfaces.C.char; - pragma Import (C, fl_browser_get_format_char, "fl_browser_get_format_char"); - pragma Inline (fl_browser_get_format_char); - - procedure fl_browser_set_format_char - (B : in Storage.Integer_Address; - C : in Interfaces.C.char); - pragma Import (C, fl_browser_set_format_char, "fl_browser_set_format_char"); - pragma Inline (fl_browser_set_format_char); - - - - - function fl_browser_get_topline - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_get_topline, "fl_browser_get_topline"); - pragma Inline (fl_browser_get_topline); - - procedure fl_browser_set_topline - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_set_topline, "fl_browser_set_topline"); - pragma Inline (fl_browser_set_topline); - - procedure fl_browser_middleline - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_middleline, "fl_browser_middleline"); - pragma Inline (fl_browser_middleline); - - procedure fl_browser_bottomline - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_bottomline, "fl_browser_bottomline"); - pragma Inline (fl_browser_bottomline); - - procedure fl_browser_lineposition - (B : in Storage.Integer_Address; - L, P : in Interfaces.C.int); - pragma Import (C, fl_browser_lineposition, "fl_browser_lineposition"); - pragma Inline (fl_browser_lineposition); - - - - - function fl_browser_select - (B : in Storage.Integer_Address; - L, V : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_browser_select, "fl_browser_select"); - pragma Inline (fl_browser_select); - - function fl_browser_selected - (B : in Storage.Integer_Address; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_browser_selected, "fl_browser_selected"); - pragma Inline (fl_browser_selected); - - function fl_browser_value - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_value, "fl_browser_value"); - pragma Inline (fl_browser_value); - - - - - function fl_browser_visible - (B : in Storage.Integer_Address; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_browser_visible, "fl_browser_visible"); - pragma Inline (fl_browser_visible); - - procedure fl_browser_make_visible - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_make_visible, "fl_browser_make_visible"); - pragma Inline (fl_browser_make_visible); - - function fl_browser_displayed - (B : in Storage.Integer_Address; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_browser_displayed, "fl_browser_displayed"); - pragma Inline (fl_browser_displayed); - - procedure fl_browser_show_line - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_show_line, "fl_browser_show_line"); - pragma Inline (fl_browser_show_line); - - procedure fl_browser_hide_line - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_hide_line, "fl_browser_hide_line"); - pragma Inline (fl_browser_hide_line); - - procedure fl_browser_show - (B : in Storage.Integer_Address); - pragma Import (C, fl_browser_show, "fl_browser_show"); - pragma Inline (fl_browser_show); - - procedure fl_browser_hide - (B : in Storage.Integer_Address); - pragma Import (C, fl_browser_hide, "fl_browser_hide"); - pragma Inline (fl_browser_hide); - - - - - procedure fl_browser_set_size - (B : in Storage.Integer_Address; - W, H : in Interfaces.C.int); - pragma Import (C, fl_browser_set_size, "fl_browser_set_size"); - pragma Inline (fl_browser_set_size); - - - - - procedure fl_browser_set_icon - (B : in Storage.Integer_Address; - L : in Interfaces.C.int; - C : in Storage.Integer_Address); - pragma Import (C, fl_browser_set_icon, "fl_browser_set_icon"); - pragma Inline (fl_browser_set_icon); - - procedure fl_browser_remove_icon - (B : in Storage.Integer_Address; - L : in Interfaces.C.int); - pragma Import (C, fl_browser_remove_icon, "fl_browser_remove_icon"); - pragma Inline (fl_browser_remove_icon); - - - - - function fl_browser_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_item_width, "fl_browser_item_width"); - pragma Inline (fl_browser_item_width); - - function fl_browser_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_item_height, "fl_browser_item_height"); - pragma Inline (fl_browser_item_height); - - function fl_browser_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_browser_item_first, "fl_browser_item_first"); - pragma Inline (fl_browser_item_first); - - function fl_browser_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_browser_item_last, "fl_browser_item_last"); - pragma Inline (fl_browser_item_last); - - function fl_browser_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_browser_item_next, "fl_browser_item_next"); - pragma Inline (fl_browser_item_next); - - function fl_browser_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_browser_item_prev, "fl_browser_item_prev"); - pragma Inline (fl_browser_item_prev); - - function fl_browser_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_browser_item_at, "fl_browser_item_at"); - pragma Inline (fl_browser_item_at); - - procedure fl_browser_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - pragma Import (C, fl_browser_item_select, "fl_browser_item_select"); - pragma Inline (fl_browser_item_select); - - function fl_browser_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_item_selected, "fl_browser_item_selected"); - pragma Inline (fl_browser_item_selected); - - procedure fl_browser_item_swap - (B, X, Y : in Storage.Integer_Address); - pragma Import (C, fl_browser_item_swap, "fl_browser_item_swap"); - pragma Inline (fl_browser_item_swap); - - function fl_browser_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_browser_item_text, "fl_browser_item_text"); - pragma Inline (fl_browser_item_text); - - procedure fl_browser_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_browser_item_draw, "fl_browser_item_draw"); - pragma Inline (fl_browser_item_draw); - - - - - function fl_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_full_width, "fl_browser_full_width"); - pragma Inline (fl_browser_full_width); - - function fl_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_full_height, "fl_browser_full_height"); - pragma Inline (fl_browser_full_height); - - function fl_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_incr_height, "fl_browser_incr_height"); - pragma Inline (fl_browser_incr_height); - - function fl_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_item_quick_height, "fl_browser_item_quick_height"); - pragma Inline (fl_browser_item_quick_height); - - - - - function fl_browser_lineno - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_browser_lineno, "fl_browser_lineno"); - pragma Inline (fl_browser_lineno); - - - - - procedure fl_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_browser_draw, "fl_browser_draw"); - pragma Inline (fl_browser_draw); - - function fl_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_browser_handle, "fl_browser_handle"); - pragma Inline (fl_browser_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Free is new Ada.Unchecked_Deallocation - (Object => C_Col_Widths, - Name => C_Col_Widths_Access); - - procedure Free is new Ada.Unchecked_Deallocation - (Object => FLTK.Images.Image'Class, - Name => Image_Access); - - - procedure Extra_Final - (This : in out Textline_Browser) is - begin - Free (This.Columns); - for Icon_Ptr of This.Icons loop - Free (Icon_Ptr); - end loop; - Extra_Final (Browser (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Textline_Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Textline_Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Browser (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Textline_Browser) is - begin - This.Item_Override_Ptrs := - (Item_Width_Ptr => fl_browser_item_width'Address, - Item_Height_Ptr => fl_browser_item_height'Address, - Item_First_Ptr => fl_browser_item_first'Address, - Item_Last_Ptr => fl_browser_item_last'Address, - Item_Next_Ptr => fl_browser_item_next'Address, - Item_Previous_Ptr => fl_browser_item_prev'Address, - Item_At_Ptr => fl_browser_item_at'Address, - Item_Select_Ptr => fl_browser_item_select'Address, - Item_Selected_Ptr => fl_browser_item_selected'Address, - Item_Swap_Ptr => fl_browser_item_swap'Address, - Item_Text_Ptr => fl_browser_item_text'Address, - Item_Draw_Ptr => fl_browser_item_draw'Address); - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_browser_full_width'Address, - Full_List_Height_Ptr => fl_browser_full_height'Address, - Average_Item_Height_Ptr => fl_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_browser_item_quick_height'Address); - This.Draw_Ptr := fl_browser_draw'Address; - This.Handle_Ptr := fl_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Textline_Browser is - begin - return This : Textline_Browser do - This.Void_Ptr := new_fl_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Add - (This : in out Textline_Browser; - Text : in String) is - begin - fl_browser_add - (This.Void_Ptr, - Interfaces.C.To_C (Text), - Null_Pointer); - end Add; - - - procedure Insert - (This : in out Textline_Browser; - Above : in Positive; - Text : in String) is - begin - fl_browser_insert - (This.Void_Ptr, - Interfaces.C.int (Above), - Interfaces.C.To_C (Text), - Null_Pointer); - end Insert; - - - procedure Move - (This : in out Textline_Browser; - From, To : in Positive) is - begin - fl_browser_move - (This.Void_Ptr, - Interfaces.C.int (To), - Interfaces.C.int (From)); - end Move; - - - procedure Swap - (This : in out Textline_Browser; - A, B : in Positive) is - begin - fl_browser_swap - (This.Void_Ptr, - Interfaces.C.int (A), - Interfaces.C.int (B)); - end Swap; - - - procedure Remove - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_remove - (This.Void_Ptr, - Interfaces.C.int (Line)); - end Remove; - - - procedure Clear - (This : in out Textline_Browser) is - begin - fl_browser_clear (This.Void_Ptr); - end Clear; - - - function Number_Of_Lines - (This : in Textline_Browser) - return Natural is - begin - return Natural (fl_browser_size (This.Void_Ptr)); - end Number_Of_Lines; - - - - - procedure Load - (This : in out Textline_Browser; - File : in String) - is - Msg : Interfaces.C.Strings.chars_ptr; - Code : Interfaces.C.int := fl_browser_load (This.Void_Ptr, Interfaces.C.To_C (File)); - begin - if Code = 0 then - Msg := get_error_message; - if Msg = Interfaces.C.Strings.Null_Ptr then - raise Browser_Load_Error; - else - raise Browser_Load_Error with Interfaces.C.Strings.Value (Msg); - end if; - else - pragma Assert (Code = 1); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Load; - - - function Get_Line_Text - (This : in Textline_Browser; - Line : in Positive) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_browser_get_text - (This.Void_Ptr, - Interfaces.C.int (Line)); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Line_Text; - - - procedure Set_Line_Text - (This : in out Textline_Browser; - Line : in Positive; - Text : in String) is - begin - fl_browser_set_text - (This.Void_Ptr, - Interfaces.C.int (Line), - Interfaces.C.To_C (Text)); - end Set_Line_Text; - - - function Get_Text_Size - (This : in Textline_Browser) - return Font_Size is - begin - return Font_Size (fl_browser_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Textline_Browser; - Size : in Font_Size) is - begin - fl_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - function Get_Column_Character - (This : in Textline_Browser) - return Character is - begin - return Interfaces.C.To_Ada (fl_browser_get_column_char (This.Void_Ptr)); - end Get_Column_Character; - - - procedure Set_Column_Character - (This : in out Textline_Browser; - Value : in Character) is - begin - fl_browser_set_column_char (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Column_Character; - - - function Get_Column_Widths - (This : in Textline_Browser) - return Column_Widths is - begin - if This.Columns = null then - return Result : Column_Widths (1 .. 0); - else - return Result : Column_Widths (This.Columns'First .. This.Columns'Last - 1) do - for Index in Result'Range loop - Result (Index) := Integer (This.Columns (Index)); - end loop; - end return; - end if; - end Get_Column_Widths; - - - procedure Set_Column_Widths - (This : in out Textline_Browser; - Widths : in Column_Widths) is - begin - Free (This.Columns); - This.Columns := new C_Col_Widths (1 .. Widths'Length + 1); - for Index in This.Columns'Range loop - This.Columns (Index) := Interfaces.C.int (Widths (Widths'First + Index - 1)); - end loop; - This.Columns (This.Columns'Last) := 0; - fl_browser_set_column_widths (This.Void_Ptr, Storage.To_Integer (This.Columns.all'Address)); - end Set_Column_Widths; - - - function Get_Format_Character - (This : in Textline_Browser) - return Character is - begin - return Interfaces.C.To_Ada (fl_browser_get_format_char (This.Void_Ptr)); - end Get_Format_Character; - - - procedure Set_Format_Character - (This : in out Textline_Browser; - Value : in Character) is - begin - fl_browser_set_format_char (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Format_Character; - - - - - function Get_Top_Line - (This : in Textline_Browser) - return Positive is - begin - return Positive (fl_browser_get_topline (This.Void_Ptr)); - end Get_Top_Line; - - - procedure Set_Top_Line - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_set_topline (This.Void_Ptr, Interfaces.C.int (Line)); - end Set_Top_Line; - - - procedure Set_Middle_Line - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_middleline (This.Void_Ptr, Interfaces.C.int (Line)); - end Set_Middle_Line; - - - procedure Set_Bottom_Line - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_bottomline (This.Void_Ptr, Interfaces.C.int (Line)); - end Set_Bottom_Line; - - - procedure Set_Line_Position - (This : in out Textline_Browser; - Line : in Positive; - Place : in Line_Position) is - begin - fl_browser_lineposition (This.Void_Ptr, Interfaces.C.int (Line), Line_Position'Pos (Place)); - end Set_Line_Position; - - - - - function Set_Select - (This : in out Textline_Browser; - Line : in Positive; - State : in Boolean := True) - return Boolean - is - Code : Interfaces.C.int := fl_browser_select - (This.Void_Ptr, - Interfaces.C.int (Line), - Boolean'Pos (State)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Select; - - - procedure Set_Select - (This : in out Textline_Browser; - Line : in Positive; - State : in Boolean := True) - is - Code : Interfaces.C.int := fl_browser_select - (This.Void_Ptr, - Interfaces.C.int (Line), - Boolean'Pos (State)); - begin - pragma Assert (Code in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Select; - - - function Is_Selected - (This : in Textline_Browser; - Line : in Positive) - return Boolean - is - Code : Interfaces.C.int := fl_browser_selected - (This.Void_Ptr, - Interfaces.C.int (Line)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Is_Selected; - - - function Selected_Index - (This : in Textline_Browser) - return Natural is - begin - return Natural (fl_browser_value (This.Void_Ptr)); - end Selected_Index; - - - - - function Is_Visible - (This : in Textline_Browser; - Line : in Positive) - return Boolean is - begin - return fl_browser_visible (This.Void_Ptr, Interfaces.C.int (Line)) /= 0; - end Is_Visible; - - - procedure Make_Visible - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_make_visible (This.Void_Ptr, Interfaces.C.int (Line)); - end Make_Visible; - - - function Is_Displayed - (This : in Textline_Browser; - Line : in Positive) - return Boolean - is - Code : Interfaces.C.int := fl_browser_displayed - (This.Void_Ptr, - Interfaces.C.int (Line)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Is_Displayed; - - - procedure Show_Line - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_show_line (This.Void_Ptr, Interfaces.C.int (Line)); - end Show_Line; - - - procedure Hide_Line - (This : in out Textline_Browser; - Line : in Positive) is - begin - fl_browser_hide_line (This.Void_Ptr, Interfaces.C.int (Line)); - end Hide_Line; - - - procedure Show - (This : in out Textline_Browser) is - begin - fl_browser_show (This.Void_Ptr); - end Show; - - - procedure Hide - (This : in out Textline_Browser) is - begin - fl_browser_hide (This.Void_Ptr); - end Hide; - - - - - procedure Resize - (This : in out Textline_Browser; - W, H : in Integer) is - begin - fl_browser_set_size - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - function Has_Icon - (This : in Textline_Browser; - Line : in Positive) - return Boolean is - begin - return Line <= This.Icons.Last_Index and then This.Icons.Element (Line) /= null; - end Has_Icon; - - - function Get_Icon - (This : in Textline_Browser; - Line : in Positive) - return FLTK.Images.Image_Reference is - begin - return Ref : FLTK.Images.Image_Reference (Data => This.Icons.Element (Line)); - end Get_Icon; - - - procedure Set_Icon - (This : in out Textline_Browser; - Line : in Positive; - Icon : in FLTK.Images.Image'Class) is - begin - fl_browser_set_icon (This.Void_Ptr, Interfaces.C.int (Line), Wrapper (Icon).Void_Ptr); - if Line > This.Icons.Last_Index then - This.Icons.Append (null, Ada.Containers.Count_Type (Line - This.Icons.Last_Index - 1)); - This.Icons.Append (new FLTK.Images.Image); - Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False; - elsif This.Icons.Element (Line) = null then - This.Icons.Replace_Element (Line, new FLTK.Images.Image); - Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False; - end if; - Wrapper (This.Icons.Element (Line).all).Void_Ptr := Wrapper (Icon).Void_Ptr; - end Set_Icon; - - - procedure Remove_Icon - (This : in out Textline_Browser; - Line : in Positive) - is - Ptr : Image_Access; - begin - fl_browser_remove_icon (This.Void_Ptr, Interfaces.C.int (Line)); - if Line <= This.Icons.Last_Index then - Ptr := This.Icons.Element (Line); - Free (Ptr); - This.Icons.Replace_Element (Line, null); - end if; - end Remove_Icon; - - - - - function Full_List_Height - (This : in Textline_Browser) - return Integer is - begin - return Browser (This).Full_List_Height; - end Full_List_Height; - - - function Average_Item_Height - (This : in Textline_Browser) - return Integer is - begin - return Browser (This).Average_Item_Height; - end Average_Item_Height; - - - - - function Item_Width - (This : in Textline_Browser; - Item : in Item_Cursor) - return Integer - is - function my_item_width - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - for my_item_width'Address use This.Item_Override_Ptrs (Item_Width_Ptr); - pragma Import (Ada, my_item_width); - begin - return Integer (my_item_width (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Width; - - - function Item_Height - (This : in Textline_Browser; - Item : in Item_Cursor) - return Integer - is - function my_item_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - for my_item_height'Address use This.Item_Override_Ptrs (Item_Height_Ptr); - pragma Import (Ada, my_item_height); - begin - return Integer (my_item_height (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Height; - - - function Item_First - (This : in Textline_Browser) - return Item_Cursor - is - function my_item_first - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_item_first'Address use This.Item_Override_Ptrs (Item_First_Ptr); - pragma Import (Ada, my_item_first); - begin - return Address_To_Cursor (my_item_first (This.Void_Ptr)); - end Item_First; - - - function Item_Last - (This : in Textline_Browser) - return Item_Cursor - is - function my_item_last - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_item_last'Address use This.Item_Override_Ptrs (Item_Last_Ptr); - pragma Import (Ada, my_item_last); - begin - return Address_To_Cursor (my_item_last (This.Void_Ptr)); - end Item_Last; - - - function Item_Next - (This : in Textline_Browser; - Item : in Item_Cursor) - return Item_Cursor - is - function my_item_next - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_item_next'Address use This.Item_Override_Ptrs (Item_Next_Ptr); - pragma Import (Ada, my_item_next); - begin - return Address_To_Cursor (my_item_next (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Next; - - - function Item_Previous - (This : in Textline_Browser; - Item : in Item_Cursor) - return Item_Cursor - is - function my_item_prev - (B, I : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_item_prev'Address use This.Item_Override_Ptrs (Item_Previous_Ptr); - pragma Import (Ada, my_item_prev); - begin - return Address_To_Cursor (my_item_prev (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Previous; - - - function Item_At - (This : in Textline_Browser; - Index : in Positive) - return Item_Cursor - is - function my_item_at - (B : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - for my_item_at'Address use This.Item_Override_Ptrs (Item_At_Ptr); - pragma Import (Ada, my_item_at); - begin - return Address_To_Cursor (my_item_at (This.Void_Ptr, Interfaces.C.int (Index))); - end Item_At; - - - procedure Item_Select - (This : in out Textline_Browser; - Item : in Item_Cursor; - State : in Boolean := True) - is - procedure my_item_select - (B, I : in Storage.Integer_Address; - V : in Interfaces.C.int); - for my_item_select'Address use This.Item_Override_Ptrs (Item_Select_Ptr); - pragma Import (Ada, my_item_select); - begin - my_item_select (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (State)); - end Item_Select; - - - function Item_Selected - (This : in Textline_Browser; - Item : in Item_Cursor) - return Boolean - is - function my_item_selected - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - for my_item_selected'Address use This.Item_Override_Ptrs (Item_Selected_Ptr); - pragma Import (Ada, my_item_selected); - Code : Interfaces.C.int := my_item_selected (This.Void_Ptr, Cursor_To_Address (Item)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Item_Selected; - - - procedure Item_Swap - (This : in out Textline_Browser; - A, B : in Item_Cursor) - is - procedure my_item_swap - (B, X, Y : in Storage.Integer_Address); - for my_item_swap'Address use This.Item_Override_Ptrs (Item_Swap_Ptr); - pragma Import (Ada, my_item_swap); - begin - my_item_swap (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B)); - end Item_Swap; - - - function Item_Text - (This : in Textline_Browser; - Item : in Item_Cursor) - return String - is - function my_item_text - (B, I : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - for my_item_text'Address use This.Item_Override_Ptrs (Item_Text_Ptr); - pragma Import (Ada, my_item_text); - begin - return Interfaces.C.Strings.Value (my_item_text (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Text; - - - procedure Item_Draw - (This : in Textline_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer) - is - procedure my_item_draw - (B, I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - for my_item_draw'Address use This.Item_Override_Ptrs (Item_Draw_Ptr); - pragma Import (Ada, my_item_draw); - begin - my_item_draw - (This.Void_Ptr, - Cursor_To_Address (Item), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Item_Draw; - - - - - function Line_Number - (This : in Textline_Browser; - Item : in Item_Cursor) - return Natural is - begin - return Natural (fl_browser_lineno (This.Void_Ptr, Cursor_To_Address (Item))); - end Line_Number; - - -end FLTK.Widgets.Groups.Browsers.Textline; - - diff --git a/src/fltk-widgets-groups-browsers-textline.ads b/src/fltk-widgets-groups-browsers-textline.ads deleted file mode 100644 index 581d2bd..0000000 --- a/src/fltk-widgets-groups-browsers-textline.ads +++ /dev/null @@ -1,440 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Images; - -private with - - Ada.Containers.Vectors, - Interfaces.C, - System; - - -package FLTK.Widgets.Groups.Browsers.Textline is - - - type Textline_Browser is new Browser with private; - - type Textline_Browser_Reference (Data : not null access Textline_Browser'Class) is - limited null record with Implicit_Dereference => Data; - - type Line_Position is (Top, Bottom, Middle); - - type Column_Widths is array (Positive range <>) of Integer; - - - Browser_Load_Error : exception; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Textline_Browser; - - end Forge; - - - - - -- Directly manipulating lines - - procedure Add - (This : in out Textline_Browser; - Text : in String); - - procedure Insert - (This : in out Textline_Browser; - Above : in Positive; - Text : in String); - - -- To destination calculated after From line is removed. - -- Also, note that To/From ordering is opposite from C++ - procedure Move - (This : in out Textline_Browser; - From, To : in Positive); - - procedure Swap - (This : in out Textline_Browser; - A, B : in Positive); - - procedure Remove - (This : in out Textline_Browser; - Line : in Positive); - - procedure Clear - (This : in out Textline_Browser); - - function Number_Of_Lines - (This : in Textline_Browser) - return Natural; - - - - - -- Loading text and text size - - procedure Load - (This : in out Textline_Browser; - File : in String); - - function Get_Line_Text - (This : in Textline_Browser; - Line : in Positive) - return String; - - procedure Set_Line_Text - (This : in out Textline_Browser; - Line : in Positive; - Text : in String); - - function Get_Text_Size - (This : in Textline_Browser) - return Font_Size; - - procedure Set_Text_Size - (This : in out Textline_Browser; - Size : in Font_Size); - - - - - -- Columns and formatting - - function Get_Column_Character - (This : in Textline_Browser) - return Character; - - procedure Set_Column_Character - (This : in out Textline_Browser; - Value : in Character); - - function Get_Column_Widths - (This : in Textline_Browser) - return Column_Widths; - - -- An internal copy is kept of Widths, unlike the C++ version - procedure Set_Column_Widths - (This : in out Textline_Browser; - Widths : in Column_Widths); - - function Get_Format_Character - (This : in Textline_Browser) - return Character; - - procedure Set_Format_Character - (This : in out Textline_Browser; - Value : in Character); - - - - - -- Line positioning - - function Get_Top_Line - (This : in Textline_Browser) - return Positive; - - procedure Set_Top_Line - (This : in out Textline_Browser; - Line : in Positive); - - procedure Set_Middle_Line - (This : in out Textline_Browser; - Line : in Positive); - - procedure Set_Bottom_Line - (This : in out Textline_Browser; - Line : in Positive); - - procedure Set_Line_Position - (This : in out Textline_Browser; - Line : in Positive; - Place : in Line_Position); - - - - - -- Line selection - - function Set_Select - (This : in out Textline_Browser; - Line : in Positive; - State : in Boolean := True) - return Boolean; - - procedure Set_Select - (This : in out Textline_Browser; - Line : in Positive; - State : in Boolean := True); - - function Is_Selected - (This : in Textline_Browser; - Line : in Positive) - return Boolean; - - function Selected_Index - (This : in Textline_Browser) - return Natural; - - - - - -- Visibility, showing, hiding - - function Is_Visible - (This : in Textline_Browser; - Line : in Positive) - return Boolean; - - procedure Make_Visible - (This : in out Textline_Browser; - Line : in Positive); - - function Is_Displayed - (This : in Textline_Browser; - Line : in Positive) - return Boolean; - - procedure Show_Line - (This : in out Textline_Browser; - Line : in Positive); - - procedure Hide_Line - (This : in out Textline_Browser; - Line : in Positive); - - procedure Show - (This : in out Textline_Browser); - - procedure Hide - (This : in out Textline_Browser); - - - - - -- Resizing - - procedure Resize - (This : in out Textline_Browser; - W, H : in Integer); - - - - - -- Icons for specific lines - - function Has_Icon - (This : in Textline_Browser; - Line : in Positive) - return Boolean; - - function Get_Icon - (This : in Textline_Browser; - Line : in Positive) - return FLTK.Images.Image_Reference; - - procedure Set_Icon - (This : in out Textline_Browser; - Line : in Positive; - Icon : in FLTK.Images.Image'Class); - - procedure Remove_Icon - (This : in out Textline_Browser; - Line : in Positive); - - - - - -- List dimensions - - function Full_List_Height - (This : in Textline_Browser) - return Integer; - - function Average_Item_Height - (This : in Textline_Browser) - return Integer; - - - - - -- Item implementation - - function Item_Width - (This : in Textline_Browser; - Item : in Item_Cursor) - return Integer; - - function Item_Height - (This : in Textline_Browser; - Item : in Item_Cursor) - return Integer; - - function Item_First - (This : in Textline_Browser) - return Item_Cursor; - - function Item_Last - (This : in Textline_Browser) - return Item_Cursor; - - function Item_Next - (This : in Textline_Browser; - Item : in Item_Cursor) - return Item_Cursor; - - function Item_Previous - (This : in Textline_Browser; - Item : in Item_Cursor) - return Item_Cursor; - - function Item_At - (This : in Textline_Browser; - Index : in Positive) - return Item_Cursor; - - procedure Item_Select - (This : in out Textline_Browser; - Item : in Item_Cursor; - State : in Boolean := True); - - function Item_Selected - (This : in Textline_Browser; - Item : in Item_Cursor) - return Boolean; - - procedure Item_Swap - (This : in out Textline_Browser; - A, B : in Item_Cursor); - - function Item_Text - (This : in Textline_Browser; - Item : in Item_Cursor) - return String; - - procedure Item_Draw - (This : in Textline_Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer); - - - - - function Line_Number - (This : in Textline_Browser; - Item : in Item_Cursor) - return Natural; - - -private - - - type C_Col_Widths is array (Positive range <>) of aliased Interfaces.C.int - with Convention => C; - - type C_Col_Widths_Access is access C_Col_Widths; - - - type Image_Access is access FLTK.Images.Image'Class; - - package Image_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Image_Access); - - - type Item_Override_Fun is - (Item_Width_Ptr, Item_Height_Ptr, - Item_First_Ptr, Item_Last_Ptr, - Item_Next_Ptr, Item_Previous_Ptr, - Item_At_Ptr, Item_Select_Ptr, - Item_Selected_Ptr, Item_Swap_Ptr, - Item_Text_Ptr, Item_Draw_Ptr); - type Item_Override_Fun_Ptr_Array is array (Item_Override_Fun) of System.Address; - - - type Textline_Browser is new Browser with record - Columns : C_Col_Widths_Access; - Icons : Image_Vectors.Vector; - Item_Override_Ptrs : Item_Override_Fun_Ptr_Array; - end record; - - overriding procedure Initialize - (This : in out Textline_Browser); - - overriding procedure Finalize - (This : in out Textline_Browser); - - procedure Extra_Init - (This : in out Textline_Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Textline_Browser); - - - pragma Inline (Add); - pragma Inline (Insert); - pragma Inline (Move); - pragma Inline (Swap); - pragma Inline (Remove); - pragma Inline (Clear); - pragma Inline (Number_Of_Lines); - - pragma Inline (Set_Line_Text); - pragma Inline (Get_Text_Size); - pragma Inline (Set_Text_Size); - - pragma Inline (Get_Column_Character); - pragma Inline (Set_Column_Character); - pragma Inline (Get_Format_Character); - pragma Inline (Set_Format_Character); - - pragma Inline (Get_Top_Line); - pragma Inline (Set_Top_Line); - pragma Inline (Set_Middle_Line); - pragma Inline (Set_Bottom_Line); - pragma Inline (Set_Line_Position); - - pragma Inline (Selected_Index); - - pragma Inline (Is_Visible); - pragma Inline (Make_Visible); - pragma Inline (Show_Line); - pragma Inline (Hide_Line); - pragma Inline (Show); - pragma Inline (Hide); - - pragma Inline (Has_Icon); - pragma Inline (Get_Icon); - - pragma Inline (Full_List_Height); - pragma Inline (Average_Item_Height); - - pragma Inline (Item_Width); - pragma Inline (Item_Height); - pragma Inline (Item_First); - pragma Inline (Item_Last); - pragma Inline (Item_Next); - pragma Inline (Item_Previous); - pragma Inline (Item_At); - pragma Inline (Item_Select); - pragma Inline (Item_Swap); - pragma Inline (Item_Text); - pragma Inline (Item_Draw); - - pragma Inline (Line_Number); - - -end FLTK.Widgets.Groups.Browsers.Textline; - - diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb deleted file mode 100644 index aa717b7..0000000 --- a/src/fltk-widgets-groups-browsers.adb +++ /dev/null @@ -1,1376 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings, - System.Address_To_Access_Conversions; - - -package body FLTK.Widgets.Groups.Browsers is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Constants From C -- - ------------------------ - - fl_sort_ascending : constant Interfaces.C.int; - pragma Import (C, fl_sort_ascending, "fl_sort_ascending"); - - fl_sort_descending : constant Interfaces.C.int; - pragma Import (C, fl_sort_descending, "fl_sort_descending"); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_abstract_browser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_abstract_browser, "new_fl_abstract_browser"); - pragma Inline (new_fl_abstract_browser); - - procedure free_fl_abstract_browser - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_abstract_browser, "free_fl_abstract_browser"); - pragma Inline (free_fl_abstract_browser); - - - - - function fl_abstract_browser_hscrollbar - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar"); - pragma Inline (fl_abstract_browser_hscrollbar); - - function fl_abstract_browser_scrollbar - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar"); - pragma Inline (fl_abstract_browser_scrollbar); - - - - - function fl_abstract_browser_select - (B, I : in Storage.Integer_Address; - V, C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_select, "fl_abstract_browser_select"); - pragma Inline (fl_abstract_browser_select); - - function fl_abstract_browser_select_only - (B, I : in Storage.Integer_Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_select_only, "fl_abstract_browser_select_only"); - pragma Inline (fl_abstract_browser_select_only); - - function fl_abstract_browser_selection - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_selection, "fl_abstract_browser_selection"); - pragma Inline (fl_abstract_browser_selection); - - function fl_abstract_browser_deselect - (B : in Storage.Integer_Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_deselect, "fl_abstract_browser_deselect"); - pragma Inline (fl_abstract_browser_deselect); - - procedure fl_abstract_browser_display - (B, I : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_display, "fl_abstract_browser_display"); - pragma Inline (fl_abstract_browser_display); - - function fl_abstract_browser_displayed - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_displayed, "fl_abstract_browser_displayed"); - pragma Inline (fl_abstract_browser_displayed); - - function fl_abstract_browser_find_item - (B : in Storage.Integer_Address; - Y : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_find_item, "fl_abstract_browser_find_item"); - pragma Inline (fl_abstract_browser_find_item); - - function fl_abstract_browser_top - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_abstract_browser_top, "fl_abstract_browser_top"); - pragma Inline (fl_abstract_browser_top); - - procedure fl_abstract_browser_sort - (B : in Storage.Integer_Address; - F : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_sort, "fl_abstract_browser_sort"); - pragma Inline (fl_abstract_browser_sort); - - - - - function fl_abstract_browser_get_has_scrollbar - (B : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_abstract_browser_get_has_scrollbar, - "fl_abstract_browser_get_has_scrollbar"); - pragma Inline (fl_abstract_browser_get_has_scrollbar); - - procedure fl_abstract_browser_set_has_scrollbar - (B : in Storage.Integer_Address; - M : in Interfaces.C.unsigned_char); - pragma Import (C, fl_abstract_browser_set_has_scrollbar, - "fl_abstract_browser_set_has_scrollbar"); - pragma Inline (fl_abstract_browser_set_has_scrollbar); - - function fl_abstract_browser_get_hposition - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_get_hposition, "fl_abstract_browser_get_hposition"); - pragma Inline (fl_abstract_browser_get_hposition); - - procedure fl_abstract_browser_set_hposition - (B : in Storage.Integer_Address; - P : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_set_hposition, "fl_abstract_browser_set_hposition"); - pragma Inline (fl_abstract_browser_set_hposition); - - function fl_abstract_browser_get_position - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_get_position, "fl_abstract_browser_get_position"); - pragma Inline (fl_abstract_browser_get_position); - - procedure fl_abstract_browser_set_position - (B : in Storage.Integer_Address; - P : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_set_position, "fl_abstract_browser_set_position"); - pragma Inline (fl_abstract_browser_set_position); - - procedure fl_abstract_browser_scrollbar_left - (B : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_scrollbar_left, "fl_abstract_browser_scrollbar_left"); - pragma Inline (fl_abstract_browser_scrollbar_left); - - procedure fl_abstract_browser_scrollbar_right - (B : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_scrollbar_right, "fl_abstract_browser_scrollbar_right"); - pragma Inline (fl_abstract_browser_scrollbar_right); - - function fl_abstract_browser_get_scrollbar_size - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_get_scrollbar_size, - "fl_abstract_browser_get_scrollbar_size"); - pragma Inline (fl_abstract_browser_get_scrollbar_size); - - procedure fl_abstract_browser_set_scrollbar_size - (B : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_set_scrollbar_size, - "fl_abstract_browser_set_scrollbar_size"); - pragma Inline (fl_abstract_browser_set_scrollbar_size); - - - - - function fl_abstract_browser_get_textcolor - (B : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_abstract_browser_get_textcolor, "fl_abstract_browser_get_textcolor"); - pragma Inline (fl_abstract_browser_get_textcolor); - - procedure fl_abstract_browser_set_textcolor - (B : in Storage.Integer_Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_abstract_browser_set_textcolor, "fl_abstract_browser_set_textcolor"); - pragma Inline (fl_abstract_browser_set_textcolor); - - function fl_abstract_browser_get_textfont - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_get_textfont, "fl_abstract_browser_get_textfont"); - pragma Inline (fl_abstract_browser_get_textfont); - - procedure fl_abstract_browser_set_textfont - (B : in Storage.Integer_Address; - F : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_set_textfont, "fl_abstract_browser_set_textfont"); - pragma Inline (fl_abstract_browser_set_textfont); - - function fl_abstract_browser_get_textsize - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_get_textsize, "fl_abstract_browser_get_textsize"); - pragma Inline (fl_abstract_browser_get_textsize); - - procedure fl_abstract_browser_set_textsize - (B : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_set_textsize, "fl_abstract_browser_set_textsize"); - pragma Inline (fl_abstract_browser_set_textsize); - - - - - procedure fl_abstract_browser_resize - (B : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_abstract_browser_resize, "fl_abstract_browser_resize"); - pragma Inline (fl_abstract_browser_resize); - - procedure fl_abstract_browser_bbox - (B : in Storage.Integer_Address; - X, Y, W, H : out Interfaces.C.int); - pragma Import (C, fl_abstract_browser_bbox, "fl_abstract_browser_bbox"); - pragma Inline (fl_abstract_browser_bbox); - - function fl_abstract_browser_leftedge - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_leftedge, "fl_abstract_browser_leftedge"); - pragma Inline (fl_abstract_browser_leftedge); - - procedure fl_abstract_browser_redraw_line - (B, I : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_redraw_line, "fl_abstract_browser_redraw_line"); - pragma Inline (fl_abstract_browser_redraw_line); - - procedure fl_abstract_browser_redraw_lines - (B : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_redraw_lines, "fl_abstract_browser_redraw_lines"); - pragma Inline (fl_abstract_browser_redraw_lines); - - - - - function fl_abstract_browser_full_width - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_full_width, "fl_abstract_browser_full_width"); - pragma Inline (fl_abstract_browser_full_width); - - function fl_abstract_browser_full_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_full_height, "fl_abstract_browser_full_height"); - pragma Inline (fl_abstract_browser_full_height); - - function fl_abstract_browser_incr_height - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_incr_height, "fl_abstract_browser_incr_height"); - pragma Inline (fl_abstract_browser_incr_height); - - function fl_abstract_browser_item_quick_height - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_item_quick_height, - "fl_abstract_browser_item_quick_height"); - pragma Inline (fl_abstract_browser_item_quick_height); - - - - - procedure fl_abstract_browser_new_list - (B : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_new_list, "fl_abstract_browser_new_list"); - pragma Inline (fl_abstract_browser_new_list); - - procedure fl_abstract_browser_inserting - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_inserting, "fl_abstract_browser_inserting"); - pragma Inline (fl_abstract_browser_inserting); - - procedure fl_abstract_browser_deleting - (B, I : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_deleting, "fl_abstract_browser_deleting"); - pragma Inline (fl_abstract_browser_deleting); - - procedure fl_abstract_browser_replacing - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_replacing, "fl_abstract_browser_replacing"); - pragma Inline (fl_abstract_browser_replacing); - - procedure fl_abstract_browser_swapping - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_swapping, "fl_abstract_browser_swapping"); - pragma Inline (fl_abstract_browser_swapping); - - - - - procedure fl_abstract_browser_draw - (B : in Storage.Integer_Address); - pragma Import (C, fl_abstract_browser_draw, "fl_abstract_browser_draw"); - pragma Inline (fl_abstract_browser_draw); - - function fl_abstract_browser_handle - (B : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_abstract_browser_handle, "fl_abstract_browser_handle"); - pragma Inline (fl_abstract_browser_handle); - - - - - ---------------------- - -- Exported Hooks -- - ---------------------- - - package Browser_Convert is new System.Address_To_Access_Conversions (Browser'Class); - - - function Full_Width_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Full_Width_Hook, "browser_full_width_hook"); - - function Full_Width_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Full_List_Width); - end Full_Width_Hook; - - - function Full_Height_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Full_Height_Hook, "browser_full_height_hook"); - - function Full_Height_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Full_List_Height); - end Full_Height_Hook; - - - function Average_Item_Height_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Average_Item_Height_Hook, "browser_incr_height_hook"); - - function Average_Item_Height_Hook - (Ada_Addr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Average_Item_Height); - end Average_Item_Height_Hook; - - - function Item_Quick_Height_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Item_Quick_Height_Hook, "browser_item_quick_height_hook"); - - function Item_Quick_Height_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Item_Quick_Height (Address_To_Cursor (Item_Ptr))); - end Item_Quick_Height_Hook; - - - function Item_Width_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Item_Width_Hook, "browser_item_width_hook"); - - function Item_Width_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Item_Width (Address_To_Cursor (Item_Ptr))); - end Item_Width_Hook; - - - function Item_Height_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Item_Height_Hook, "browser_item_height_hook"); - - function Item_Height_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Interfaces.C.int (Ada_Object.Item_Height (Address_To_Cursor (Item_Ptr))); - end Item_Height_Hook; - - - function Item_First_Hook - (Ada_Addr : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Export (C, Item_First_Hook, "browser_item_first_hook"); - - function Item_First_Hook - (Ada_Addr : in Storage.Integer_Address) - return Storage.Integer_Address - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Cursor_To_Address (Ada_Object.Item_First); - end Item_First_Hook; - - - function Item_Last_Hook - (Ada_Addr : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Export (C, Item_Last_Hook, "browser_item_last_hook"); - - function Item_Last_Hook - (Ada_Addr : in Storage.Integer_Address) - return Storage.Integer_Address - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Cursor_To_Address (Ada_Object.Item_Last); - end Item_Last_Hook; - - - function Item_Next_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Export (C, Item_Next_Hook, "browser_item_next_hook"); - - function Item_Next_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Storage.Integer_Address - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Cursor_To_Address (Ada_Object.Item_Next (Address_To_Cursor (Item_Ptr))); - end Item_Next_Hook; - - - function Item_Previous_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Export (C, Item_Previous_Hook, "browser_item_prev_hook"); - - function Item_Previous_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Storage.Integer_Address - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Cursor_To_Address (Ada_Object.Item_Previous (Address_To_Cursor (Item_Ptr))); - end Item_Previous_Hook; - - - function Item_At_Hook - (Ada_Addr : in Storage.Integer_Address; - Index : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Export (C, Item_At_Hook, "browser_item_at_hook"); - - function Item_At_Hook - (Ada_Addr : in Storage.Integer_Address; - Index : in Interfaces.C.int) - return Storage.Integer_Address - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - use type Interfaces.C.int; - begin - return Cursor_To_Address (Ada_Object.Item_At (Positive (Index + 1))); - end Item_At_Hook; - - - procedure Item_Select_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address; - Int_State : in Interfaces.C.int); - pragma Export (C, Item_Select_Hook, "browser_item_select_hook"); - - procedure Item_Select_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address; - Int_State : in Interfaces.C.int) - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - use type Interfaces.C.int; - begin - Ada_Object.Item_Select - (Address_To_Cursor (Item_Ptr), - Int_State /= 0); - end Item_Select_Hook; - - - function Item_Selected_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Export (C, Item_Selected_Hook, "browser_item_selected_hook"); - - function Item_Selected_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.int - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - return Boolean'Pos (Ada_Object.Item_Selected (Address_To_Cursor (Item_Ptr))); - end Item_Selected_Hook; - - - procedure Item_Swap_Hook - (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address); - pragma Export (C, Item_Swap_Hook, "browser_item_swap_hook"); - - procedure Item_Swap_Hook - (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address) - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - Ada_Object.Item_Swap (Address_To_Cursor (A_Ptr), Address_To_Cursor (B_Ptr)); - end Item_Swap_Hook; - - - -- The following is a hack due to inherent incompatibilities between Ada Strings - -- and C char pointers. The hook will convert Strings to char* and return them - -- fine for the first two calls, but after that it will deallocate the oldest - -- char* it previously returned to make room for more. Fortunately, this hook - -- is only used by the FLTK C++ side of things for comparing two strings for the - -- purposes of sorting items so it all works out in the end. - - -- Calls by the Ada programmer to Item_Text will be completely unaffected, but - -- this does mean that the default implementation of Sort is not task safe. - - -- At the time of writing this I have no idea how task safe FLTK is anyway. - - function Item_Text_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Export (C, Item_Text_Hook, "browser_item_text_hook"); - - function Item_Text_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - Interfaces.C.Strings.Free (Ada_Object.Text_Store (Ada_Object.Current)); - Ada_Object.Text_Store (Ada_Object.Current) := Interfaces.C.Strings.New_String - (Ada_Object.Item_Text (Address_To_Cursor (Item_Ptr))); - return C_Char_Is_Not_A_String : Interfaces.C.Strings.chars_ptr := - Ada_Object.Text_Store (Ada_Object.Current) - do - Ada_Object.Current := Ada_Object.Current + 1; - if Ada_Object.Current > Ada_Object.Text_Store'Last then - Ada_Object.Current := Ada_Object.Text_Store'First; - end if; - end return; - end Item_Text_Hook; - - - procedure Item_Draw_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Export (C, Item_Draw_Hook, "browser_item_draw_hook"); - - procedure Item_Draw_Hook - (Ada_Addr, Item_Ptr : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int) - is - Ada_Object : access Browser'Class := - Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); - begin - Ada_Object.Item_Draw - (Address_To_Cursor (Item_Ptr), - Integer (X), - Integer (Y), - Integer (W), - Integer (H)); - end Item_Draw_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Preparing to use morse code - procedure fl_scrollbar_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_scrollbar_extra_final, "fl_scrollbar_extra_final"); - pragma Inline (fl_scrollbar_extra_final); - - - procedure Extra_Final - (This : in out Browser) is - begin - fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address)); - fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address)); - Extra_Final (Group (This)); - for Index in This.Text_Store'Range loop - Interfaces.C.Strings.Free (This.Text_Store (Index)); - end loop; - end Extra_Final; - - - procedure Finalize - (This : in out Browser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_abstract_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Boarding the Titanic... - procedure fl_scrollbar_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_scrollbar_extra_init, "fl_scrollbar_extra_init"); - pragma Inline (fl_scrollbar_extra_init); - - - procedure Extra_Init - (This : in out Browser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Widget (This.Horizon).Void_Ptr := fl_abstract_browser_hscrollbar (This.Void_Ptr); - Widget (This.Horizon).Needs_Dealloc := False; - fl_scrollbar_extra_init - (Storage.To_Integer (This.Horizon'Address), - Interfaces.C.int (This.Horizon.Get_X), - Interfaces.C.int (This.Horizon.Get_Y), - Interfaces.C.int (This.Horizon.Get_W), - Interfaces.C.int (This.Horizon.Get_H), - Interfaces.C.To_C (This.Horizon.Get_Label)); - Widget (This.Vertigo).Void_Ptr := fl_abstract_browser_scrollbar (This.Void_Ptr); - Widget (This.Vertigo).Needs_Dealloc := False; - fl_scrollbar_extra_init - (Storage.To_Integer (This.Vertigo'Address), - Interfaces.C.int (This.Vertigo.Get_X), - Interfaces.C.int (This.Vertigo.Get_Y), - Interfaces.C.int (This.Vertigo.Get_W), - Interfaces.C.int (This.Vertigo.Get_H), - Interfaces.C.To_C (This.Vertigo.Get_Label)); - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Browser) is - begin - This.Wide_High_Ptrs := - (Full_List_Width_Ptr => fl_abstract_browser_full_width'Address, - Full_List_Height_Ptr => fl_abstract_browser_full_height'Address, - Average_Item_Height_Ptr => fl_abstract_browser_incr_height'Address, - Item_Quick_Height_Ptr => fl_abstract_browser_item_quick_height'Address); - This.Draw_Ptr := fl_abstract_browser_draw'Address; - This.Handle_Ptr := fl_abstract_browser_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Browser is - begin - return This : Browser do - This.Void_Ptr := new_fl_abstract_browser - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - -- Access to the Browser's self contained scrollbars - - function H_Bar - (This : in out Browser) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference is - begin - return (Data => This.Horizon'Unchecked_Access); - end H_Bar; - - - function V_Bar - (This : in out Browser) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference is - begin - return (Data => This.Vertigo'Unchecked_Access); - end V_Bar; - - - - - -- Item related settings - - function Set_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True; - Do_Callbacks : in Boolean := False) - return Boolean - is - Code : Interfaces.C.int := fl_abstract_browser_select - (This.Void_Ptr, - Cursor_To_Address (Item), - Boolean'Pos (State), - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Select; - - - procedure Set_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True; - Do_Callbacks : in Boolean := False) - is - Code : Interfaces.C.int := fl_abstract_browser_select - (This.Void_Ptr, - Cursor_To_Address (Item), - Boolean'Pos (State), - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Select; - - - function Select_Only - (This : in out Browser; - Item : in Item_Cursor; - Do_Callbacks : in Boolean := False) - return Boolean - is - Code : Interfaces.C.int := fl_abstract_browser_select_only - (This.Void_Ptr, - Cursor_To_Address (Item), - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Select_Only; - - - procedure Select_Only - (This : in out Browser; - Item : in Item_Cursor; - Do_Callbacks : in Boolean := False) - is - Code : Interfaces.C.int := fl_abstract_browser_select_only - (This.Void_Ptr, - Cursor_To_Address (Item), - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Select_Only; - - - function Current_Selection - (This : in Browser) - return Item_Cursor is - begin - return Address_To_Cursor (fl_abstract_browser_selection (This.Void_Ptr)); - end Current_Selection; - - - function Deselect - (This : in out Browser; - Do_Callbacks : in Boolean := False) - return Boolean - is - Code : Interfaces.C.int := fl_abstract_browser_deselect - (This.Void_Ptr, - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Deselect; - - - procedure Deselect - (This : in out Browser; - Do_Callbacks : in Boolean := False) - is - Code : Interfaces.C.int := fl_abstract_browser_deselect - (This.Void_Ptr, - Boolean'Pos (Do_Callbacks)); - begin - pragma Assert (Code in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Deselect; - - - procedure Display - (This : in out Browser; - Item : in Item_Cursor) is - begin - fl_abstract_browser_display (This.Void_Ptr, Cursor_To_Address (Item)); - end Display; - - - function Is_Displayed - (This : in Browser; - Item : in Item_Cursor) - return Boolean - is - Code : Interfaces.C.int := fl_abstract_browser_displayed - (This.Void_Ptr, Cursor_To_Address (Item)); - begin - pragma Assert (Code in 0 .. 1); - return Boolean'Val (Code); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Is_Displayed; - - - function Find_Item - (This : in Browser; - Y_Pos : in Integer) - return Item_Cursor is - begin - return Address_To_Cursor (fl_abstract_browser_find_item - (This.Void_Ptr, - Interfaces.C.int (Y_Pos))); - end Find_Item; - - - function Top_Item - (This : in Browser) - return Item_Cursor is - begin - return Address_To_Cursor (fl_abstract_browser_top (This.Void_Ptr)); - end Top_Item; - - - procedure Sort - (This : in out Browser; - Order : in Sort_Order) - is - Code : Interfaces.C.int := - (case Order is - when Ascending => fl_sort_ascending, - when Descending => fl_sort_descending); - begin - fl_abstract_browser_sort (This.Void_Ptr, Code); - end Sort; - - - - - -- Scrollbar related settings - - function Get_Scrollbar_Mode - (This : in Browser) - return Scrollbar_Mode is - begin - return Uchar_To_Mode (fl_abstract_browser_get_has_scrollbar (This.Void_Ptr)); - end Get_Scrollbar_Mode; - - - procedure Set_Scrollbar_Mode - (This : in out Browser; - Mode : in Scrollbar_Mode) is - begin - fl_abstract_browser_set_has_scrollbar (This.Void_Ptr, Mode_To_Uchar (Mode)); - end Set_Scrollbar_Mode; - - - function Get_H_Position - (This : in Browser) - return Integer is - begin - return Integer (fl_abstract_browser_get_hposition (This.Void_Ptr)); - end Get_H_Position; - - - procedure Set_H_Position - (This : in out Browser; - Value : in Integer) is - begin - fl_abstract_browser_set_hposition - (This.Void_Ptr, - Interfaces.C.int (Value)); - end Set_H_Position; - - - function Get_V_Position - (This : in Browser) - return Integer is - begin - return Integer (fl_abstract_browser_get_position (This.Void_Ptr)); - end Get_V_Position; - - - procedure Set_V_Position - (This : in out Browser; - Value : in Integer) is - begin - fl_abstract_browser_set_position - (This.Void_Ptr, - Interfaces.C.int (Value)); - end Set_V_Position; - - - procedure Set_Vertical_Left - (This : in out Browser) is - begin - fl_abstract_browser_scrollbar_left (This.Void_Ptr); - end Set_Vertical_Left; - - - procedure Set_Vertical_Right - (This : in out Browser) is - begin - fl_abstract_browser_scrollbar_right (This.Void_Ptr); - end Set_Vertical_Right; - - - function Get_Scrollbar_Size - (This : in Browser) - return Integer is - begin - return Integer (fl_abstract_browser_get_scrollbar_size (This.Void_Ptr)); - end Get_Scrollbar_Size; - - - procedure Set_Scrollbar_Size - (This : in out Browser; - Value : in Integer) is - begin - fl_abstract_browser_set_scrollbar_size - (This.Void_Ptr, - Interfaces.C.int (Value)); - end Set_Scrollbar_Size; - - - - - -- Text related settings - - function Get_Text_Color - (This : in Browser) - return Color is - begin - return Color (fl_abstract_browser_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Browser; - Value : in Color) is - begin - fl_abstract_browser_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Browser) - return Font_Kind is - begin - return Font_Kind'Val (fl_abstract_browser_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Browser; - Font : in Font_Kind) is - begin - fl_abstract_browser_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Browser) - return Font_Size is - begin - return Font_Size (fl_abstract_browser_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Browser; - Size : in Font_Size) is - begin - fl_abstract_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - -- Graphical dimensions and redrawing - - procedure Resize - (This : in out Browser; - X, Y, W, H : in Integer) is - begin - fl_abstract_browser_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - procedure Bounding_Box - (This : in Browser; - X, Y, W, H : out Integer) is - begin - fl_abstract_browser_bbox - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Bounding_Box; - - - function Left_Edge - (This : in Browser) - return Integer is - begin - return Integer (fl_abstract_browser_leftedge (This.Void_Ptr)); - end Left_Edge; - - - procedure Redraw_Line - (This : in out Browser; - Item : in Item_Cursor) is - begin - fl_abstract_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item)); - end Redraw_Line; - - - procedure Redraw_List - (This : in out Browser) is - begin - fl_abstract_browser_redraw_lines (This.Void_Ptr); - end Redraw_List; - - - - - -- Optional Override API - - function Full_List_Width - (This : in Browser) - return Integer - is - function my_full_width - (V : in Storage.Integer_Address) - return Interfaces.C.int; - for my_full_width'Address use This.Wide_High_Ptrs (Full_List_Width_Ptr); - pragma Import (Ada, my_full_width); - begin - return Integer (my_full_width (This.Void_Ptr)); - end Full_List_Width; - - - function Full_List_Height - (This : in Browser) - return Integer - is - function my_full_height - (V : in Storage.Integer_Address) - return Interfaces.C.int; - for my_full_height'Address use This.Wide_High_Ptrs (Full_List_Height_Ptr); - pragma Import (Ada, my_full_height); - begin - return Integer (my_full_height (This.Void_Ptr)); - end Full_List_Height; - - - function Average_Item_Height - (This : in Browser) - return Integer - is - function my_incr_height - (V : in Storage.Integer_Address) - return Interfaces.C.int; - for my_incr_height'Address use This.Wide_High_Ptrs (Average_Item_Height_Ptr); - pragma Import (Ada, my_incr_height); - begin - return Integer (my_incr_height (This.Void_Ptr)); - end Average_Item_Height; - - - function Item_Quick_Height - (This : in Browser; - Item : in Item_Cursor) - return Integer - is - function my_item_quick_height - (V, I : Storage.Integer_Address) - return Interfaces.C.int; - for my_item_quick_height'Address use This.Wide_High_Ptrs (Item_Quick_Height_Ptr); - pragma Import (Ada, my_item_quick_height); - begin - return Integer (my_item_quick_height - (This.Void_Ptr, - Cursor_To_Address (Item))); - end Item_Quick_Height; - - - - - -- Mandatory Override API - - function Item_Width - (This : in Browser; - Item : in Item_Cursor) - return Integer is - begin - return raise Program_Error with "Browser Item_Width must be overridden"; - end Item_Width; - - function Item_Height - (This : in Browser; - Item : in Item_Cursor) - return Integer is - begin - return raise Program_Error with "Browser Item_Height must be overridden"; - end Item_Height; - - function Item_First - (This : in Browser) - return Item_Cursor is - begin - return raise Program_Error with "Browser Item_First must be overridden"; - end Item_First; - - function Item_Last - (This : in Browser) - return Item_Cursor is - begin - return raise Program_Error with "Browser Item_Last must be overridden"; - end Item_Last; - - function Item_Next - (This : in Browser; - Item : in Item_Cursor) - return Item_Cursor is - begin - return raise Program_Error with "Browser Item_Next must be overridden"; - end Item_Next; - - function Item_Previous - (This : in Browser; - Item : in Item_Cursor) - return Item_Cursor is - begin - return raise Program_Error with "Browser Item_Previous must be overridden"; - end Item_Previous; - - function Item_At - (This : in Browser; - Index : in Positive) - return Item_Cursor is - begin - return raise Program_Error with "Browser Item_At must be overridden"; - end Item_At; - - procedure Item_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True) is - begin - raise Program_Error with "Browser Item_Select must be overridden"; - end Item_Select; - - function Item_Selected - (This : in Browser; - Item : in Item_Cursor) - return Boolean is - begin - return raise Program_Error with "Browser Item_Selected must be overridden"; - end Item_Selected; - - procedure Item_Swap - (This : in out Browser; - A, B : in Item_Cursor) is - begin - raise Program_Error with "Browser Item_Swap must be overridden"; - end Item_Swap; - - function Item_Text - (This : in Browser; - Item : in Item_Cursor) - return String is - begin - return raise Program_Error with "Browser Item_Text must be overridden"; - end Item_Text; - - procedure Item_Draw - (This : in Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer) is - begin - raise Program_Error with "Browser Item_Draw must be overridden"; - end Item_Draw; - - - - - -- Cache invalidation - - procedure New_List - (This : in out Browser) is - begin - fl_abstract_browser_new_list (This.Void_Ptr); - end New_List; - - - procedure Inserting - (This : in out Browser; - A, B : in Item_Cursor) is - begin - fl_abstract_browser_inserting - (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Inserting; - - - procedure Deleting - (This : in out Browser; - Item : in Item_Cursor) is - begin - fl_abstract_browser_deleting - (This.Void_Ptr, - Cursor_To_Address (Item)); - end Deleting; - - - procedure Replacing - (This : in out Browser; - A, B : in Item_Cursor) is - begin - fl_abstract_browser_replacing - (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Replacing; - - - procedure Swapping - (This : in out Browser; - A, B : in Item_Cursor) is - begin - fl_abstract_browser_swapping - (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Swapping; - - - - - -- Standard Override API - - procedure Draw - (This : in out Browser) - is - procedure my_draw - (V : in Storage.Integer_Address); - for my_draw'Address use This.Draw_Ptr; - pragma Import (Ada, my_draw); - begin - my_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Browser; - Event : in Event_Kind) - return Event_Outcome - is - function my_handle - (V : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - for my_handle'Address use This.Handle_Ptr; - pragma Import (Ada, my_handle); - begin - return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; - - -end FLTK.Widgets.Groups.Browsers; - - diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads deleted file mode 100644 index 6b0619e..0000000 --- a/src/fltk-widgets-groups-browsers.ads +++ /dev/null @@ -1,459 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Valuators.Sliders.Scrollbars, - System; - -private with - - Ada.Unchecked_Conversion, - Interfaces.C.Strings; - - -package FLTK.Widgets.Groups.Browsers is - - - type Browser is new Group with private; - - type Browser_Reference (Data : not null access Browser'Class) is - limited null record with Implicit_Dereference => Data; - - type Item_Cursor is mod System.Memory_Size; - - No_Item : constant Item_Cursor; - - type Sort_Order is (Ascending, Descending); - - type Scrollbar_Mode is record - Horizontal : Boolean := True; - Vertical : Boolean := True; - Always_On : Boolean := False; - end record; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Browser; - - end Forge; - - - - - -- Access to the Browser's self contained scrollbars - - function H_Bar - (This : in out Browser) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference; - - function V_Bar - (This : in out Browser) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference; - - - - - -- Item related settings - - function Set_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True; - Do_Callbacks : in Boolean := False) - return Boolean; - - procedure Set_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True; - Do_Callbacks : in Boolean := False); - - function Select_Only - (This : in out Browser; - Item : in Item_Cursor; - Do_Callbacks : in Boolean := False) - return Boolean; - - procedure Select_Only - (This : in out Browser; - Item : in Item_Cursor; - Do_Callbacks : in Boolean := False); - - function Current_Selection - (This : in Browser) - return Item_Cursor; - - function Deselect - (This : in out Browser; - Do_Callbacks : in Boolean := False) - return Boolean; - - procedure Deselect - (This : in out Browser; - Do_Callbacks : in Boolean := False); - - procedure Display - (This : in out Browser; - Item : in Item_Cursor); - - function Is_Displayed - (This : in Browser; - Item : in Item_Cursor) - return Boolean; - - function Find_Item - (This : in Browser; - Y_Pos : in Integer) - return Item_Cursor; - - function Top_Item - (This : in Browser) - return Item_Cursor; - - -- Not task safe due to internal issues with converting Ada Strings to char* in C. - -- Unsure how much that matters since unsure how task safe FLTK is anyway. - procedure Sort - (This : in out Browser; - Order : in Sort_Order); - - - - - -- Scrollbar related settings - - function Get_Scrollbar_Mode - (This : in Browser) - return Scrollbar_Mode; - - procedure Set_Scrollbar_Mode - (This : in out Browser; - Mode : in Scrollbar_Mode); - - function Get_H_Position - (This : in Browser) - return Integer; - - procedure Set_H_Position - (This : in out Browser; - Value : in Integer); - - function Get_V_Position - (This : in Browser) - return Integer; - - procedure Set_V_Position - (This : in out Browser; - Value : in Integer); - - procedure Set_Vertical_Left - (This : in out Browser); - - procedure Set_Vertical_Right - (This : in out Browser); - - function Get_Scrollbar_Size - (This : in Browser) - return Integer; - - procedure Set_Scrollbar_Size - (This : in out Browser; - Value : in Integer); - - - - - -- Text related settings - - function Get_Text_Color - (This : in Browser) - return Color; - - procedure Set_Text_Color - (This : in out Browser; - Value : in Color); - - function Get_Text_Font - (This : in Browser) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Browser; - Font : in Font_Kind); - - function Get_Text_Size - (This : in Browser) - return Font_Size; - - procedure Set_Text_Size - (This : in out Browser; - Size : in Font_Size); - - - - - -- Graphical dimensions and redrawing - - procedure Resize - (This : in out Browser; - X, Y, W, H : in Integer); - - procedure Bounding_Box - (This : in Browser; - X, Y, W, H : out Integer); - - function Left_Edge - (This : in Browser) - return Integer; - - procedure Redraw_Line - (This : in out Browser; - Item : in Item_Cursor); - - procedure Redraw_List - (This : in out Browser); - - - - - -- You may override these subprograms to change the behaviour of the widget - -- even though these are called from within FLTK. - - function Full_List_Width - (This : in Browser) - return Integer; - - function Full_List_Height - (This : in Browser) - return Integer; - - function Average_Item_Height - (This : in Browser) - return Integer; - - function Item_Quick_Height - (This : in Browser; - Item : in Item_Cursor) - return Integer; - - - - - -- You MUST override these subprograms if deriving a type from Browser or your - -- program will crash, since they are called from within FLTK and do not have - -- any implementations given. By default here they will raise an exception. - - function Item_Width - (This : in Browser; - Item : in Item_Cursor) - return Integer; - - function Item_Height - (This : in Browser; - Item : in Item_Cursor) - return Integer; - - function Item_First - (This : in Browser) - return Item_Cursor; - - function Item_Last - (This : in Browser) - return Item_Cursor; - - function Item_Next - (This : in Browser; - Item : in Item_Cursor) - return Item_Cursor; - - function Item_Previous - (This : in Browser; - Item : in Item_Cursor) - return Item_Cursor; - - function Item_At - (This : in Browser; - Index : in Positive) - return Item_Cursor; - - procedure Item_Select - (This : in out Browser; - Item : in Item_Cursor; - State : in Boolean := True); - - function Item_Selected - (This : in Browser; - Item : in Item_Cursor) - return Boolean; - - procedure Item_Swap - (This : in out Browser; - A, B : in Item_Cursor); - - function Item_Text - (This : in Browser; - Item : in Item_Cursor) - return String; - - procedure Item_Draw - (This : in Browser; - Item : in Item_Cursor; - X, Y, W, H : in Integer); - - - - - -- Cache invalidation - - procedure New_List - (This : in out Browser); - - procedure Inserting - (This : in out Browser; - A, B : in Item_Cursor); - - procedure Deleting - (This : in out Browser; - Item : in Item_Cursor); - - procedure Replacing - (This : in out Browser; - A, B : in Item_Cursor); - - procedure Swapping - (This : in out Browser; - A, B : in Item_Cursor); - - - - - -- You may override these subprograms to change the behaviour of the widget - -- even though these are called from within FLTK. - - procedure Draw - (This : in out Browser); - - function Handle - (This : in out Browser; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Wide_High_Fun is - (Full_List_Width_Ptr, Full_List_Height_Ptr, - Average_Item_Height_Ptr, Item_Quick_Height_Ptr); - type Wide_High_Fun_Ptr_Array is array (Wide_High_Fun) of System.Address; - - - type Browser is new Group with record - Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar; - Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; - Text_Store : Interfaces.C.Strings.chars_ptr_array (1 .. 2); - Current : Interfaces.C.size_t := 1; - Wide_High_Ptrs : Wide_High_Fun_Ptr_Array; - end record; - - overriding procedure Initialize - (This : in out Browser); - - overriding procedure Finalize - (This : in out Browser); - - procedure Extra_Init - (This : in out Browser; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Browser); - - - pragma Assert - (Item_Cursor'Size = Storage.Integer_Address'Size, - "Size of Browser Item_Cursor does not match Ada address values"); - - function Address_To_Cursor is - new Ada.Unchecked_Conversion (Storage.Integer_Address, Item_Cursor); - function Cursor_To_Address is - new Ada.Unchecked_Conversion (Item_Cursor, Storage.Integer_Address); - - No_Item : constant Item_Cursor := Address_To_Cursor (Null_Pointer); - - - for Scrollbar_Mode use record - Horizontal at 0 range 0 .. 0; - Vertical at 0 range 1 .. 1; - Always_On at 0 range 2 .. 2; - end record; - - for Scrollbar_Mode'Size use Interfaces.C.unsigned_char'Size; - - function Mode_To_Uchar is - new Ada.Unchecked_Conversion (Scrollbar_Mode, Interfaces.C.unsigned_char); - function Uchar_To_Mode is - new Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Scrollbar_Mode); - - - pragma Inline (H_Bar); - pragma Inline (V_Bar); - - pragma Inline (Current_Selection); - pragma Inline (Display); - pragma Inline (Find_Item); - pragma Inline (Top_Item); - pragma Inline (Sort); - - pragma Inline (Get_Scrollbar_Mode); - pragma Inline (Set_Scrollbar_Mode); - pragma Inline (Get_H_Position); - pragma Inline (Set_H_Position); - pragma Inline (Get_V_Position); - pragma Inline (Set_V_Position); - pragma Inline (Set_Vertical_Left); - pragma Inline (Set_Vertical_Right); - pragma Inline (Get_Scrollbar_Size); - pragma Inline (Set_Scrollbar_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 (Bounding_Box); - pragma Inline (Left_Edge); - pragma Inline (Redraw_Line); - pragma Inline (Redraw_List); - - pragma Inline (Full_List_Width); - pragma Inline (Full_List_Height); - pragma Inline (Average_Item_Height); - pragma Inline (Item_Quick_Height); - - pragma Inline (New_List); - pragma Inline (Inserting); - pragma Inline (Deleting); - pragma Inline (Replacing); - pragma Inline (Swapping); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Browsers; - - diff --git a/src/fltk-widgets-groups-color_choosers.adb b/src/fltk-widgets-groups-color_choosers.adb deleted file mode 100644 index 5c52ce3..0000000 --- a/src/fltk-widgets-groups-color_choosers.adb +++ /dev/null @@ -1,383 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups.Color_Choosers is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_color_chooser - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Color_Chooser) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Color_Chooser) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_color_chooser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Color_Chooser; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Color_Chooser) is - begin - This.Draw_Ptr := fl_color_chooser_draw'Address; - This.Handle_Ptr := fl_color_chooser_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Result : Interfaces.C.int := fl_color_chooser_rgb - (This.Void_Ptr, - Interfaces.C.double (R), - Interfaces.C.double (G), - Interfaces.C.double (B)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_RGB; - - - function Set_RGB - (This : in out Color_Chooser; - R, G, B : in Long_Float) - return Boolean - is - Result : Interfaces.C.int := fl_color_chooser_rgb - (This.Void_Ptr, - Interfaces.C.double (R), - Interfaces.C.double (G), - Interfaces.C.double (B)); - begin - return Boolean'Val (Result); - exception - when Constraint_Error => raise Internal_FLTK_Error; - 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 - Result : Interfaces.C.int := fl_color_chooser_hsv - (This.Void_Ptr, - Interfaces.C.double (H), - Interfaces.C.double (S), - Interfaces.C.double (V)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_HSV; - - - function Set_HSV - (This : in out Color_Chooser; - H, S, V : in Long_Float) - return Boolean - is - Result : Interfaces.C.int := fl_color_chooser_hsv - (This.Void_Ptr, - Interfaces.C.double (H), - Interfaces.C.double (S), - Interfaces.C.double (V)); - begin - return Boolean'Val (Result); - exception - when Constraint_Error => raise Internal_FLTK_Error; - 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 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; - - -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 8ceb1b7..0000000 --- a/src/fltk-widgets-groups-color_choosers.ads +++ /dev/null @@ -1,141 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Set_RGB - (This : in out Color_Chooser; - R, G, B : in Long_Float) - return Boolean; - - - - - 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); - - function Set_HSV - (This : in out Color_Chooser; - H, S, V : in Long_Float) - return Boolean; - - - - - 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 Get_Mode - (This : in Color_Chooser) - return Color_Mode; - - procedure Set_Mode - (This : in out Color_Chooser; - To : in Color_Mode); - - -private - - - type Color_Chooser is new Group with null record; - - overriding procedure Initialize - (This : in out Color_Chooser); - - overriding procedure Finalize - (This : in out Color_Chooser); - - procedure Extra_Init - (This : in out Color_Chooser; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Color_Chooser) - with Inline; - - - 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 (Get_Mode); - pragma Inline (Set_Mode); - - -end FLTK.Widgets.Groups.Color_Choosers; - - diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb deleted file mode 100644 index ec8688d..0000000 --- a/src/fltk-widgets-groups-help_views.adb +++ /dev/null @@ -1,610 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups.Help_Views is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_help_view - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_help_view, "new_fl_help_view"); - pragma Inline (new_fl_help_view); - - procedure free_fl_help_view - (V : in Storage.Integer_Address); - pragma Import (C, free_fl_help_view, "free_fl_help_view"); - pragma Inline (free_fl_help_view); - - - - - procedure fl_help_view_clear_selection - (V : in Storage.Integer_Address); - pragma Import (C, fl_help_view_clear_selection, "fl_help_view_clear_selection"); - pragma Inline (fl_help_view_clear_selection); - - procedure fl_help_view_select_all - (V : in Storage.Integer_Address); - pragma Import (C, fl_help_view_select_all, "fl_help_view_select_all"); - pragma Inline (fl_help_view_select_all); - - - - - function fl_help_view_find - (V : in Storage.Integer_Address; - S : in Interfaces.C.char_array; - P : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_help_view_find, "fl_help_view_find"); - pragma Inline (fl_help_view_find); - - function fl_help_view_get_leftline - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_leftline, "fl_help_view_get_leftline"); - pragma Inline (fl_help_view_get_leftline); - - procedure fl_help_view_set_leftline - (V : in Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_leftline, "fl_help_view_set_leftline"); - pragma Inline (fl_help_view_set_leftline); - - function fl_help_view_get_topline - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_topline, "fl_help_view_get_topline"); - pragma Inline (fl_help_view_get_topline); - - procedure fl_help_view_set_topline - (V : in Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_topline, "fl_help_view_set_topline"); - pragma Inline (fl_help_view_set_topline); - - procedure fl_help_view_set_topline_target - (V : in Storage.Integer_Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_help_view_set_topline_target, "fl_help_view_set_topline_target"); - pragma Inline (fl_help_view_set_topline_target); - - - - - function fl_help_view_directory - (V : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_help_view_directory, "fl_help_view_directory"); - pragma Inline (fl_help_view_directory); - - function fl_help_view_filename - (V : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_help_view_filename, "fl_help_view_filename"); - pragma Inline (fl_help_view_filename); - - function fl_help_view_load - (V : in Storage.Integer_Address; - F : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_help_view_load, "fl_help_view_load"); - pragma Inline (fl_help_view_load); - - function fl_help_view_title - (V : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_help_view_title, "fl_help_view_title"); - pragma Inline (fl_help_view_title); - - function fl_help_view_get_value - (V : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_help_view_get_value, "fl_help_view_get_value"); - pragma Inline (fl_help_view_get_value); - - procedure fl_help_view_set_value - (V : in Storage.Integer_Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_help_view_set_value, "fl_help_view_set_value"); - pragma Inline (fl_help_view_set_value); - - procedure fl_help_view_link - (V, F : in Storage.Integer_Address); - pragma Import (C, fl_help_view_link, "fl_help_view_link"); - pragma Inline (fl_help_view_link); - - - - - function fl_help_view_get_scrollbar_size - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_scrollbar_size, "fl_help_view_get_scrollbar_size"); - pragma Inline (fl_help_view_get_scrollbar_size); - - procedure fl_help_view_set_scrollbar_size - (V : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_scrollbar_size, "fl_help_view_set_scrollbar_size"); - pragma Inline (fl_help_view_set_scrollbar_size); - - function fl_help_view_get_size - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_size, "fl_help_view_get_size"); - pragma Inline (fl_help_view_get_size); - - procedure fl_help_view_set_size - (V : in Storage.Integer_Address; - W, H : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_size, "fl_help_view_set_size"); - pragma Inline (fl_help_view_set_size); - - procedure fl_help_view_resize - (V : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_help_view_resize, "fl_help_view_resize"); - pragma Inline (fl_help_view_resize); - - function fl_help_view_get_textcolor - (V : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_help_view_get_textcolor, "fl_help_view_get_textcolor"); - pragma Inline (fl_help_view_get_textcolor); - - procedure fl_help_view_set_textcolor - (V : in Storage.Integer_Address; - C : in Interfaces.C.unsigned); - pragma Import (C, fl_help_view_set_textcolor, "fl_help_view_set_textcolor"); - pragma Inline (fl_help_view_set_textcolor); - - function fl_help_view_get_textfont - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_textfont, "fl_help_view_get_textfont"); - pragma Inline (fl_help_view_get_textfont); - - procedure fl_help_view_set_textfont - (V : in Storage.Integer_Address; - F : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_textfont, "fl_help_view_set_textfont"); - pragma Inline (fl_help_view_set_textfont); - - function fl_help_view_get_textsize - (V : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_help_view_get_textsize, "fl_help_view_get_textsize"); - pragma Inline (fl_help_view_get_textsize); - - procedure fl_help_view_set_textsize - (V : in Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_help_view_set_textsize, "fl_help_view_set_textsize"); - pragma Inline (fl_help_view_set_textsize); - - - - - procedure fl_help_view_draw - (V : in Storage.Integer_Address); - pragma Import (C, fl_help_view_draw, "fl_help_view_draw"); - pragma Inline (fl_help_view_draw); - - function fl_help_view_handle - (V : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_help_view_handle, "fl_help_view_handle"); - pragma Inline (fl_help_view_handle); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - package Help_View_Convert is new System.Address_To_Access_Conversions (Help_View'Class); - - function Link_Callback_Hook - (V : in Storage.Integer_Address; - S : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.Strings.chars_ptr; - - pragma Convention (C, Link_Callback_Hook); - - function Link_Callback_Hook - (V : in Storage.Integer_Address; - S : in Interfaces.C.Strings.chars_ptr) - return Interfaces.C.Strings.chars_ptr - is - User_Data : Storage.Integer_Address := fl_widget_get_user_data (V); - Ada_Help_View : access Help_View'Class; - begin - pragma Assert (User_Data /= Null_Pointer); - Ada_Help_View := Help_View_Convert.To_Pointer (Storage.To_Address (User_Data)); - if Ada_Help_View.Zelda = null then - return S; - end if; - Interfaces.C.Strings.Free (Ada_Help_View.Hilda); - Ada_Help_View.Hilda := Interfaces.C.Strings.New_String - (Ada_Help_View.Zelda (Ada_Help_View.all, Interfaces.C.Strings.Value (S))); - if Interfaces.C.Strings.Value (Ada_Help_View.Hilda) = "" then - return Interfaces.C.Strings.Null_Ptr; - else - return Ada_Help_View.Hilda; - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Link_Callback_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Help_View) is - begin - Interfaces.C.Strings.Free (This.Hilda); - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Help_View) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_help_view (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Help_View; - X, Y, W, H : in Integer; - Text : in String) is - begin - fl_help_view_link (This.Void_Ptr, Storage.To_Integer (Link_Callback_Hook'Address)); - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Help_View) is - begin - This.Draw_Ptr := fl_help_view_draw'Address; - This.Handle_Ptr := fl_help_view_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Help_View is - begin - return This : Help_View do - This.Void_Ptr := new_fl_help_view - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Clear_Selection - (This : in out Help_View) is - begin - fl_help_view_clear_selection (This.Void_Ptr); - end Clear_Selection; - - - procedure Select_All - (This : in out Help_View) is - begin - fl_help_view_select_all (This.Void_Ptr); - end Select_All; - - - - - function Find - (This : in Help_View; - Item : in String; - From : in Position := 1) - return Extended_Position is - begin - return Extended_Position (fl_help_view_find - (This.Void_Ptr, - Interfaces.C.To_C (Item), - Interfaces.C.int (From) - 1) + 1); - end Find; - - - function Get_Leftline_Pixel - (This : in Help_View) - return Natural is - begin - return Natural (fl_help_view_get_leftline (This.Void_Ptr)); - end Get_Leftline_Pixel; - - - procedure Set_Leftline_Pixel - (This : in out Help_View; - Value : in Natural) is - begin - fl_help_view_set_leftline (This.Void_Ptr, Interfaces.C.int (Value)); - end Set_Leftline_Pixel; - - - function Get_Topline_Pixel - (This : in Help_View) - return Natural is - begin - return Natural (fl_help_view_get_topline (This.Void_Ptr)); - end Get_Topline_Pixel; - - - procedure Set_Topline_Pixel - (This : in out Help_View; - Value : in Natural) is - begin - fl_help_view_set_topline (This.Void_Ptr, Interfaces.C.int (Value)); - end Set_Topline_Pixel; - - - procedure Set_Topline_Target - (This : in out Help_View; - Value : in String) is - begin - fl_help_view_set_topline_target (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Topline_Target; - - - - - function Current_Directory - (This : in Help_View) - return String is - begin - return Interfaces.C.Strings.Value (fl_help_view_directory (This.Void_Ptr)); - end Current_Directory; - - - function Current_File - (This : in Help_View) - return String is - begin - return Interfaces.C.Strings.Value (fl_help_view_filename (This.Void_Ptr)); - end Current_File; - - - procedure Load - (This : in out Help_View; - Name : in String) - is - Code : Interfaces.C.int := fl_help_view_load (This.Void_Ptr, Interfaces.C.To_C (Name)); - begin - if Code = -1 then - raise Load_Help_Error; - else - pragma Assert (Code = 0); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Load; - - - function Document_Title - (This : in Help_View) - return String - is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_title (This.Void_Ptr); - use type Interfaces.C.Strings.chars_ptr; - begin - if Raw_Chars = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Raw_Chars); - end if; - end Document_Title; - - - function Get_Content - (This : in Help_View) - return String - is - Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_get_value (This.Void_Ptr); - use type Interfaces.C.Strings.chars_ptr; - begin - if Raw_Chars = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Raw_Chars); - end if; - end Get_Content; - - - procedure Set_Content - (This : in out Help_View; - Value : in String) is - begin - fl_help_view_set_value (This.Void_Ptr, Interfaces.C.To_C (Value)); - end Set_Content; - - - procedure Set_Link_Callback - (This : in out Help_View; - Func : in Link_Callback) is - begin - This.Zelda := Func; - end Set_Link_Callback; - - - - - function Get_Scrollbar_Size - (This : in Help_View) - return Natural is - begin - return Natural (fl_help_view_get_scrollbar_size (This.Void_Ptr)); - end Get_Scrollbar_Size; - - - procedure Set_Scrollbar_Size - (This : in out Help_View; - Value : in Natural) is - begin - fl_help_view_set_scrollbar_size (This.Void_Ptr, Interfaces.C.int (Value)); - end Set_Scrollbar_Size; - - - function Get_Size - (This : in Help_View) - return Integer is - begin - return Integer (fl_help_view_get_size (This.Void_Ptr)); - end Get_Size; - - - procedure Resize - (This : in out Help_View; - W, H : in Integer) is - begin - fl_help_view_set_size - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - procedure Resize - (This : in out Help_View; - X, Y, W, H : in Integer) is - begin - fl_help_view_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - function Get_Text_Color - (This : in Help_View) - return Color is - begin - return Color (fl_help_view_get_textcolor (This.Void_Ptr)); - end Get_Text_Color; - - - procedure Set_Text_Color - (This : in out Help_View; - Value : in Color) is - begin - fl_help_view_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); - end Set_Text_Color; - - - function Get_Text_Font - (This : in Help_View) - return Font_Kind is - begin - return Font_Kind'Val (fl_help_view_get_textfont (This.Void_Ptr)); - end Get_Text_Font; - - - procedure Set_Text_Font - (This : in out Help_View; - Font : in Font_Kind) is - begin - fl_help_view_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Text_Font; - - - function Get_Text_Size - (This : in Help_View) - return Font_Size is - begin - return Font_Size (fl_help_view_get_textsize (This.Void_Ptr)); - end Get_Text_Size; - - - procedure Set_Text_Size - (This : in out Help_View; - Size : in Font_Size) is - begin - fl_help_view_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Text_Size; - - - - - procedure Draw - (This : in out Help_View) is - begin - Group (This).Draw; - end Draw; - - - function Handle - (This : in out Help_View; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (Event); - end Handle; - - -end FLTK.Widgets.Groups.Help_Views; - - diff --git a/src/fltk-widgets-groups-help_views.ads b/src/fltk-widgets-groups-help_views.ads deleted file mode 100644 index 03bb6c5..0000000 --- a/src/fltk-widgets-groups-help_views.ads +++ /dev/null @@ -1,231 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -private with - - Interfaces.C.Strings; - - -package FLTK.Widgets.Groups.Help_Views is - - - type Help_View is new Group with private; - - type Help_View_Reference (Data : not null access Help_View'Class) is limited null record - with Implicit_Dereference => Data; - - subtype Position is Positive; - subtype Extended_Position is Natural; - - No_Position : constant Extended_Position := 0; - - type Link_Callback is access function - (Item : in out Help_View'Class; - URI : in String) - return String; - - - -- You have no idea how tempting it is to give this - -- a more tongue in cheek name. - Load_Help_Error : exception; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Help_View; - - end Forge; - - - - - procedure Clear_Selection - (This : in out Help_View); - - procedure Select_All - (This : in out Help_View); - - - - - function Find - (This : in Help_View; - Item : in String; - From : in Position := 1) - return Extended_Position; - - function Get_Leftline_Pixel - (This : in Help_View) - return Natural; - - procedure Set_Leftline_Pixel - (This : in out Help_View; - Value : in Natural); - - function Get_Topline_Pixel - (This : in Help_View) - return Natural; - - procedure Set_Topline_Pixel - (This : in out Help_View; - Value : in Natural); - - procedure Set_Topline_Target - (This : in out Help_View; - Value : in String); - - - - - function Current_Directory - (This : in Help_View) - return String; - - function Current_File - (This : in Help_View) - return String; - - -- Name here can be either a ftp/http/https/ipp/mailto/news URL or a filename. - procedure Load - (This : in out Help_View; - Name : in String); - - function Document_Title - (This : in Help_View) - return String; - - function Get_Content - (This : in Help_View) - return String; - - procedure Set_Content - (This : in out Help_View; - Value : in String); - - procedure Set_Link_Callback - (This : in out Help_View; - Func : in Link_Callback); - - - - - function Get_Scrollbar_Size - (This : in Help_View) - return Natural; - - procedure Set_Scrollbar_Size - (This : in out Help_View; - Value : in Natural); - - function Get_Size - (This : in Help_View) - return Integer; - - procedure Resize - (This : in out Help_View; - W, H : in Integer); - - procedure Resize - (This : in out Help_View; - X, Y, W, H : in Integer); - - function Get_Text_Color - (This : in Help_View) - return Color; - - procedure Set_Text_Color - (This : in out Help_View; - Value : in Color); - - function Get_Text_Font - (This : in Help_View) - return Font_Kind; - - procedure Set_Text_Font - (This : in out Help_View; - Font : in Font_Kind); - - function Get_Text_Size - (This : in Help_View) - return Font_Size; - - procedure Set_Text_Size - (This : in out Help_View; - Size : in Font_Size); - - - - - procedure Draw - (This : in out Help_View); - - function Handle - (This : in out Help_View; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Help_View is new Group with record - Zelda : Link_Callback; - Hilda : Interfaces.C.Strings.chars_ptr; - end record; - - overriding procedure Initialize - (This : in out Help_View); - - overriding procedure Finalize - (This : in out Help_View); - - procedure Extra_Init - (This : in out Help_View; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Help_View); - - - pragma Inline (Clear_Selection); - pragma Inline (Select_All); - - pragma Inline (Find); - pragma Inline (Get_Leftline_Pixel); - pragma Inline (Set_Leftline_Pixel); - pragma Inline (Get_Topline_Pixel); - pragma Inline (Set_Topline_Pixel); - pragma Inline (Set_Topline_Target); - - pragma Inline (Current_Directory); - pragma Inline (Current_File); - pragma Inline (Set_Content); - pragma Inline (Set_Link_Callback); - - pragma Inline (Get_Scrollbar_Size); - pragma Inline (Set_Scrollbar_Size); - pragma Inline (Get_Size); - pragma Inline (Resize); - 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.Groups.Help_Views; - - diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb deleted file mode 100644 index 118b9ea..0000000 --- a/src/fltk-widgets-groups-input_choices.adb +++ /dev/null @@ -1,463 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Groups.Input_Choices is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_input_choice - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_resize - (N : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_input_choice_resize, "fl_input_choice_resize"); - pragma Inline (fl_input_choice_resize); - - - - - procedure fl_input_choice_draw - (W : in Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Resorting to smoke signals - procedure fl_text_input_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final"); - pragma Inline (fl_text_input_extra_final); - - - -- Message in a bottle - procedure fl_menu_button_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_menu_button_extra_final, "fl_menu_button_extra_final"); - pragma Inline (fl_menu_button_extra_final); - - - procedure Extra_Final - (This : in out Input_Choice) is - begin - fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address)); - fl_menu_button_extra_final (Storage.To_Integer (This.My_Menu_Button'Address)); - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Input_Choice) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_input_choice (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Translocation initiating... - procedure fl_text_input_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_text_input_extra_init, "fl_text_input_extra_init"); - pragma Inline (fl_text_input_extra_init); - - - -- Crossing the streams - procedure fl_menu_button_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_menu_button_extra_init, "fl_menu_button_extra_init"); - pragma Inline (fl_menu_button_extra_init); - - - procedure Extra_Init - (This : in out Input_Choice; - X, Y, W, H : in Integer; - Text : in String) is - begin - Wrapper (This.My_Input).Void_Ptr := fl_input_choice_input (This.Void_Ptr); - Wrapper (This.My_Input).Needs_Dealloc := False; - fl_text_input_extra_init - (Storage.To_Integer (This.My_Input'Address), - Interfaces.C.int (This.My_Input.Get_X), - Interfaces.C.int (This.My_Input.Get_Y), - Interfaces.C.int (This.My_Input.Get_W), - Interfaces.C.int (This.My_Input.Get_H), - Interfaces.C.To_C (This.My_Input.Get_Label)); - Wrapper (This.My_Menu_Button).Void_Ptr := fl_input_choice_menubutton (This.Void_Ptr); - Wrapper (This.My_Menu_Button).Needs_Dealloc := False; - fl_menu_button_extra_init - (Storage.To_Integer (This.My_Menu_Button'Address), - Interfaces.C.int (This.My_Menu_Button.Get_X), - Interfaces.C.int (This.My_Menu_Button.Get_Y), - Interfaces.C.int (This.My_Menu_Button.Get_W), - Interfaces.C.int (This.My_Menu_Button.Get_H), - Interfaces.C.To_C (This.My_Menu_Button.Get_Label)); - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Input_Choice) is - begin - This.Draw_Ptr := fl_input_choice_draw'Address; - This.Handle_Ptr := fl_input_choice_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ------------------ - -- Attributes -- - ------------------ - - function Text_Field - (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Text.Text_Input_Reference is - begin - return (Data => This.My_Input'Unchecked_Access); - end Text_Field; - - - function Button_Menu - (This : in out Input_Choice) - return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference is - begin - return (Data => This.My_Menu_Button'Unchecked_Access); - end Button_Menu; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 Resize - (This : in out Input_Choice; - X, Y, W, H : in Integer) is - begin - fl_input_choice_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - -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 f97f69a..0000000 --- a/src/fltk-widgets-groups-input_choices.ads +++ /dev/null @@ -1,161 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Inputs.Text, - 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 Text_Field - (This : in out Input_Choice) - return FLTK.Widgets.Inputs.Text.Text_Input_Reference; - - function Button_Menu - (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 Resize - (This : in out Input_Choice; - X, Y, W, H : in Integer); - - -private - - - type Input_Choice is new Group with record - My_Input : aliased Inputs.Text.Text_Input; - My_Menu_Button : aliased Menus.Menu_Buttons.Menu_Button; - end record; - - overriding procedure Initialize - (This : in out Input_Choice); - - overriding procedure Finalize - (This : in out Input_Choice); - - procedure Extra_Init - (This : in out Input_Choice; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Input_Choice); - - - pragma Inline (Text_Field); - pragma Inline (Button_Menu); - - 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 (Resize); - - -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 421bca1..0000000 --- a/src/fltk-widgets-groups-packed.adb +++ /dev/null @@ -1,193 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Groups.Packed is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_pack - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_pack, "new_fl_pack"); - pragma Inline (new_fl_pack); - - procedure free_fl_pack - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_pack, "free_fl_pack"); - pragma Inline (free_fl_pack); - - - - - function fl_pack_get_spacing - (P : in Storage.Integer_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 Storage.Integer_Address; - S : in Interfaces.C.int); - pragma Import (C, fl_pack_set_spacing, "fl_pack_set_spacing"); - pragma Inline (fl_pack_set_spacing); - - function fl_widget_get_type - (P : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_widget_get_type, "fl_widget_get_type"); - pragma Inline (fl_widget_get_type); - - procedure fl_widget_set_type - (P : in Storage.Integer_Address; - T : in Interfaces.C.unsigned_char); - pragma Import (C, fl_widget_set_type, "fl_widget_set_type"); - pragma Inline (fl_widget_set_type); - - - - - procedure fl_pack_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_pack_draw, "fl_pack_draw"); - pragma Inline (fl_pack_draw); - - function fl_pack_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_pack_handle, "fl_pack_handle"); - pragma Inline (fl_pack_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Packed_Group) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Packed_Group) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_pack (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Packed_Group; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Packed_Group) is - begin - This.Draw_Ptr := fl_pack_draw'Address; - This.Handle_Ptr := fl_pack_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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; - - - function Get_Pack_Type - (This : in Packed_Group) - return Pack_Kind is - begin - return Pack_Kind'Val (fl_widget_get_type (This.Void_Ptr)); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Pack_Type; - - - procedure Set_Pack_Type - (This : in out Packed_Group; - Kind : in Pack_Kind) is - begin - fl_widget_set_type (This.Void_Ptr, Pack_Kind'Pos (Kind)); - end Set_Pack_Type; - - - - - procedure Draw - (This : in out Packed_Group) is - begin - Group (This).Draw; - end Draw; - - -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 3f2587c..0000000 --- a/src/fltk-widgets-groups-packed.ads +++ /dev/null @@ -1,87 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - type Pack_Kind is (Vertical_Pack, Horizontal_Pack); - - - - - 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); - - function Get_Pack_Type - (This : in Packed_Group) - return Pack_Kind; - - procedure Set_Pack_Type - (This : in out Packed_Group; - Kind : in Pack_Kind); - - - - - procedure Draw - (This : in out Packed_Group); - - -private - - - type Packed_Group is new Group with null record; - - overriding procedure Initialize - (This : in out Packed_Group); - - overriding procedure Finalize - (This : in out Packed_Group); - - procedure Extra_Init - (This : in out Packed_Group; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Packed_Group) - with Inline; - - - pragma Inline (Get_Spacing); - pragma Inline (Set_Spacing); - pragma Inline (Get_Pack_Type); - pragma Inline (Set_Pack_Type); - - pragma Inline (Draw); - - -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 ebffdbe..0000000 --- a/src/fltk-widgets-groups-scrolls.adb +++ /dev/null @@ -1,322 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Groups.Scrolls is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_scroll - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_scroll, "new_fl_scroll"); - pragma Inline (new_fl_scroll); - - procedure free_fl_scroll - (S : in Storage.Integer_Address); - pragma Import (C, free_fl_scroll, "free_fl_scroll"); - pragma Inline (free_fl_scroll); - - - - - function fl_scroll_hscrollbar - (S : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_scroll_hscrollbar, "fl_scroll_hscrollbar"); - pragma Inline (fl_scroll_hscrollbar); - - function fl_scroll_scrollbar - (S : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_scroll_scrollbar, "fl_scroll_scrollbar"); - pragma Inline (fl_scroll_scrollbar); - - - - - procedure fl_scroll_to - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_scroll_draw, "fl_scroll_draw"); - pragma Inline (fl_scroll_draw); - - function fl_scroll_handle - (S : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_scroll_handle, "fl_scroll_handle"); - pragma Inline (fl_scroll_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- It's the only way to be sure - procedure fl_scrollbar_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_scrollbar_extra_final, "fl_scrollbar_extra_final"); - pragma Inline (fl_scrollbar_extra_final); - - - procedure Extra_Final - (This : in out Scroll) is - begin - fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address)); - fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address)); - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Scroll) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_scroll (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Hold on, I know a shortcut - procedure fl_scrollbar_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_scrollbar_extra_init, "fl_scrollbar_extra_init"); - pragma Inline (fl_scrollbar_extra_init); - - - procedure Extra_Init - (This : in out Scroll; - X, Y, W, H : in Integer; - Text : in String) is - begin - Widget (This.Horizon).Void_Ptr := fl_scroll_hscrollbar (This.Void_Ptr); - Widget (This.Horizon).Needs_Dealloc := False; - fl_scrollbar_extra_init - (Storage.To_Integer (This.Horizon'Address), - Interfaces.C.int (This.Horizon.Get_X), - Interfaces.C.int (This.Horizon.Get_Y), - Interfaces.C.int (This.Horizon.Get_W), - Interfaces.C.int (This.Horizon.Get_H), - Interfaces.C.To_C (This.Horizon.Get_Label)); - Widget (This.Vertigo).Void_Ptr := fl_scroll_scrollbar (This.Void_Ptr); - Widget (This.Vertigo).Needs_Dealloc := False; - fl_scrollbar_extra_init - (Storage.To_Integer (This.Vertigo'Address), - Interfaces.C.int (This.Vertigo.Get_X), - Interfaces.C.int (This.Vertigo.Get_Y), - Interfaces.C.int (This.Vertigo.Get_W), - Interfaces.C.int (This.Vertigo.Get_H), - Interfaces.C.To_C (This.Vertigo.Get_Label)); - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Scroll) is - begin - This.Draw_Ptr := fl_scroll_draw'Address; - This.Handle_Ptr := fl_scroll_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ------------------ - -- Attributes -- - ------------------ - - function H_Bar - (This : in out Scroll) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference is - begin - return (Data => This.Horizon'Unchecked_Access); - end H_Bar; - - - function V_Bar - (This : in out Scroll) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference is - begin - return (Data => This.Vertigo'Unchecked_Access); - end V_Bar; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Clear - (This : in out Scroll) is - begin - -- Can't use the actual clear method here because that would - -- delete the widgets from memory, and the binding is meant to - -- handle that, not the library. - This.Remove (This.Horizon); - This.Remove (This.Vertigo); - Group (This).Clear; - This.Add (This.Horizon); - This.Add (This.Vertigo); - 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 - Group (This).Draw; - end Draw; - - - function Handle - (This : in out Scroll; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 8030fcd..0000000 --- a/src/fltk-widgets-groups-scrolls.ads +++ /dev/null @@ -1,140 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Valuators.Sliders.Scrollbars; - - -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; - - - - - function H_Bar - (This : in out Scroll) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference; - - function V_Bar - (This : in out Scroll) - return Valuators.Sliders.Scrollbars.Scrollbar_Reference; - - - - - 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 record - Horizon, Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; - end record; - - overriding procedure Initialize - (This : in out Scroll); - - overriding procedure Finalize - (This : in out Scroll); - - procedure Extra_Init - (This : in out Scroll; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (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 e9d2f28..0000000 --- a/src/fltk-widgets-groups-spinners.adb +++ /dev/null @@ -1,518 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Groups.Spinners is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_spinner - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_spinner, "new_fl_spinner"); - pragma Inline (new_fl_spinner); - - procedure free_fl_spinner - (W : in Storage.Integer_Address); - pragma Import (C, free_fl_spinner, "free_fl_spinner"); - pragma Inline (free_fl_spinner); - - - - - function fl_spinner_get_color - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_value - (S : in Storage.Integer_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 Storage.Integer_Address; - T : in Interfaces.C.double); - pragma Import (C, fl_spinner_set_value, "fl_spinner_set_value"); - pragma Inline (fl_spinner_set_value); - - - - - function fl_spinner_get_format - (S : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_spinner_get_format, "fl_spinner_get_format"); - pragma Inline (fl_spinner_get_format); - - procedure fl_spinner_set_format - (S : in Storage.Integer_Address; - F : in Interfaces.C.Strings.chars_ptr); - pragma Import (C, fl_spinner_set_format, "fl_spinner_set_format"); - pragma Inline (fl_spinner_set_format); - - function fl_spinner_get_type - (S : in Storage.Integer_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 Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_spinner_set_type, "fl_spinner_set_type"); - pragma Inline (fl_spinner_set_type); - - - - - procedure fl_spinner_resize - (S : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_spinner_resize, "fl_spinner_resize"); - pragma Inline (fl_spinner_resize); - - - - - procedure fl_spinner_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_spinner_draw, "fl_spinner_draw"); - pragma Inline (fl_spinner_draw); - - function fl_spinner_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_spinner_handle, "fl_spinner_handle"); - pragma Inline (fl_spinner_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Spinner) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Spinner) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_spinner (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Spinner; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Spinner) is - begin - This.Draw_Ptr := fl_spinner_draw'Address; - This.Handle_Ptr := fl_spinner_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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_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; - - - - - function Get_Format - (This : in Spinner) - return String - is - Result : Interfaces.C.Strings.chars_ptr := fl_spinner_get_format (This.Void_Ptr); - begin - if Result = Interfaces.C.Strings.Null_Ptr then - return ""; - else - return Interfaces.C.Strings.Value (Result); - end if; - end Get_Format; - - - procedure Set_Format - (This : in out Spinner; - To : in String) is - begin - Interfaces.C.Strings.Free (This.Format_Str); - This.Format_Str := Interfaces.C.Strings.New_String (To); - fl_spinner_set_format (This.Void_Ptr, This.Format_Str); - end Set_Format; - - - 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; - - - - - procedure Resize - (This : in out Spinner; - X, Y, W, H : in Integer) is - begin - fl_spinner_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - function Handle - (This : in out Spinner; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 39ed4b3..0000000 --- a/src/fltk-widgets-groups-spinners.ads +++ /dev/null @@ -1,210 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -private with - - Interfaces.C.Strings; - - -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_Value - (This : in Spinner) - return Long_Float; - - procedure Set_Value - (This : in out Spinner; - To : in Long_Float); - - - - - function Get_Format - (This : in Spinner) - return String; - - procedure Set_Format - (This : in out Spinner; - To : in String); - - function Get_Type - (This : in Spinner) - return Spinner_Kind; - - procedure Set_Type - (This : in out Spinner; - To : in Spinner_Kind); - - - - - procedure Resize - (This : in out Spinner; - X, Y, W, H : in Integer); - - - - - function Handle - (This : in out Spinner; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Spinner is new Group with record - Format_Str : Interfaces.C.Strings.chars_ptr; - end record; - - overriding procedure Initialize - (This : in out Spinner); - - overriding procedure Finalize - (This : in out Spinner); - - procedure Extra_Init - (This : in out Spinner; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Spinner) - with Inline; - - - 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_Value); - pragma Inline (Set_Value); - - pragma Inline (Get_Type); - pragma Inline (Set_Type); - - pragma Inline (Resize); - - 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 3b62b3c..0000000 --- a/src/fltk-widgets-groups-tabbed.adb +++ /dev/null @@ -1,290 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C; - - -package body FLTK.Widgets.Groups.Tabbed is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_tabs - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_tabs, "new_fl_tabs"); - pragma Inline (new_fl_tabs); - - procedure free_fl_tabs - (S : in Storage.Integer_Address); - pragma Import (C, free_fl_tabs, "free_fl_tabs"); - pragma Inline (free_fl_tabs); - - - - - procedure fl_tabs_client_area - (T : in Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_tabs_set_value, "fl_tabs_set_value"); - pragma Inline (fl_tabs_set_value); - - function fl_tabs_which - (T : in Storage.Integer_Address; - X, Y : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_tabs_which, "fl_tabs_which"); - pragma Inline (fl_tabs_which); - - - - - procedure fl_tabs_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_tabs_draw, "fl_tabs_draw"); - pragma Inline (fl_tabs_draw); - - procedure fl_tabs_redraw_tabs - (T : in Storage.Integer_Address); - pragma Import (C, fl_tabs_redraw_tabs, "fl_tabs_redraw_tabs"); - pragma Inline (fl_tabs_redraw_tabs); - - function fl_tabs_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_tabs_handle, "fl_tabs_handle"); - pragma Inline (fl_tabs_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Tabbed_Group) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Tabbed_Group) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_tabs (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Tabbed_Group; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Tabbed_Group) is - begin - This.Draw_Ptr := fl_tabs_draw'Address; - This.Handle_Ptr := fl_tabs_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Push_Ptr : Storage.Integer_Address := fl_tabs_get_push (This.Void_Ptr); - Actual_Widget : access Widget'Class; - begin - if Push_Ptr /= Null_Pointer then - Push_Ptr := fl_widget_get_user_data (Push_Ptr); - pragma Assert (Push_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Push_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Visible_Ptr : Storage.Integer_Address := fl_tabs_get_value (This.Void_Ptr); - Actual_Widget : access Widget'Class; - begin - if Visible_Ptr /= Null_Pointer then - Visible_Ptr := fl_widget_get_user_data (Visible_Ptr); - pragma Assert (Visible_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Which_Ptr : Storage.Integer_Address := - fl_tabs_which (This.Void_Ptr, Interfaces.C.int (Event_X), Interfaces.C.int (Event_Y)); - Actual_Widget : access Widget'Class; - begin - if Which_Ptr /= Null_Pointer then - Which_Ptr := fl_widget_get_user_data (Which_Ptr); - pragma Assert (Which_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Which_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Which; - - - - - procedure Draw - (This : in out Tabbed_Group) is - begin - Group (This).Draw; - end Draw; - - - procedure Redraw_Tabs - (This : in out Tabbed_Group) is - begin - fl_tabs_redraw_tabs (This.Void_Ptr); - end Redraw_Tabs; - - - function Handle - (This : in out Tabbed_Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 136c66e..0000000 --- a/src/fltk-widgets-groups-tabbed.ads +++ /dev/null @@ -1,111 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - procedure Redraw_Tabs - (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 Initialize - (This : in out Tabbed_Group); - - overriding procedure Finalize - (This : in out Tabbed_Group); - - procedure Extra_Init - (This : in out Tabbed_Group; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Tabbed_Group) - with Inline; - - - 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 (Redraw_Tabs); - 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 636e368..0000000 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ /dev/null @@ -1,1019 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Event, - Interfaces.C; - -use type - - Interfaces.C.unsigned_long; - - -package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_text_editor - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - K, S : in Interfaces.C.int; - F : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - function Key_Func_Hook - (K : in Interfaces.C.int; - E : in Storage.Integer_Address) - return Interfaces.C.int - is - Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E); - Ada_Editor : access Text_Editor'Class; - 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 - pragma Assert (Editor_Ptr /= Null_Pointer); - Ada_Editor := Editor_Convert.To_Pointer (Storage.To_Address (Editor_Ptr)); - 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; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Text_Editor) is - begin - Extra_Final (Text_Display (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Text_Editor) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_text_editor (This.Void_Ptr); - free_fl_text_buffer (This.Raw_Buffer); - This.Void_Ptr := Null_Pointer; - end if; - 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)); - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Text_Editor; - X, Y, W, H : in Integer; - Text : in String) is - begin - -- 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, Storage.To_Integer (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; - Extra_Init (Text_Display (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Text_Editor) is - begin - This.Draw_Ptr := fl_text_editor_draw'Address; - This.Handle_Ptr := fl_text_editor_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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_Mode - (This : in Text_Editor) - return Tab_Navigation is - begin - return Tab_Navigation'Val (fl_text_editor_get_tab_nav (This.Void_Ptr)); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Tab_Mode; - - - procedure Set_Tab_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_Mode; - - - - - function Handle - (This : in out Text_Editor; - Event : in Event_Kind) - return Event_Outcome is - begin - return Text_Display (This).Handle (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 36c945d..0000000 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ /dev/null @@ -1,432 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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_Mode - (This : in Text_Editor) - return Tab_Navigation; - - procedure Set_Tab_Mode - (This : in out Text_Editor; - To : in Tab_Navigation); - - - - - 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 Initialize - (This : in out Text_Editor); - - overriding procedure Finalize - (This : in out Text_Editor); - - procedure Extra_Init - (This : in out Text_Editor; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Text_Editor); - - - function Key_Func_Hook - (K : in Interfaces.C.int; - E : in Storage.Integer_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 (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 170ed51..0000000 --- a/src/fltk-widgets-groups-text_displays.adb +++ /dev/null @@ -1,1138 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C, - FLTK.Text_Buffers; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups.Text_Displays is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_text_display - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - L : in Interfaces.C.int; - C : in Interfaces.C.unsigned; - B, A : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - procedure Style_Hook - (C : in Interfaces.C.int; - D : in Storage.Integer_Address) - is - use Styles; -- for maximum stylin' - - Ada_Widget : access Text_Display'Class := - Text_Display_Convert.To_Pointer (Storage.To_Address (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; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Text_Display) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Text_Display) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_text_display (This.Void_Ptr); - free_fl_text_buffer (This.Raw_Buffer); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Text_Display; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Text_Display) is - begin - This.Draw_Ptr := fl_text_display_draw'Address; - This.Handle_Ptr := fl_text_display_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ---------------------- - -- Child Packages -- - ---------------------- - - 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; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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); - if This.Raw_Buffer /= Null_Pointer then - free_fl_text_buffer (This.Raw_Buffer); - end if; - This.Raw_Buffer := Wrapper (Buff).Void_Ptr; - upref_fl_text_buffer (This.Raw_Buffer); - 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, - Storage.To_Integer (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, - Storage.To_Integer (Table'Address), - Table'Length, - Character'Pos (Character (Unfinished)), - Storage.To_Integer (Style_Hook'Address), - Storage.To_Integer (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 - Group (This).Draw; - end Draw; - - - function Handle - (This : in out Text_Display; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 f4ffd43..0000000 --- a/src/fltk-widgets-groups-text_displays.ads +++ /dev/null @@ -1,476 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - Raw_Buffer : Storage.Integer_Address := Null_Pointer; - Style_Callback : Styles.Unfinished_Style_Callback; - end record; - - overriding procedure Initialize - (This : in out Text_Display); - - overriding procedure Finalize - (This : in out Text_Display); - - procedure Extra_Init - (This : in out Text_Display; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Text_Display) - with Inline; - - - package Text_Display_Convert is new System.Address_To_Access_Conversions (Text_Display'Class); - - - -- Adds some basic reference counting on the C side to help ensure any Text_Buffers - -- do not get deallocated before all Text_Displays they might be attached to. - procedure upref_fl_text_buffer - (TB : in Storage.Integer_Address); - pragma Import (C, upref_fl_text_buffer, "upref_fl_text_buffer"); - pragma Inline (upref_fl_text_buffer); - - procedure free_fl_text_buffer - (TB : in Storage.Integer_Address); - pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); - pragma Inline (free_fl_text_buffer); - - - 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 bf3950c..0000000 --- a/src/fltk-widgets-groups-tiled.adb +++ /dev/null @@ -1,174 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Groups.Tiled is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_tile - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_tile, "new_fl_tile"); - pragma Inline (new_fl_tile); - - procedure free_fl_tile - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_tile, "free_fl_tile"); - pragma Inline (free_fl_tile); - - - - - procedure fl_tile_position - (T : in Storage.Integer_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_resize - (T : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_tile_resize, "fl_tile_resize"); - pragma Inline (fl_tile_resize); - - - - - procedure fl_tile_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_tile_draw, "fl_tile_draw"); - pragma Inline (fl_tile_draw); - - function fl_tile_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_tile_handle, "fl_tile_handle"); - pragma Inline (fl_tile_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Tiled_Group) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Tiled_Group) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_tile (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Tiled_Group; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Tiled_Group) is - begin - This.Draw_Ptr := fl_tile_draw'Address; - This.Handle_Ptr := fl_tile_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 Resize - (This : in out Tiled_Group; - X, Y, W, H : in Integer) is - begin - fl_tile_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - function Handle - (This : in out Tiled_Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 1580464..0000000 --- a/src/fltk-widgets-groups-tiled.ads +++ /dev/null @@ -1,78 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Resize - (This : in out Tiled_Group; - X, Y, W, H : in Integer); - - - - - 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 Initialize - (This : in out Tiled_Group); - - overriding procedure Finalize - (This : in out Tiled_Group); - - procedure Extra_Init - (This : in out Tiled_Group; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Tiled_Group) - with Inline; - - - pragma Inline (Position); - pragma Inline (Resize); - - pragma Inline (Handle); - - -end FLTK.Widgets.Groups.Tiled; - - diff --git a/src/fltk-widgets-groups-windows-double-cairo.adb b/src/fltk-widgets-groups-windows-double-cairo.adb deleted file mode 100644 index eedcbd1..0000000 --- a/src/fltk-widgets-groups-windows-double-cairo.adb +++ /dev/null @@ -1,213 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C, - System.Address_To_Access_Conversions; - - -package body FLTK.Widgets.Groups.Windows.Double.Cairo is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_cairo_window - (W, H : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, new_fl_cairo_window, "new_fl_cairo_window"); - pragma Inline (new_fl_cairo_window); - - procedure free_fl_cairo_window - (W : in Storage.Integer_Address); - pragma Import (C, free_fl_cairo_window, "free_fl_cairo_window"); - pragma Inline (free_fl_cairo_window); - - - - - procedure fl_cairo_window_set_draw_cb - (W, F : in Storage.Integer_Address); - pragma Import (C, fl_cairo_window_set_draw_cb, "fl_cairo_window_set_draw_cb"); - pragma Inline (fl_cairo_window_set_draw_cb); - - - - - procedure fl_cairo_window_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_cairo_window_draw, "fl_cairo_window_draw"); - pragma Inline (fl_cairo_window_draw); - - function fl_cairo_window_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_cairo_window_handle, "fl_cairo_window_handle"); - pragma Inline (fl_cairo_window_handle); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - package Cairo_Convert is new System.Address_To_Access_Conversions (Cairo_Window'Class); - - - procedure Cairo_Draw_Hook - (C_Addr, Cairo_Addr : in Storage.Integer_Address); - - pragma Convention (C, Cairo_Draw_Hook); - - procedure Cairo_Draw_Hook - (C_Addr, Cairo_Addr : in Storage.Integer_Address) - is - Ada_Addr : System.Address := - Storage.To_Address (fl_widget_get_user_data (C_Addr)); - Ada_Object : access Cairo_Window'Class := - Cairo_Convert.To_Pointer (Ada_Addr); - begin - pragma Assert (Ada_Object /= null); - if Ada_Object.My_Func /= null then - Ada_Object.My_Func (Cairo_Window (Ada_Object.all), Storage.To_Address (Cairo_Addr)); - end if; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Cairo_Draw_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Cairo_Window) is - begin - Extra_Final (Double_Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Cairo_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_cairo_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Cairo_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - fl_cairo_window_set_draw_cb (This.Void_Ptr, Storage.To_Integer (Cairo_Draw_Hook'Address)); - Extra_Init (Double_Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Cairo_Window) is - begin - This.Draw_Ptr := fl_cairo_window_draw'Address; - This.Handle_Ptr := fl_cairo_window_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Cairo_Window is - begin - return This : Cairo_Window do - This.Void_Ptr := new_fl_cairo_window - (Interfaces.C.int (W), - Interfaces.C.int (H)); - This.Reposition (X, Y); - This.Set_Label (Text); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - - function Create - (W, H : in Integer; - Text : in String := "") - return Cairo_Window is - begin - return This : Cairo_Window do - This.Void_Ptr := new_fl_cairo_window - (Interfaces.C.int (W), - Interfaces.C.int (H)); - This.Set_Label (Text); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); - end return; - end Create; - - - function Create - (W, H : in Integer) - return Cairo_Window is - begin - return This : Cairo_Window do - This.Void_Ptr := new_fl_cairo_window - (Interfaces.C.int (W), - Interfaces.C.int (H)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, This.Get_Label); - end return; - end Create; - - end Forge; - - - - - ------------------------ - -- Cairo Window API -- - ------------------------ - - procedure Set_Cairo_Draw - (This : in out Cairo_Window; - Func : in Cairo_Callback) is - begin - This.My_Func := Func; - end Set_Cairo_Draw; - - - - - procedure Draw - (This : in out Cairo_Window) is - begin - Double_Window (This).Draw; - end Draw; - - -end FLTK.Widgets.Groups.Windows.Double.Cairo; - - diff --git a/src/fltk-widgets-groups-windows-double-cairo.ads b/src/fltk-widgets-groups-windows-double-cairo.ads deleted file mode 100644 index 02a1dbf..0000000 --- a/src/fltk-widgets-groups-windows-double-cairo.ads +++ /dev/null @@ -1,98 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - System; - - -package FLTK.Widgets.Groups.Windows.Double.Cairo is - - - -- If FLTK has not been built with Cairo support then - -- this will just be a duplicate of Double_Window and the - -- callback set with Set_Cairo_Draw will never be triggered. - - -- Building with Cairo support requires either of - -- 1. CMake option FLTK_OPTION_CAIRO_WINDOW - -- 2. configure -enable-cairo - -- when building FLTK itself. - - - type Cairo_Window is new Double_Window with private; - - type Cairo_Window_Reference (Data : not null access Cairo_Window'Class) is - limited null record with Implicit_Dereference => Data; - - type Cairo_Callback is access procedure - (This : in out Cairo_Window; - Context : in System.Address); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Cairo_Window; - - function Create - (W, H : in Integer; - Text : in String := "") - return Cairo_Window; - - function Create - (W, H : in Integer) - return Cairo_Window; - - end Forge; - - - - - procedure Set_Cairo_Draw - (This : in out Cairo_Window; - Func : in Cairo_Callback); - - - - - procedure Draw - (This : in out Cairo_Window); - - -private - - - type Cairo_Window is new Double_Window with record - My_Func : Cairo_Callback; - end record; - - overriding procedure Initialize - (This : in out Cairo_Window); - - overriding procedure Finalize - (This : in out Cairo_Window); - - procedure Extra_Init - (This : in out Cairo_Window; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Cairo_Window); - - - pragma Inline (Set_Cairo_Draw); - - pragma Inline (Draw); - - -end FLTK.Widgets.Groups.Windows.Double.Cairo; - - 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 53ba257..0000000 --- a/src/fltk-widgets-groups-windows-double-overlay.adb +++ /dev/null @@ -1,293 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Show_Argv, - Interfaces.C, - System.Address_To_Access_Conversions; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups.Windows.Double.Overlay is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_overlay_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_overlay_window_show, "fl_overlay_window_show"); - pragma Inline (fl_overlay_window_show); - - procedure fl_overlay_window_show2 - (W : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_overlay_window_show2, "fl_overlay_window_show2"); - pragma Inline (fl_overlay_window_show2); - - procedure fl_overlay_window_hide - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_resize - (OW : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_overlay_window_resize, "fl_overlay_window_resize"); - pragma Inline (fl_overlay_window_resize); - - - - - procedure fl_overlay_window_draw - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ---------------------- - -- Exported Hooks -- - ---------------------- - - package Over_Convert is new System.Address_To_Access_Conversions (Overlay_Window'Class); - - procedure Overlay_Window_Draw_Overlay_Hook - (U : in Storage.Integer_Address); - pragma Export (C, Overlay_Window_Draw_Overlay_Hook, "overlay_window_draw_overlay_hook"); - - procedure Overlay_Window_Draw_Overlay_Hook - (U : in Storage.Integer_Address) - is - Overlay_Widget : access Overlay_Window'Class := - Over_Convert.To_Pointer (Storage.To_Address (U)); - begin - Overlay_Widget.Draw_Overlay; - end Overlay_Window_Draw_Overlay_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Overlay_Window) is - begin - Extra_Final (Double_Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Overlay_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_overlay_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Overlay_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Double_Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Overlay_Window) is - begin - This.Draw_Ptr := fl_overlay_window_draw'Address; - This.Handle_Ptr := fl_overlay_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, 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 Show_With_Args - (This : in out Overlay_Window) is - begin - FLTK.Show_Argv.Dispatch (fl_overlay_window_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - 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; - - - procedure Resize - (This : in out Overlay_Window; - X, Y, W, H : in Integer) is - begin - fl_overlay_window_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- - - procedure Draw_Overlay - (This : in out Overlay_Window) is - begin - raise Program_Error with "You must override Draw_Overlay"; - end Draw_Overlay; - - - procedure Redraw_Overlay - (This : in out Overlay_Window) is - begin - fl_overlay_window_redraw_overlay (This.Void_Ptr); - end Redraw_Overlay; - - -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 3d07549..0000000 --- a/src/fltk-widgets-groups-windows-double-overlay.ads +++ /dev/null @@ -1,104 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Groups.Windows.Double.Overlay is - - - 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; - - - - - 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; - - - - - procedure Show - (This : in out Overlay_Window); - - procedure Show_With_Args - (This : in out Overlay_Window); - - procedure Hide - (This : in out Overlay_Window); - - procedure Flush - (This : in out Overlay_Window); - - - - - function Can_Do_Overlay - (This : in Overlay_Window) - return Boolean; - - procedure Resize - (This : in out Overlay_Window; - X, Y, W, H : in Integer); - - - - - -- You must override this subprogram - procedure Draw_Overlay - (This : in out Overlay_Window); - - procedure Redraw_Overlay - (This : in out Overlay_Window); - - -private - - - type Overlay_Window is new Double_Window with null record; - - overriding procedure Initialize - (This : in out Overlay_Window); - - overriding procedure Finalize - (This : in out Overlay_Window); - - procedure Extra_Init - (This : in out Overlay_Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Overlay_Window) - with Inline; - - - pragma Inline (Show); - pragma Inline (Show_With_Args); - pragma Inline (Hide); - pragma Inline (Flush); - - pragma Inline (Can_Do_Overlay); - pragma Inline (Resize); - - pragma Inline (Redraw_Overlay); - - -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 bb7e3da..0000000 --- a/src/fltk-widgets-groups-windows-double.adb +++ /dev/null @@ -1,236 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Show_Argv, - Interfaces.C; - - -package body FLTK.Widgets.Groups.Windows.Double is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_double_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_double_window_show, "fl_double_window_show"); - pragma Inline (fl_double_window_show); - - procedure fl_double_window_show2 - (W : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_double_window_show2, "fl_double_window_show2"); - pragma Inline (fl_double_window_show2); - - procedure fl_double_window_hide - (W : in Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_double_window_flush, "fl_double_window_flush"); - pragma Inline (fl_double_window_flush); - - procedure fl_double_window_flush2 - (W : in Storage.Integer_Address; - E : in Interfaces.C.int); - pragma Import (C, fl_double_window_flush2, "fl_double_window_flush2"); - pragma Inline (fl_double_window_flush2); - - - - - procedure fl_double_window_resize - (DW : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_double_window_resize, "fl_double_window_resize"); - pragma Inline (fl_double_window_resize); - - - - - procedure fl_double_window_draw - (W : in Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Double_Window) is - begin - Extra_Final (Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Double_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_double_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Double_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Double_Window) is - begin - This.Draw_Ptr := fl_double_window_draw'Address; - This.Handle_Ptr := fl_double_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Show - (This : in out Double_Window) is - begin - fl_double_window_show (This.Void_Ptr); - end Show; - - - procedure Show_With_Args - (This : in out Double_Window) is - begin - FLTK.Show_Argv.Dispatch (fl_double_window_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - 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 Flush_All - (This : in out Double_Window) is - begin - fl_double_window_flush2 (This.Void_Ptr, 1); - end Flush_All; - - - - - procedure Resize - (This : in out Double_Window; - X, Y, W, H : in Integer) is - begin - fl_double_window_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - -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 bd54d47..0000000 --- a/src/fltk-widgets-groups-windows-double.ads +++ /dev/null @@ -1,91 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Show_With_Args - (This : in out Double_Window); - - procedure Hide - (This : in out Double_Window); - - procedure Flush - (This : in out Double_Window); - - procedure Flush_All - (This : in out Double_Window); - - - - - procedure Resize - (This : in out Double_Window; - X, Y, W, H : in Integer); - - -private - - - type Double_Window is new Window with null record; - - overriding procedure Initialize - (This : in out Double_Window); - - overriding procedure Finalize - (This : in out Double_Window); - - procedure Extra_Init - (This : in out Double_Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Double_Window) - with Inline; - - - pragma Inline (Show); - pragma Inline (Show_With_Args); - pragma Inline (Hide); - pragma Inline (Flush); - pragma Inline (Flush_All); - - pragma Inline (Resize); - - -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 e949f2d..0000000 --- a/src/fltk-widgets-groups-windows-opengl.adb +++ /dev/null @@ -1,556 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Show_Argv, - Interfaces.C, - System; - -use type - - Interfaces.C.int, - Interfaces.C.signed_char, - Interfaces.C.unsigned; - - -package body FLTK.Widgets.Groups.Windows.OpenGL is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_gl_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_gl_window_show, "fl_gl_window_show"); - pragma Inline (fl_gl_window_show); - - procedure fl_gl_window_show2 - (S : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_gl_window_show2, "fl_gl_window_show2"); - pragma Inline (fl_gl_window_show2); - - procedure fl_gl_window_hide - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - procedure fl_gl_window_resize - (G : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_gl_window_resize, "fl_gl_window_resize"); - pragma Inline (fl_gl_window_resize); - - - - - function fl_gl_window_get_mode - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_invalidate - (S : in Storage.Integer_Address); - pragma Import (C, fl_gl_window_invalidate, "fl_gl_window_invalidate"); - pragma Inline (fl_gl_window_invalidate); - - procedure fl_gl_window_make_current - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out GL_Window) is - begin - Extra_Final (Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out GL_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_gl_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out GL_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out GL_Window) is - begin - This.Draw_Ptr := fl_gl_window_draw'Address; - This.Handle_Ptr := fl_gl_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, 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 Show_With_Args - (This : in out GL_Window) is - begin - FLTK.Show_Argv.Dispatch (fl_gl_window_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - 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; - - - procedure Resize - (This : in out GL_Window; - X, Y, W, H : in Integer) is - begin - fl_gl_window_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - -------------------- - -- 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 Storage.To_Address (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, Storage.To_Integer (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 Invalidate - (This : in out GL_Window) is - begin - fl_gl_window_invalidate (This.Void_Ptr); - end Invalidate; - - - 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 - Window (This).Draw; - end Draw; - - - function Handle - (This : in out GL_Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Window (This).Handle (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 2582bb1..0000000 --- a/src/fltk-widgets-groups-windows-opengl.ads +++ /dev/null @@ -1,270 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - System; - -private with - - Interfaces.C; - - -package FLTK.Widgets.Groups.Windows.OpenGL is - - - 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; - - - - - 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 Show_With_Args - (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; - - procedure Resize - (This : in out GL_Window; - X, Y, W, H : in Integer); - - - - - -------------------- - -- 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 Invalidate - (This : in out GL_Window); - - 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 Initialize - (This : in out GL_Window); - - overriding procedure Finalize - (This : in out GL_Window); - - procedure Extra_Init - (This : in out GL_Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out GL_Window) - with Inline; - - - 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 (Show_With_Args); - 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 (Invalidate); - 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 480f89e..0000000 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ /dev/null @@ -1,248 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - -use type - - Interfaces.C.unsigned; - - -package body FLTK.Widgets.Groups.Windows.Single.Menu is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_menu_window - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); - pragma Inline (fl_menu_window_flush); - - procedure fl_menu_window_erase - (M : in Storage.Integer_Address); - pragma Import (C, fl_menu_window_erase, "fl_menu_window_erase"); - pragma Inline (fl_menu_window_erase); - - - - - procedure fl_menu_window_set_overlay - (M : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Menu_Window) is - begin - Extra_Final (Single_Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Menu_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_menu_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Menu_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Single_Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Menu_Window) is - begin - This.Draw_Ptr := fl_menu_window_draw'Address; - This.Handle_Ptr := fl_menu_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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; - - - procedure Erase - (This : in out Menu_Window) is - begin - fl_menu_window_erase (This.Void_Ptr); - end Erase; - - - - - 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 := True) 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 Clear_Overlay - (This : in out Menu_Window) is - begin - fl_menu_window_clear_overlay (This.Void_Ptr); - end Clear_Overlay; - - -end FLTK.Widgets.Groups.Windows.Single.Menu; - - diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads deleted file mode 100644 index 7f6fd59..0000000 --- a/src/fltk-widgets-groups-windows-single-menu.ads +++ /dev/null @@ -1,96 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - procedure Erase - (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 := True); - - procedure Clear_Overlay - (This : in out Menu_Window); - - -private - - - type Menu_Window is new Single_Window with null record; - - overriding procedure Initialize - (This : in out Menu_Window); - - overriding procedure Finalize - (This : in out Menu_Window); - - procedure Extra_Init - (This : in out Menu_Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Menu_Window) - with Inline; - - - pragma Inline (Show); - pragma Inline (Hide); - pragma Inline (Flush); - pragma Inline (Erase); - - pragma Inline (Is_Overlay); - pragma Inline (Set_Overlay); - pragma Inline (Clear_Overlay); - - -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 a74b122..0000000 --- a/src/fltk-widgets-groups-windows-single.adb +++ /dev/null @@ -1,204 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Show_Argv, - Interfaces.C; - - -package body FLTK.Widgets.Groups.Windows.Single is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_single_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_single_window_show, "fl_single_window_show"); - pragma Inline (fl_single_window_show); - - procedure fl_single_window_show2 - (S : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_single_window_show2, "fl_single_window_show2"); - pragma Inline (fl_single_window_show2); - - procedure fl_single_window_flush - (S : in Storage.Integer_Address); - pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); - pragma Inline (fl_single_window_flush); - - - - - procedure fl_single_window_make_current - (S : in Storage.Integer_Address); - pragma Import (C, fl_single_window_make_current, "fl_single_window_make_current"); - pragma Inline (fl_single_window_make_current); - - - - - procedure fl_single_window_draw - (W : in Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Single_Window) is - begin - Extra_Final (Window (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Single_Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_single_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Single_Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Window (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Single_Window) is - begin - This.Draw_Ptr := fl_single_window_draw'Address; - This.Handle_Ptr := fl_single_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Show - (This : in out Single_Window) is - begin - fl_single_window_show (This.Void_Ptr); - end Show; - - - procedure Show_With_Args - (This : in out Single_Window) is - begin - FLTK.Show_Argv.Dispatch (fl_single_window_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - procedure Flush - (This : in out Single_Window) is - begin - fl_single_window_flush (This.Void_Ptr); - end Flush; - - - - - procedure Make_Current - (This : in out Single_Window) is - begin - fl_single_window_make_current (This.Void_Ptr); - end Make_Current; - - -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 be2fea6..0000000 --- a/src/fltk-widgets-groups-windows-single.ads +++ /dev/null @@ -1,82 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Show_With_Args - (This : in out Single_Window); - - procedure Flush - (This : in out Single_Window); - - - - - procedure Make_Current - (This : in out Single_Window); - - -private - - - type Single_Window is new Window with null record; - - overriding procedure Initialize - (This : in out Single_Window); - - overriding procedure Finalize - (This : in out Single_Window); - - procedure Extra_Init - (This : in out Single_Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Single_Window) - with Inline; - - - pragma Inline (Show); - pragma Inline (Show_With_Args); - pragma Inline (Flush); - - pragma Inline (Make_Current); - - -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 b79f937..0000000 --- a/src/fltk-widgets-groups-windows.adb +++ /dev/null @@ -1,768 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Command_Line, - Interfaces.C.Strings, - FLTK.Images.RGB, - FLTK.Show_Argv; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Groups.Windows is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address; - pragma Import (C, new_fl_window2, "new_fl_window2"); - pragma Inline (new_fl_window2); - - procedure free_fl_window - (W : in Storage.Integer_Address); - pragma Import (C, free_fl_window, "free_fl_window"); - pragma Inline (free_fl_window); - - - - - procedure fl_window_show - (W : in Storage.Integer_Address); - pragma Import (C, fl_window_show, "fl_window_show"); - pragma Inline (fl_window_show); - - procedure fl_window_show2 - (W : in Storage.Integer_Address; - C : in Interfaces.C.int; - V : in Storage.Integer_Address); - pragma Import (C, fl_window_show2, "fl_window_show2"); - pragma Inline (fl_window_show2); - - procedure fl_window_hide - (W : in Storage.Integer_Address); - pragma Import (C, fl_window_hide, "fl_window_hide"); - pragma Inline (fl_window_hide); - - function fl_window_shown - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_window_iconize, "fl_window_iconize"); - pragma Inline (fl_window_iconize); - - procedure fl_window_make_current - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_window_fullscreen, "fl_window_fullscreen"); - pragma Inline (fl_window_fullscreen); - - procedure fl_window_fullscreen_off - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_window_set_override, "fl_window_set_override"); - pragma Inline (fl_window_set_override); - - function fl_window_modal - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_window_shape, "fl_window_shape"); - pragma Inline (fl_window_shape); - - - - - function fl_window_get_x_root - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_window_draw, "fl_window_draw"); - pragma Inline (fl_window_draw); - - function fl_window_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_window_handle, "fl_window_handle"); - pragma Inline (fl_window_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Window) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Window) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Window; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Window) is - begin - This.Draw_Ptr := fl_window_draw'Address; - This.Handle_Ptr := fl_window_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, 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)); - Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Show - (This : in out Window) is - begin - fl_window_show (This.Void_Ptr); - end Show; - - - procedure Show_With_Args - (This : in out Window) is - begin - FLTK.Show_Argv.Dispatch (fl_window_show2'Access, This.Void_Ptr); - end Show_With_Args; - - - 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 - Group (This).Draw; - end Draw; - - - function Handle - (This : in out Window; - Event : in Event_Kind) - return Event_Outcome is - begin - return Group (This).Handle (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 d00d3d7..0000000 --- a/src/fltk-widgets-groups-windows.ads +++ /dev/null @@ -1,287 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Images.RGB; - -private with - - Interfaces.C.Strings; - - -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 Show_With_Args - (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 Initialize - (This : in out Window); - - overriding procedure Finalize - (This : in out Window); - - procedure Extra_Init - (This : in out Window; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Window) - with Inline; - - - pragma Inline (Show); - pragma Inline (Show_With_Args); - 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 0f60c46..0000000 --- a/src/fltk-widgets-groups-wizards.adb +++ /dev/null @@ -1,207 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C; - - -package body FLTK.Widgets.Groups.Wizards is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_wizard - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_wizard, "new_fl_wizard"); - pragma Inline (new_fl_wizard); - - procedure free_fl_wizard - (S : in Storage.Integer_Address); - pragma Import (C, free_fl_wizard, "free_fl_wizard"); - pragma Inline (free_fl_wizard); - - - - - procedure fl_wizard_next - (W : in Storage.Integer_Address); - pragma Import (C, fl_wizard_next, "fl_wizard_next"); - pragma Inline (fl_wizard_next); - - procedure fl_wizard_prev - (W : in Storage.Integer_Address); - pragma Import (C, fl_wizard_prev, "fl_wizard_prev"); - pragma Inline (fl_wizard_prev); - - - - - function fl_wizard_get_visible - (W : in Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_wizard_set_visible, "fl_wizard_set_visible"); - pragma Inline (fl_wizard_set_visible); - - - - - procedure fl_wizard_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_wizard_draw, "fl_wizard_draw"); - pragma Inline (fl_wizard_draw); - - function fl_wizard_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_wizard_handle, "fl_wizard_handle"); - pragma Inline (fl_wizard_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Wizard) is - begin - Extra_Final (Group (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Wizard) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_wizard (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Wizard; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Group (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Wizard) is - begin - This.Draw_Ptr := fl_wizard_draw'Address; - This.Handle_Ptr := fl_wizard_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Visible_Ptr : Storage.Integer_Address := fl_wizard_get_visible (This.Void_Ptr); - Actual_Widget : access Widget'Class; - begin - if Visible_Ptr /= Null_Pointer then - Visible_Ptr := fl_widget_get_user_data (Visible_Ptr); - pragma Assert (Visible_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Group (This).Draw; - end Draw; - - -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 4473c54..0000000 --- a/src/fltk-widgets-groups-wizards.ads +++ /dev/null @@ -1,87 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - -private - - - type Wizard is new Group with null record; - - overriding procedure Initialize - (This : in out Wizard); - - overriding procedure Finalize - (This : in out Wizard); - - procedure Extra_Init - (This : in out Wizard; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Wizard) - with Inline; - - - pragma Inline (Next); - pragma Inline (Prev); - - pragma Inline (Get_Visible); - pragma Inline (Set_Visible); - - pragma Inline (Draw); - - -end FLTK.Widgets.Groups.Wizards; - - diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb deleted file mode 100644 index 2c21533..0000000 --- a/src/fltk-widgets-groups.adb +++ /dev/null @@ -1,625 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Groups is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_group - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_group, "new_fl_group"); - pragma Inline (new_fl_group); - - procedure free_fl_group - (G : in Storage.Integer_Address); - pragma Import (C, free_fl_group, "free_fl_group"); - pragma Inline (free_fl_group); - - - - - procedure fl_group_add - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_add, "fl_group_add"); - pragma Inline (fl_group_add); - - procedure fl_group_insert - (G, W : in Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_group_insert2, "fl_group_insert2"); - pragma Inline (fl_group_insert2); - - procedure fl_group_remove - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_remove, "fl_group_remove"); - pragma Inline (fl_group_remove); - - procedure fl_group_remove2 - (G : in Storage.Integer_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 Storage.Integer_Address; - I : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_group_child, "fl_group_child"); - pragma Inline (fl_group_child); - - function fl_group_find - (G, W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - C : in Interfaces.C.int); - pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); - pragma Inline (fl_group_set_clip_children); - - - - - procedure fl_group_add_resizable - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_add_resizable, "fl_group_add_resizable"); - pragma Inline (fl_group_add_resizable); - - function fl_group_get_resizable - (G : in Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes"); - pragma Inline (fl_group_init_sizes); - - procedure fl_group_resize - (G : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_group_resize, "fl_group_resize"); - pragma Inline (fl_group_resize); - - - - - function fl_group_get_current - return Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_group_set_current, "fl_group_set_current"); - pragma Inline (fl_group_set_current); - - procedure fl_group_begin - (G : in Storage.Integer_Address); - pragma Import (C, fl_group_begin, "fl_group_begin"); - pragma Inline (fl_group_begin); - - procedure fl_group_end - (G : in Storage.Integer_Address); - pragma Import (C, fl_group_end, "fl_group_end"); - pragma Inline (fl_group_end); - - - - - procedure fl_group_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_group_draw, "fl_group_draw"); - pragma Inline (fl_group_draw); - - procedure fl_group_draw_child - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_draw_child, "fl_group_draw_child"); - pragma Inline (fl_group_draw_child); - - procedure fl_group_draw_children - (G : in Storage.Integer_Address); - pragma Import (C, fl_group_draw_children, "fl_group_draw_children"); - pragma Inline (fl_group_draw_children); - - procedure fl_group_draw_outside_label - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_draw_outside_label, "fl_group_draw_outside_label"); - pragma Inline (fl_group_draw_outside_label); - - procedure fl_group_update_child - (G, W : in Storage.Integer_Address); - pragma Import (C, fl_group_update_child, "fl_group_update_child"); - pragma Inline (fl_group_update_child); - - function fl_group_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_group_handle, "fl_group_handle"); - pragma Inline (fl_group_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Group) is - begin - This.Clear; - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Group) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_group (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Group; - X, Y, W, H : in Integer; - Text : in String) is - begin - fl_group_end (This.Void_Ptr); - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Group) is - begin - This.Draw_Ptr := fl_group_draw'Address; - This.Handle_Ptr := fl_group_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - -- We don't use the actual clear method here because - -- that would delete the children from memory. - 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 : Storage.Integer_Address := - fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); - Actual_Widget : access Widget'Class; - begin - Widget_Ptr := fl_widget_get_user_data (Widget_Ptr); - pragma Assert (Widget_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr)); - return (Data => Actual_Widget); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 - Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr); - begin - if Result = fl_group_children (This.Void_Ptr) then - return No_Index; - end if; - return Extended_Index (Result + 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)); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Clip_Mode; - - - procedure Set_Clip_Mode - (This : in out Group; - Mode : in Clip_Mode := Clip) is - begin - fl_group_set_clip_children (This.Void_Ptr, Clip_Mode'Pos (Mode)); - end Set_Clip_Mode; - - - - - procedure Add_Resizable - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_add_resizable (This.Void_Ptr, Item.Void_Ptr); - end Add_Resizable; - - - function Get_Resizable - (This : in Group) - return access Widget'Class - is - Widget_Ptr : Storage.Integer_Address := fl_group_get_resizable (This.Void_Ptr); - Actual_Widget : access Widget'Class; - begin - if Widget_Ptr /= Null_Pointer then - Widget_Ptr := fl_widget_get_user_data (Widget_Ptr); - pragma Assert (Widget_Ptr /= Null_Pointer); - Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr)); - end if; - return Actual_Widget; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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_Sizes - (This : in out Group) is - begin - fl_group_init_sizes (This.Void_Ptr); - end Reset_Sizes; - - - procedure Resize - (This : in out Group; - X, Y, W, H : in Integer) is - begin - fl_group_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - function Get_Current - return access Group'Class - is - Group_Ptr : Storage.Integer_Address := fl_group_get_current; - Actual_Group : access Group'Class; - begin - if Group_Ptr /= Null_Pointer then - Group_Ptr := fl_widget_get_user_data (Group_Ptr); - pragma Assert (Group_Ptr /= Null_Pointer); - Actual_Group := Group_Convert.To_Pointer (Storage.To_Address (Group_Ptr)); - end if; - return Actual_Group; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Get_Current; - - - procedure Set_Current - (To : in Group'Class) is - begin - fl_group_set_current (To.Void_Ptr); - end Set_Current; - - - procedure Begin_Current - (This : in out Group) is - begin - fl_group_begin (This.Void_Ptr); - end Begin_Current; - - - procedure End_Current - (This : in out Group) is - begin - fl_group_end (This.Void_Ptr); - end End_Current; - - - - - procedure Draw - (This : in out Group) is - begin - Widget (This).Draw; - end Draw; - - - procedure Draw_Child - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_draw_child (This.Void_Ptr, Item.Void_Ptr); - end Draw_Child; - - - procedure Draw_Children - (This : in out Group) is - begin - fl_group_draw_children (This.Void_Ptr); - end Draw_Children; - - - procedure Draw_Outside_Label - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_draw_outside_label (This.Void_Ptr, Item.Void_Ptr); - end Draw_Outside_Label; - - - procedure Update_Child - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_update_child (This.Void_Ptr, Item.Void_Ptr); - end Update_Child; - - - function Handle - (This : in out Group; - Event : in Event_Kind) - return Event_Outcome is - begin - return Widget (This).Handle (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 960c7b6..0000000 --- a/src/fltk-widgets-groups.ads +++ /dev/null @@ -1,277 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 - with Pre => This.Has_Child (Place); - - 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 := Clip); - - - - - procedure Add_Resizable - (This : in out Group; - Item : in out Widget'Class); - - function Get_Resizable - (This : in Group) - return access Widget'Class; - - procedure Set_Resizable - (This : in out Group; - Item : in Widget'Class); - - procedure Reset_Sizes - (This : in out Group); - - procedure Resize - (This : in out Group; - X, Y, W, H : in Integer); - - - - - function Get_Current - return access Group'Class; - - procedure Set_Current - (To : in Group'Class); - - procedure Begin_Current - (This : in out Group); - - procedure End_Current - (This : in out Group); - - - - - procedure Draw - (This : in out Group); - - procedure Draw_Child - (This : in out Group; - Item : in out Widget'Class); - - procedure Draw_Children - (This : in out Group); - - procedure Draw_Outside_Label - (This : in out Group; - Item : in out Widget'Class); - - procedure Update_Child - (This : in out Group; - Item : in out Widget'Class); - - function Handle - (This : in out Group; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Group is new Widget with null record; - - overriding procedure Initialize - (This : in out Group); - - overriding procedure Finalize - (This : in out Group); - - procedure Extra_Init - (This : in out Group; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Group); - - - package Group_Convert is new System.Address_To_Access_Conversions (Group); - - - 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 (Add_Resizable); - pragma Inline (Set_Resizable); - pragma Inline (Reset_Sizes); - pragma Inline (Resize); - - pragma Inline (Set_Current); - pragma Inline (Begin_Current); - pragma Inline (End_Current); - - pragma Inline (Draw); - pragma Inline (Draw_Child); - pragma Inline (Draw_Children); - pragma Inline (Draw_Outside_Label); - pragma Inline (Update_Child); - pragma Inline (Handle); - - -end FLTK.Widgets.Groups; - - diff --git a/src/fltk-widgets-inputs-text-file.adb b/src/fltk-widgets-inputs-text-file.adb deleted file mode 100644 index ce4a625..0000000 --- a/src/fltk-widgets-inputs-text-file.adb +++ /dev/null @@ -1,259 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.Text.File is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_file_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_file_input, "new_fl_file_input"); - pragma Inline (new_fl_file_input); - - procedure free_fl_file_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_file_input, "free_fl_file_input"); - pragma Inline (free_fl_file_input); - - - - - function fl_file_input_get_down_box - (F : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_file_input_get_down_box, "fl_file_input_get_down_box"); - pragma Inline (fl_file_input_get_down_box); - - procedure fl_file_input_set_down_box - (F : in Storage.Integer_Address; - T : in Interfaces.C.int); - pragma Import (C, fl_file_input_set_down_box, "fl_file_input_set_down_box"); - pragma Inline (fl_file_input_set_down_box); - - function fl_file_input_get_errorcolor - (F : in Storage.Integer_Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_file_input_get_errorcolor, "fl_file_input_get_errorcolor"); - pragma Inline (fl_file_input_get_errorcolor); - - procedure fl_file_input_set_errorcolor - (F : in Storage.Integer_Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_file_input_set_errorcolor, "fl_file_input_set_errorcolor"); - pragma Inline (fl_file_input_set_errorcolor); - - - - - function fl_file_input_get_value - (F : in Storage.Integer_Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_file_input_get_value, "fl_file_input_get_value"); - pragma Inline (fl_file_input_get_value); - - function fl_file_input_set_value - (I : in Storage.Integer_Address; - T : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_file_input_set_value, "fl_file_input_set_value"); - pragma Inline (fl_file_input_set_value); - - - - - procedure fl_file_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); - pragma Inline (fl_file_input_draw); - - function fl_file_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); - pragma Inline (fl_file_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out File_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out File_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_file_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out File_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out File_Input) is - begin - This.Draw_Ptr := fl_file_input_draw'Address; - This.Handle_Ptr := fl_file_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Input is - begin - return This : File_Input do - This.Void_Ptr := new_fl_file_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Down_Box - (This : in File_Input) - return Box_Kind is - begin - return Box_Kind'Val (fl_file_input_get_down_box (This.Void_Ptr)); - end Get_Down_Box; - - - procedure Set_Down_Box - (This : in out File_Input; - To : in Box_Kind) is - begin - fl_file_input_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); - end Set_Down_Box; - - - function Get_Error_Color - (This : in File_Input) - return Color is - begin - return Color (fl_file_input_get_errorcolor (This.Void_Ptr)); - end Get_Error_Color; - - - procedure Set_Error_Color - (This : in out File_Input; - To : in Color) is - begin - fl_file_input_set_errorcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); - end Set_Error_Color; - - - - - function Get_Value - (This : in File_Input) - return String - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr then - return ""; - else - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (Ptr); - end if; - end Get_Value; - - - procedure Set_Value - (This : in out File_Input; - To : in String) - is - Result : Interfaces.C.int := fl_file_input_set_value - (This.Void_Ptr, - Interfaces.C.To_C (To), To'Length); - begin - pragma Assert (Result /= 0); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Value; - - - - - procedure Draw - (This : in out File_Input) is - begin - Text_Input (This).Draw; - end Draw; - - - function Handle - (This : in out File_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Text_Input (This).Handle (Event); - end Handle; - - -end FLTK.Widgets.Inputs.Text.File; - - diff --git a/src/fltk-widgets-inputs-text-file.ads b/src/fltk-widgets-inputs-text-file.ads deleted file mode 100644 index 74ea7e1..0000000 --- a/src/fltk-widgets-inputs-text-file.ads +++ /dev/null @@ -1,105 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.File is - - - type File_Input is new Text_Input with private; - - type File_Input_Reference (Data : not null access File_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return File_Input; - - end Forge; - - - - - function Get_Down_Box - (This : in File_Input) - return Box_Kind; - - procedure Set_Down_Box - (This : in out File_Input; - To : in Box_Kind); - - function Get_Error_Color - (This : in File_Input) - return Color; - - procedure Set_Error_Color - (This : in out File_Input; - To : in Color); - - - - - function Get_Value - (This : in File_Input) - return String; - - procedure Set_Value - (This : in out File_Input; - To : in String); - - - - - procedure Draw - (This : in out File_Input); - - function Handle - (This : in out File_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type File_Input is new Text_Input with null record; - - overriding procedure Initialize - (This : in out File_Input); - - overriding procedure Finalize - (This : in out File_Input); - - procedure Extra_Init - (This : in out File_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out File_Input) - with Inline; - - - pragma Inline (Get_Down_Box); - pragma Inline (Set_Down_Box); - pragma Inline (Get_Error_Color); - pragma Inline (Set_Error_Color); - - pragma Inline (Get_Value); - pragma Inline (Set_Value); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Text.File; - - diff --git a/src/fltk-widgets-inputs-text-floating_point.adb b/src/fltk-widgets-inputs-text-floating_point.adb deleted file mode 100644 index 61ea531..0000000 --- a/src/fltk-widgets-inputs-text-floating_point.adb +++ /dev/null @@ -1,143 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.Text.Floating_Point is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_float_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_float_input, "new_fl_float_input"); - pragma Inline (new_fl_float_input); - - procedure free_fl_float_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_float_input, "free_fl_float_input"); - pragma Inline (free_fl_float_input); - - - - - procedure fl_float_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); - pragma Inline (fl_float_input_draw); - - function fl_float_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); - pragma Inline (fl_float_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Float_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Float_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_float_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Float_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Float_Input) is - begin - This.Draw_Ptr := fl_float_input_draw'Address; - This.Handle_Ptr := fl_float_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Float_Input is - begin - return This : Float_Input do - This.Void_Ptr := new_fl_float_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Value - (This : in Float_Input) - return Long_Float - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr or else - Interfaces.C.Strings.Value (Ptr) = "" - then - return 0.0; - else - return Long_Float'Value (Interfaces.C.Strings.Value (Ptr)); - end if; - end Get_Value; - - -end FLTK.Widgets.Inputs.Text.Floating_Point; - - diff --git a/src/fltk-widgets-inputs-text-floating_point.ads b/src/fltk-widgets-inputs-text-floating_point.ads deleted file mode 100644 index a6bc600..0000000 --- a/src/fltk-widgets-inputs-text-floating_point.ads +++ /dev/null @@ -1,62 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Floating_Point is - - - type Float_Input is new Text_Input with private; - - type Float_Input_Reference (Data : not null access Float_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Float_Input; - - end Forge; - - - - - function Get_Value - (This : in Float_Input) - return Long_Float; - - -private - - - type Float_Input is new Text_Input with null record; - - overriding procedure Initialize - (This : in out Float_Input); - - overriding procedure Finalize - (This : in out Float_Input); - - procedure Extra_Init - (This : in out Float_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Float_Input) - with Inline; - - - pragma Inline (Get_Value); - - -end FLTK.Widgets.Inputs.Text.Floating_Point; - - diff --git a/src/fltk-widgets-inputs-text-multiline.adb b/src/fltk-widgets-inputs-text-multiline.adb deleted file mode 100644 index 2bed66d..0000000 --- a/src/fltk-widgets-inputs-text-multiline.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Text.Multiline is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_multiline_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_multiline_input, "new_fl_multiline_input"); - pragma Inline (new_fl_multiline_input); - - procedure free_fl_multiline_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input"); - pragma Inline (free_fl_multiline_input); - - - - - procedure fl_multiline_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); - pragma Inline (fl_multiline_input_draw); - - function fl_multiline_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); - pragma Inline (fl_multiline_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Multiline_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Multiline_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_multiline_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Multiline_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Multiline_Input) is - begin - This.Draw_Ptr := fl_multiline_input_draw'Address; - This.Handle_Ptr := fl_multiline_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Input is - begin - return This : Multiline_Input do - This.Void_Ptr := new_fl_multiline_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Inputs.Text.Multiline; - - diff --git a/src/fltk-widgets-inputs-text-multiline.ads b/src/fltk-widgets-inputs-text-multiline.ads deleted file mode 100644 index 0a51992..0000000 --- a/src/fltk-widgets-inputs-text-multiline.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Multiline is - - - type Multiline_Input is new Text_Input with private; - - type Multiline_Input_Reference (Data : not null access Multiline_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Input; - - end Forge; - - -private - - - type Multiline_Input is new Text_Input with null record; - - overriding procedure Initialize - (This : in out Multiline_Input); - - overriding procedure Finalize - (This : in out Multiline_Input); - - procedure Extra_Init - (This : in out Multiline_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Multiline_Input) - with Inline; - - -end FLTK.Widgets.Inputs.Text.Multiline; - - diff --git a/src/fltk-widgets-inputs-text-outputs-multiline.adb b/src/fltk-widgets-inputs-text-outputs-multiline.adb deleted file mode 100644 index 021377e..0000000 --- a/src/fltk-widgets-inputs-text-outputs-multiline.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Text.Outputs.Multiline is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_multiline_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_multiline_output, "new_fl_multiline_output"); - pragma Inline (new_fl_multiline_output); - - procedure free_fl_multiline_output - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output"); - pragma Inline (free_fl_multiline_output); - - - - - procedure fl_multiline_output_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); - pragma Inline (fl_multiline_output_draw); - - function fl_multiline_output_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); - pragma Inline (fl_multiline_output_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Multiline_Output) is - begin - Extra_Final (Output (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Multiline_Output) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_multiline_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Multiline_Output; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Output (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Multiline_Output) is - begin - This.Draw_Ptr := fl_multiline_output_draw'Address; - This.Handle_Ptr := fl_multiline_output_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Output is - begin - return This : Multiline_Output do - This.Void_Ptr := new_fl_multiline_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Inputs.Text.Outputs.Multiline; - - diff --git a/src/fltk-widgets-inputs-text-outputs-multiline.ads b/src/fltk-widgets-inputs-text-outputs-multiline.ads deleted file mode 100644 index 4600616..0000000 --- a/src/fltk-widgets-inputs-text-outputs-multiline.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Outputs.Multiline is - - - type Multiline_Output is new Output with private; - - type Multiline_Output_Reference (Data : not null access Multiline_Output'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Multiline_Output; - - end Forge; - - -private - - - type Multiline_Output is new Output with null record; - - overriding procedure Initialize - (This : in out Multiline_Output); - - overriding procedure Finalize - (This : in out Multiline_Output); - - procedure Extra_Init - (This : in out Multiline_Output; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Multiline_Output) - with Inline; - - -end FLTK.Widgets.Inputs.Text.Outputs.Multiline; - - diff --git a/src/fltk-widgets-inputs-text-outputs.adb b/src/fltk-widgets-inputs-text-outputs.adb deleted file mode 100644 index 07f9294..0000000 --- a/src/fltk-widgets-inputs-text-outputs.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Text.Outputs is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_output, "new_fl_output"); - pragma Inline (new_fl_output); - - procedure free_fl_output - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_output, "free_fl_output"); - pragma Inline (free_fl_output); - - - - - procedure fl_output_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_output_draw, "fl_output_draw"); - pragma Inline (fl_output_draw); - - function fl_output_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_output_handle, "fl_output_handle"); - pragma Inline (fl_output_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Output) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Output) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Output; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Output) is - begin - This.Draw_Ptr := fl_output_draw'Address; - This.Handle_Ptr := fl_output_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Output is - begin - return This : Output do - This.Void_Ptr := new_fl_output - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Inputs.Text.Outputs; - - diff --git a/src/fltk-widgets-inputs-text-outputs.ads b/src/fltk-widgets-inputs-text-outputs.ads deleted file mode 100644 index 7e003e6..0000000 --- a/src/fltk-widgets-inputs-text-outputs.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Outputs is - - - type Output is new Text_Input with private; - - type Output_Reference (Data : not null access Output'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Output; - - end Forge; - - -private - - - type Output is new Text_Input with null record; - - overriding procedure Initialize - (This : in out Output); - - overriding procedure Finalize - (This : in out Output); - - procedure Extra_Init - (This : in out Output; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Output) - with Inline; - - -end FLTK.Widgets.Inputs.Text.Outputs; - - diff --git a/src/fltk-widgets-inputs-text-secret.adb b/src/fltk-widgets-inputs-text-secret.adb deleted file mode 100644 index 242d872..0000000 --- a/src/fltk-widgets-inputs-text-secret.adb +++ /dev/null @@ -1,132 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Inputs.Text.Secret is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_secret_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_secret_input, "new_fl_secret_input"); - pragma Inline (new_fl_secret_input); - - procedure free_fl_secret_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_secret_input, "free_fl_secret_input"); - pragma Inline (free_fl_secret_input); - - - - - procedure fl_secret_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); - pragma Inline (fl_secret_input_draw); - - function fl_secret_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); - pragma Inline (fl_secret_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Secret_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Secret_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_secret_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Secret_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Secret_Input) is - begin - This.Draw_Ptr := fl_secret_input_draw'Address; - This.Handle_Ptr := fl_secret_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Secret_Input is - begin - return This : Secret_Input do - This.Void_Ptr := new_fl_secret_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Handle - (This : in out Secret_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Text_Input (This).Handle (Event); - end Handle; - - -end FLTK.Widgets.Inputs.Text.Secret; - - diff --git a/src/fltk-widgets-inputs-text-secret.ads b/src/fltk-widgets-inputs-text-secret.ads deleted file mode 100644 index 375ebfb..0000000 --- a/src/fltk-widgets-inputs-text-secret.ads +++ /dev/null @@ -1,63 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Secret is - - - type Secret_Input is new Text_Input with private; - - type Secret_Input_Reference (Data : not null access Secret_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Secret_Input; - - end Forge; - - - - - function Handle - (This : in out Secret_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Secret_Input is new Text_Input with null record; - - overriding procedure Initialize - (This : in out Secret_Input); - - overriding procedure Finalize - (This : in out Secret_Input); - - procedure Extra_Init - (This : in out Secret_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Secret_Input) - with Inline; - - - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Text.Secret; - - diff --git a/src/fltk-widgets-inputs-text-whole_number.adb b/src/fltk-widgets-inputs-text-whole_number.adb deleted file mode 100644 index ae3ad7d..0000000 --- a/src/fltk-widgets-inputs-text-whole_number.adb +++ /dev/null @@ -1,143 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs.Text.Whole_Number is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_int_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_int_input, "new_fl_int_input"); - pragma Inline (new_fl_int_input); - - procedure free_fl_int_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_int_input, "free_fl_int_input"); - pragma Inline (free_fl_int_input); - - - - - procedure fl_int_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); - pragma Inline (fl_int_input_draw); - - function fl_int_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); - pragma Inline (fl_int_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Integer_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Integer_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_int_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Integer_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Integer_Input) is - begin - This.Draw_Ptr := fl_int_input_draw'Address; - This.Handle_Ptr := fl_int_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Integer_Input is - begin - return This : Integer_Input do - This.Void_Ptr := new_fl_int_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Value - (This : in Integer_Input) - return Long_Integer - is - Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); - begin - if Ptr = Interfaces.C.Strings.Null_Ptr or else - Interfaces.C.Strings.Value (Ptr) = "" - then - return 0; - else - return Long_Integer'Value (Interfaces.C.Strings.Value (Ptr)); - end if; - end Get_Value; - - -end FLTK.Widgets.Inputs.Text.Whole_Number; - - diff --git a/src/fltk-widgets-inputs-text-whole_number.ads b/src/fltk-widgets-inputs-text-whole_number.ads deleted file mode 100644 index 0d2695f..0000000 --- a/src/fltk-widgets-inputs-text-whole_number.ads +++ /dev/null @@ -1,62 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text.Whole_Number is - - - type Integer_Input is new Text_Input with private; - - type Integer_Input_Reference (Data : not null access Integer_Input'Class) is - limited null record with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Integer_Input; - - end Forge; - - - - - function Get_Value - (This : in Integer_Input) - return Long_Integer; - - -private - - - type Integer_Input is new Text_Input with null record; - - overriding procedure Initialize - (This : in out Integer_Input); - - overriding procedure Finalize - (This : in out Integer_Input); - - procedure Extra_Init - (This : in out Integer_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Integer_Input) - with Inline; - - - pragma Inline (Get_Value); - - -end FLTK.Widgets.Inputs.Text.Whole_Number; - - diff --git a/src/fltk-widgets-inputs-text.adb b/src/fltk-widgets-inputs-text.adb deleted file mode 100644 index 573e589..0000000 --- a/src/fltk-widgets-inputs-text.adb +++ /dev/null @@ -1,179 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Inputs.Text is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_text_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_text_input, "new_fl_text_input"); - pragma Inline (new_fl_text_input); - - procedure free_fl_text_input - (T : in Storage.Integer_Address); - pragma Import (C, free_fl_text_input, "free_fl_text_input"); - pragma Inline (free_fl_text_input); - - - - - procedure fl_text_input_draw - (T : in Storage.Integer_Address); - pragma Import (C, fl_text_input_draw, "fl_text_input_draw"); - pragma Inline (fl_text_input_draw); - - function fl_text_input_handle - (T : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_input_handle, "fl_text_input_handle"); - pragma Inline (fl_text_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Message received, every zig will take off - procedure text_input_extra_final_hook - (Ada_Obj : in Storage.Integer_Address); - pragma Export (C, text_input_extra_final_hook, "text_input_extra_final_hook"); - - procedure text_input_extra_final_hook - (Ada_Obj : in Storage.Integer_Address) - is - My_Text_Input : Text_Input; - for My_Text_Input'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Text_Input); - begin - Extra_Final (My_Text_Input); - end text_input_extra_final_hook; - - - procedure Extra_Final - (This : in out Text_Input) is - begin - Extra_Final (Input (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Text_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_text_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Last stop, everyone out! - procedure text_input_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, text_input_extra_init_hook, "text_input_extra_init_hook"); - - procedure text_input_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr) - is - My_Text_Input : Text_Input; - for My_Text_Input'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Text_Input); - begin - Extra_Init - (My_Text_Input, - Integer (X), Integer (Y), - Integer (W), Integer (H), - Interfaces.C.Strings.Value (C_Str)); - end text_input_extra_init_hook; - - - procedure Extra_Init - (This : in out Text_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Input (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Text_Input) is - begin - This.Draw_Ptr := fl_text_input_draw'Address; - This.Handle_Ptr := fl_text_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Input is - begin - return This : Text_Input do - This.Void_Ptr := new_fl_text_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Text_Input) is - begin - Input (This).Draw; - end Draw; - - - function Handle - (This : in out Text_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Input (This).Handle (Event); - end Handle; - - -end FLTK.Widgets.Inputs.Text; - - diff --git a/src/fltk-widgets-inputs-text.ads b/src/fltk-widgets-inputs-text.ads deleted file mode 100644 index 7f0f695..0000000 --- a/src/fltk-widgets-inputs-text.ads +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Inputs.Text is - - - type Text_Input is new Input with private; - - type Text_Input_Reference (Data : not null access Text_Input'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Text_Input; - - end Forge; - - - - - procedure Draw - (This : in out Text_Input); - - function Handle - (This : in out Text_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Text_Input is new Input with null record; - - overriding procedure Initialize - (This : in out Text_Input); - - overriding procedure Finalize - (This : in out Text_Input); - - procedure Extra_Init - (This : in out Text_Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Text_Input) - with Inline; - - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Inputs.Text; - - diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb deleted file mode 100644 index 15c7964..0000000 --- a/src/fltk-widgets-inputs.adb +++ /dev/null @@ -1,934 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Inputs is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_input, "new_fl_input"); - pragma Inline (new_fl_input); - - procedure free_fl_input - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_input, "free_fl_input"); - pragma Inline (free_fl_input); - - - - - function fl_input_copy - (I : in Storage.Integer_Address; - C : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_copy, "fl_input_copy"); - pragma Inline (fl_input_copy); - - function fl_input_cut - (I : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_set_position2 - (I : in Storage.Integer_Address; - P, M : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_set_position2, "fl_input_set_position2"); - pragma Inline (fl_input_set_position2); - - - - - function fl_input_index - (I : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - function fl_input_set_value - (I : in Storage.Integer_Address; - T : in Interfaces.C.char_array; - L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_set_value, "fl_input_set_value"); - pragma Inline (fl_input_set_value); - - - - - function fl_input_get_maximum_size - (I : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_resize - (I : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_input_resize, "fl_input_resize"); - pragma Inline (fl_input_resize); - - - - - procedure fl_input_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_input_draw, "fl_input_draw"); - pragma Inline (fl_input_draw); - - function fl_input_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_input_handle, "fl_input_handle"); - pragma Inline (fl_input_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Input) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Input) is - begin - This.Draw_Ptr := fl_input_draw'Address; - This.Handle_Ptr := fl_input_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Copy - (This : in out Input; - Destination : in Clipboard_Kind := Cut_Paste_Board) - is - Result : Interfaces.C.int := fl_input_copy - (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Copy; - - - function Copy - (This : in out Input; - Destination : in Clipboard_Kind := Cut_Paste_Board) - return Boolean - is - Result : Interfaces.C.int := fl_input_copy - (This.Void_Ptr, Clipboard_Kind'Pos (Destination)); - begin - pragma Assert (Result in 0 .. 1); - return Boolean'Val (Result); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Copy; - - - procedure Cut - (This : in out Input) - is - Result : Interfaces.C.int := fl_input_cut (This.Void_Ptr); - begin - null; - end Cut; - - - function Cut - (This : in out Input) - return Boolean is - begin - return fl_input_cut (This.Void_Ptr) /= 0; - end Cut; - - - procedure Cut - (This : in out Input; - Num_Bytes : in Integer) - is - Result : Interfaces.C.int := fl_input_cut2 - (This.Void_Ptr, - Interfaces.C.int (Num_Bytes)); - begin - null; - end Cut; - - - function Cut - (This : in out Input; - Num_Bytes : in Integer) - return Boolean is - begin - return fl_input_cut2 - (This.Void_Ptr, - Interfaces.C.int (Num_Bytes)) /= 0; - end Cut; - - - procedure Cut - (This : in out Input; - Start, Finish : in Integer) - is - Result : Interfaces.C.int := fl_input_cut3 - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - begin - null; - end Cut; - - - function Cut - (This : in out Input; - Start, Finish : in Integer) - return Boolean is - begin - return fl_input_cut3 - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)) /= 0; - end Cut; - - - procedure Copy_Cuts - (This : in out Input) - is - Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); - begin - null; - end Copy_Cuts; - - - function Copy_Cuts - (This : in out Input) - return Boolean - is - Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr); - begin - return Result /= 0; - end Copy_Cuts; - - - procedure Undo - (This : in out Input) - is - Result : Interfaces.C.int := fl_input_undo (This.Void_Ptr); - begin - null; - end Undo; - - - function Undo - (This : in out Input) - return Boolean is - begin - return fl_input_undo (This.Void_Ptr) /= 0; - end Undo; - - - - - 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 - Result : Interfaces.C.int := fl_input_set_mark - (This.Void_Ptr, - Interfaces.C.int (To)); - begin - null; - end Set_Mark; - - - function Set_Mark - (This : in out Input; - To : in Natural) - return Boolean is - begin - return 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 - Result : Interfaces.C.int := fl_input_set_position - (This.Void_Ptr, - Interfaces.C.int (To)); - begin - null; - end Set_Position; - - - function Set_Position - (This : in out Input; - To : in Natural) - return Boolean is - begin - return fl_input_set_position - (This.Void_Ptr, - Interfaces.C.int (To)) /= 0; - end Set_Position; - - - procedure Set_Position_Mark - (This : in out Input; - Place : in Natural; - Mark : in Natural) - is - Result : Interfaces.C.int := fl_input_set_position2 - (This.Void_Ptr, - Interfaces.C.int (Place), - Interfaces.C.int (Mark)); - begin - null; - end Set_Position_Mark; - - - function Set_Position_Mark - (This : in out Input; - Place : in Natural; - Mark : in Natural) - return Boolean is - begin - return fl_input_set_position2 - (This.Void_Ptr, - Interfaces.C.int (Place), - Interfaces.C.int (Mark)) /= 0; - end Set_Position_Mark; - - - - - function Index - (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 - Result : Interfaces.C.int := fl_input_insert - (This.Void_Ptr, - Interfaces.C.To_C (Str, False), - Str'Length); - begin - null; - end Insert; - - - function Insert - (This : in out Input; - Str : in String) - return Boolean is - begin - return fl_input_insert - (This.Void_Ptr, - Interfaces.C.To_C (Str, False), - Str'Length) /= 0; - end Insert; - - - procedure Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String) - is - Result : Interfaces.C.int := fl_input_replace - (This.Void_Ptr, - Interfaces.C.int (From), - Interfaces.C.int (To), - Interfaces.C.To_C (New_Text), - New_Text'Length); - begin - null; - end Replace; - - - function Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String) - return Boolean is - begin - return fl_input_replace - (This.Void_Ptr, - Interfaces.C.int (From), - Interfaces.C.int (To), - Interfaces.C.To_C (New_Text, False), - New_Text'Length) /= 0; - end Replace; - - - 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 - Result : Interfaces.C.int := fl_input_set_value - (This.Void_Ptr, Interfaces.C.To_C (To), To'Length); - begin - null; - end Set_Value; - - - function Set_Value - (This : in out Input; - To : in String) - return Boolean is - begin - return fl_input_set_value - (This.Void_Ptr, - Interfaces.C.To_C (To, False), - To'Length) /= 0; - end Set_Value; - - - - - 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 Resize - (This : in out Input; - X, Y, W, H : in Integer) is - begin - fl_input_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - 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 7fc436b..0000000 --- a/src/fltk-widgets-inputs.ads +++ /dev/null @@ -1,369 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - type Clipboard_Kind is (Selection_Buffer, Cut_Paste_Board); - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Input; - - end Forge; - - - - - procedure Copy - (This : in out Input; - Destination : in Clipboard_Kind := Cut_Paste_Board); - - function Copy - (This : in out Input; - Destination : in Clipboard_Kind := Cut_Paste_Board) - return Boolean; - - procedure Cut - (This : in out Input); - - function Cut - (This : in out Input) - return Boolean; - - procedure Cut - (This : in out Input; - Num_Bytes : in Integer); - - function Cut - (This : in out Input; - Num_Bytes : in Integer) - return Boolean; - - procedure Cut - (This : in out Input; - Start, Finish : in Integer); - - function Cut - (This : in out Input; - Start, Finish : in Integer) - return Boolean; - - procedure Copy_Cuts - (This : in out Input); - - function Copy_Cuts - (This : in out Input) - return Boolean; - - procedure Undo - (This : in out Input); - - function Undo - (This : in out Input) - return Boolean; - - - - - function 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 Set_Mark - (This : in out Input; - To : in Natural) - return Boolean; - - function Get_Position - (This : in Input) - return Natural; - - procedure Set_Position - (This : in out Input; - To : in Natural); - - function Set_Position - (This : in out Input; - To : in Natural) - return Boolean; - - procedure Set_Position_Mark - (This : in out Input; - Place : in Natural; - Mark : in Natural); - - function Set_Position_Mark - (This : in out Input; - Place : in Natural; - Mark : in Natural) - return Boolean; - - - - - function Index - (This : in Input; - Place : in Integer) - return Character; - - procedure Insert - (This : in out Input; - Str : in String); - - function Insert - (This : in out Input; - Str : in String) - return Boolean; - - procedure Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String); - - function Replace - (This : in out Input; - From, To : in Natural; - New_Text : in String) - return Boolean; - - function Get_Value - (This : in Input) - return String; - - procedure Set_Value - (This : in out Input; - To : in String); - - function Set_Value - (This : in out Input; - To : in String) - return Boolean; - - - - - 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 Resize - (This : in out Input; - X, Y, W, H : in Integer); - - - - - package Extra is - - procedure Set_Input_Type - (This : in out Input; - To : in Input_Kind); - - end Extra; - - -private - - - type Input is new Widget with null record; - - overriding procedure Initialize - (This : in out Input); - - overriding procedure Finalize - (This : in out Input); - - procedure Extra_Init - (This : in out Input; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Input) - with Inline; - - - pragma Inline (Copy); - pragma Inline (Cut); - pragma Inline (Copy_Cuts); - pragma Inline (Undo); - - 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 Storage.Integer_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 f0fb03a..0000000 --- a/src/fltk-widgets-menus-choices.adb +++ /dev/null @@ -1,204 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C, - System; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Menus.Choices is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_choice - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_choice, "new_fl_choice"); - pragma Inline (new_fl_choice); - - procedure free_fl_choice - (B : in Storage.Integer_Address); - pragma Import (C, free_fl_choice, "free_fl_choice"); - pragma Inline (free_fl_choice); - - - - - function fl_choice_value - (M : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_choice_draw, "fl_choice_draw"); - pragma Inline (fl_choice_draw); - - function fl_choice_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_choice_handle, "fl_choice_handle"); - pragma Inline (fl_choice_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Choice) is - begin - Extra_Final (Menu (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Choice) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_choice (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Choice; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Menu (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Choice) is - begin - This.Draw_Ptr := fl_choice_draw'Address; - This.Handle_Ptr := fl_choice_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_Chosen - (This : in Choice) - return FLTK.Menu_Items.Menu_Item_Reference is - begin - return (Data => This.My_Items.Element (This.Chosen_Index)); - end Get_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 - Menu (This).Draw; - end Draw; - - - function Handle - (This : in out Choice; - Event : in Event_Kind) - return Event_Outcome is - begin - return Menu (This).Handle (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 86ddd60..0000000 --- a/src/fltk-widgets-menus-choices.ads +++ /dev/null @@ -1,90 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Get_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 Initialize - (This : in out Choice); - - overriding procedure Finalize - (This : in out Choice); - - procedure Extra_Init - (This : in out Choice; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Choice) - with Inline; - - - 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 0548936..0000000 --- a/src/fltk-widgets-menus-menu_bars.adb +++ /dev/null @@ -1,139 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - - -package body FLTK.Widgets.Menus.Menu_Bars is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_menu_bar - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Menu_Bar) is - begin - Extra_Final (Menu (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Menu_Bar) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_menu_bar (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Menu_Bar; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Menu (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Menu_Bar) is - begin - This.Draw_Ptr := fl_menu_bar_draw'Address; - This.Handle_Ptr := fl_menu_bar_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Menu_Bar) is - begin - Menu (This).Draw; - end Draw; - - - function Handle - (This : in out Menu_Bar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Menu (This).Handle (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 53603b0..0000000 --- a/src/fltk-widgets-menus-menu_bars.ads +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Menu_Bar); - - overriding procedure Finalize - (This : in out Menu_Bar); - - procedure Extra_Init - (This : in out Menu_Bar; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Menu_Bar) - with Inline; - - - 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 ae9ae75..0000000 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ /dev/null @@ -1,221 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Menus.Menu_Buttons is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_menu_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- More magic - procedure menu_button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address); - pragma Export (C, menu_button_extra_final_hook, "menu_button_extra_final_hook"); - - procedure menu_button_extra_final_hook - (Ada_Obj : in Storage.Integer_Address) - is - My_Menu_Button : Menu_Button; - for My_Menu_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Menu_Button); - begin - Extra_Final (My_Menu_Button); - end menu_button_extra_final_hook; - - - procedure Extra_Final - (This : in out Menu_Button) is - begin - Extra_Final (Menu (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Menu_Button) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_menu_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Long distance telephone call receival - procedure menu_button_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, menu_button_extra_init_hook, "menu_button_extra_init_hook"); - - procedure menu_button_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr) - is - My_Menu_Button : Menu_Button; - for My_Menu_Button'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Menu_Button); - begin - Extra_Init - (My_Menu_Button, - Integer (X), Integer (Y), - Integer (W), Integer (H), - Interfaces.C.Strings.Value (C_Str)); - end menu_button_extra_init_hook; - - - procedure Extra_Init - (This : in out Menu_Button; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Menu (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Menu_Button) is - begin - This.Draw_Ptr := fl_menu_button_draw'Address; - This.Handle_Ptr := fl_menu_button_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 : Storage.Integer_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 - Menu (This).Draw; - end Draw; - - - function Handle - (This : in out Menu_Button; - Event : in Event_Kind) - return Event_Outcome is - begin - return Menu (This).Handle (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 4ba09a3..0000000 --- a/src/fltk-widgets-menus-menu_buttons.ads +++ /dev/null @@ -1,89 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Menu_Button); - - overriding procedure Finalize - (This : in out Menu_Button); - - procedure Extra_Init - (This : in out Menu_Button; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Menu_Button) - with Inline; - - - 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 28653ec..0000000 --- a/src/fltk-widgets-menus.adb +++ /dev/null @@ -1,839 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Ada.Unchecked_Deallocation, - Interfaces.C.Strings; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned_long, - Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Widgets.Menus is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_menu - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_menu, "new_fl_menu"); - pragma Inline (new_fl_menu); - - procedure free_fl_menu - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_menu, "free_fl_menu"); - pragma Inline (free_fl_menu); - - - - - function fl_menu_add - (M : in Storage.Integer_Address; - T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; - C, U : in Storage.Integer_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 Storage.Integer_Address; - P : in Interfaces.C.int; - T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; - C, U : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_menu_clear, "fl_menu_clear"); - pragma Inline (fl_menu_clear); - - - - - function fl_menu_get_item - (M : in Storage.Integer_Address; - I : in Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_Address; - T : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); - pragma Inline (fl_menu_mvalue); - - function fl_menu_text - (M : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_menu_global, "fl_menu_global"); - pragma Inline (fl_menu_global); - - function fl_menu_measure - (M : in Storage.Integer_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 Storage.Integer_Address; - X, Y : in Interfaces.C.int; - T : in Interfaces.C.char_array; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_menu_popup, "fl_menu_popup"); - pragma Inline (fl_menu_popup); - - function fl_menu_pulldown - (M : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - N : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_menu_pulldown, "fl_menu_pulldown"); - pragma Inline (fl_menu_pulldown); - - - - - procedure fl_menu_draw_item - (M : in Storage.Integer_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 fl_menu_draw - (M : in Storage.Integer_Address); - pragma Import (C, fl_menu_draw, "fl_menu_draw"); - pragma Inline (fl_menu_draw); - - function fl_menu_handle - (M : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_menu_handle, "fl_menu_handle"); - pragma Inline (fl_menu_handle); - - - - - ---------------------- - -- Callback Hooks -- - ---------------------- - - procedure Item_Hook - (M, U : in Storage.Integer_Address) - is - C_Ptr : Storage.Integer_Address := fl_widget_get_user_data (M); - Ada_Widget : access Widget'Class; - Action : Widget_Callback := Callback_Convert.To_Access (U); - begin - pragma Assert (C_Ptr /= Null_Pointer); - Ada_Widget := Widget_Convert.To_Pointer (Storage.To_Address (C_Ptr)); - Action.all (Ada_Widget.all); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Item_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Free_Item is new Ada.Unchecked_Deallocation - (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access); - - - procedure Extra_Final - (This : in out Menu) is - begin - for Item of This.My_Items loop - Free_Item (Item); - end loop; - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Menu) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_menu (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Menu; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Menu) is - begin - This.Draw_Ptr := fl_menu_draw'Address; - This.Handle_Ptr := fl_menu_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 : Storage.Integer_Address := Null_Pointer; - begin - if Action /= null then - Callback := Storage.To_Integer (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 : Storage.Integer_Address := Null_Pointer; - begin - if Action /= null then - Callback := Storage.To_Integer (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 : Storage.Integer_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 : Storage.Integer_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; - - -end FLTK.Widgets.Menus; - - diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads deleted file mode 100644 index 1d7b55b..0000000 --- a/src/fltk-widgets-menus.ads +++ /dev/null @@ -1,329 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Menu_Items, - Ada.Iterator_Interfaces; - -private with - - Ada.Containers.Vectors, - Interfaces; - - -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_Item - (This : in out Menu; - Item : in Index; - X, Y, W, H : in Integer; - Selected : in Boolean := False); - - -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 Initialize - (This : in out Menu); - - overriding procedure Finalize - (This : in out Menu); - - procedure Extra_Init - (This : in out Menu; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Menu); - - - procedure Item_Hook (M, U : in Storage.Integer_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_Item); - - -end FLTK.Widgets.Menus; - - diff --git a/src/fltk-widgets-positioners.adb b/src/fltk-widgets-positioners.adb deleted file mode 100644 index 0e3dfb2..0000000 --- a/src/fltk-widgets-positioners.adb +++ /dev/null @@ -1,525 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - Interfaces.C; - - -package body FLTK.Widgets.Positioners is - - - package Chk renames Ada.Assertions; - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_positioner - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_positioner, "new_fl_positioner"); - pragma Inline (new_fl_positioner); - - procedure free_fl_positioner - (P : in Storage.Integer_Address); - pragma Import (C, free_fl_positioner, "free_fl_positioner"); - pragma Inline (free_fl_positioner); - - - - - function fl_positioner_set_value - (P : in Storage.Integer_Address; - X, Y : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_positioner_set_value, "fl_positioner_set_value"); - pragma Inline (fl_positioner_set_value); - - - - - procedure fl_positioner_xbounds - (P : in Storage.Integer_Address; - L, H : in Interfaces.C.double); - pragma Import (C, fl_positioner_xbounds, "fl_positioner_xbounds"); - pragma Inline (fl_positioner_xbounds); - - procedure fl_positioner_xstep - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_xstep, "fl_positioner_xstep"); - pragma Inline (fl_positioner_xstep); - - function fl_positioner_get_xminimum - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_xminimum, "fl_positioner_get_xminimum"); - pragma Inline (fl_positioner_get_xminimum); - - procedure fl_positioner_set_xminimum - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_set_xminimum, "fl_positioner_set_xminimum"); - pragma Inline (fl_positioner_set_xminimum); - - function fl_positioner_get_xmaximum - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_xmaximum, "fl_positioner_get_xmaximum"); - pragma Inline (fl_positioner_get_xmaximum); - - procedure fl_positioner_set_xmaximum - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_set_xmaximum, "fl_positioner_set_xmaximum"); - pragma Inline (fl_positioner_set_xmaximum); - - function fl_positioner_get_xvalue - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_xvalue, "fl_positioner_get_xvalue"); - pragma Inline (fl_positioner_get_xvalue); - - function fl_positioner_set_xvalue - (P : in Storage.Integer_Address; - V : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_positioner_set_xvalue, "fl_positioner_set_xvalue"); - pragma Inline (fl_positioner_set_xvalue); - - - - - procedure fl_positioner_ybounds - (P : in Storage.Integer_Address; - L, H : in Interfaces.C.double); - pragma Import (C, fl_positioner_ybounds, "fl_positioner_ybounds"); - pragma Inline (fl_positioner_ybounds); - - procedure fl_positioner_ystep - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_ystep, "fl_positioner_ystep"); - pragma Inline (fl_positioner_ystep); - - function fl_positioner_get_yminimum - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_yminimum, "fl_positioner_get_yminimum"); - pragma Inline (fl_positioner_get_yminimum); - - procedure fl_positioner_set_yminimum - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_set_yminimum, "fl_positioner_set_yminimum"); - pragma Inline (fl_positioner_set_yminimum); - - function fl_positioner_get_ymaximum - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_ymaximum, "fl_positioner_get_ymaximum"); - pragma Inline (fl_positioner_get_ymaximum); - - procedure fl_positioner_set_ymaximum - (P : in Storage.Integer_Address; - A : in Interfaces.C.double); - pragma Import (C, fl_positioner_set_ymaximum, "fl_positioner_set_ymaximum"); - pragma Inline (fl_positioner_set_ymaximum); - - function fl_positioner_get_yvalue - (P : in Storage.Integer_Address) - return Interfaces.C.double; - pragma Import (C, fl_positioner_get_yvalue, "fl_positioner_get_yvalue"); - pragma Inline (fl_positioner_get_yvalue); - - function fl_positioner_set_yvalue - (P : in Storage.Integer_Address; - V : in Interfaces.C.double) - return Interfaces.C.int; - pragma Import (C, fl_positioner_set_yvalue, "fl_positioner_set_yvalue"); - pragma Inline (fl_positioner_set_yvalue); - - - - - procedure fl_positioner_draw - (P : in Storage.Integer_Address); - pragma Import (C, fl_positioner_draw, "fl_positioner_draw"); - pragma Inline (fl_positioner_draw); - - procedure fl_positioner_draw2 - (P : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_positioner_draw2, "fl_positioner_draw2"); - pragma Inline (fl_positioner_draw2); - - function fl_positioner_handle - (P : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_positioner_handle, "fl_positioner_handle"); - pragma Inline (fl_positioner_handle); - - function fl_positioner_handle2 - (P : in Storage.Integer_Address; - E, X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_positioner_handle2, "fl_positioner_handle2"); - pragma Inline (fl_positioner_handle2); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Positioner) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Positioner) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_positioner (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Positioner; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Positioner) is - begin - This.Draw_Ptr := fl_positioner_draw'Address; - This.Handle_Ptr := fl_positioner_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Positioner is - begin - return This : Positioner do - This.Void_Ptr := new_fl_positioner - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Get_Coords - (This : in Positioner; - X, Y : out Long_Float) is - begin - X := This.Get_Ecks; - Y := This.Get_Why; - end Get_Coords; - - - procedure Set_Coords - (This : in out Positioner; - X, Y : in Long_Float) - is - Result : Interfaces.C.int := fl_positioner_set_value - (This.Void_Ptr, - Interfaces.C.double (X), - Interfaces.C.double (Y)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Coords; - - - function Set_Coords - (This : in out Positioner; - X, Y : in Long_Float) - return Boolean - is - Result : Interfaces.C.int := fl_positioner_set_value - (This.Void_Ptr, - Interfaces.C.double (X), - Interfaces.C.double (Y)); - begin - return Boolean'Val (Result); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Set_Coords; - - - - - procedure Set_Ecks_Bounds - (This : in out Positioner; - Low, High : in Long_Float) is - begin - fl_positioner_xbounds - (This.Void_Ptr, - Interfaces.C.double (Low), - Interfaces.C.double (High)); - end Set_Ecks_Bounds; - - - procedure Set_Ecks_Step - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_xstep (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Ecks_Step; - - - function Get_Ecks_Minimum - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_xminimum (This.Void_Ptr)); - end Get_Ecks_Minimum; - - - procedure Set_Ecks_Minimum - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_set_xminimum (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Ecks_Minimum; - - - function Get_Ecks_Maximum - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_xmaximum (This.Void_Ptr)); - end Get_Ecks_Maximum; - - - procedure Set_Ecks_Maximum - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_set_xmaximum (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Ecks_Maximum; - - - function Get_Ecks - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_xvalue (This.Void_Ptr)); - end Get_Ecks; - - - procedure Set_Ecks - (This : in out Positioner; - Value : in Long_Float) - is - Result : Interfaces.C.int := fl_positioner_set_xvalue - (This.Void_Ptr, - Interfaces.C.double (Value)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Ecks; - - - function Set_Ecks - (This : in out Positioner; - Value : in Long_Float) - return Boolean - is - Result : Interfaces.C.int := fl_positioner_set_xvalue - (This.Void_Ptr, - Interfaces.C.double (Value)); - begin - return Boolean'Val (Result); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Set_Ecks; - - - - - procedure Set_Why_Bounds - (This : in out Positioner; - Low, High : in Long_Float) is - begin - fl_positioner_ybounds - (This.Void_Ptr, - Interfaces.C.double (Low), - Interfaces.C.double (High)); - end Set_Why_Bounds; - - - procedure Set_Why_Step - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_ystep (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Why_Step; - - - function Get_Why_Minimum - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_yminimum (This.Void_Ptr)); - end Get_Why_Minimum; - - - procedure Set_Why_Minimum - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_set_yminimum (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Why_Minimum; - - - function Get_Why_Maximum - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_ymaximum (This.Void_Ptr)); - end Get_Why_Maximum; - - - procedure Set_Why_Maximum - (This : in out Positioner; - Value : in Long_Float) is - begin - fl_positioner_set_ymaximum (This.Void_Ptr, Interfaces.C.double (Value)); - end Set_Why_Maximum; - - - function Get_Why - (This : in Positioner) - return Long_Float is - begin - return Long_Float (fl_positioner_get_yvalue (This.Void_Ptr)); - end Get_Why; - - - procedure Set_Why - (This : in out Positioner; - Value : in Long_Float) - is - Result : Interfaces.C.int := fl_positioner_set_yvalue - (This.Void_Ptr, - Interfaces.C.double (Value)); - begin - pragma Assert (Result in 0 .. 1); - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Set_Why; - - - function Set_Why - (This : in out Positioner; - Value : in Long_Float) - return Boolean - is - Result : Interfaces.C.int := fl_positioner_set_yvalue - (This.Void_Ptr, - Interfaces.C.double (Value)); - begin - return Boolean'Val (Result); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Set_Why; - - - - - procedure Draw - (This : in out Positioner) is - begin - Widget (This).Draw; - end Draw; - - - procedure Draw - (This : in out Positioner; - X, Y, W, H : in Integer) is - begin - fl_positioner_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 Positioner; - Event : in Event_Kind) - return Event_Outcome is - begin - return Widget (This).Handle (Event); - end Handle; - - - function Handle - (This : in out Positioner; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome is - begin - return Event_Outcome'Val (fl_positioner_handle2 - (This.Void_Ptr, - Event_Kind'Pos (Event), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H))); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Handle; - - -end FLTK.Widgets.Positioners; - - diff --git a/src/fltk-widgets-positioners.ads b/src/fltk-widgets-positioners.ads deleted file mode 100644 index 1da99b9..0000000 --- a/src/fltk-widgets-positioners.ads +++ /dev/null @@ -1,194 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Positioners is - - - type Positioner is new Widget with private; - - type Positioner_Reference (Data : not null access Positioner'Class) is limited null record - with Implicit_Dereference => Data; - - - - - package Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Positioner; - - end Forge; - - - - - procedure Get_Coords - (This : in Positioner; - X, Y : out Long_Float); - - procedure Set_Coords - (This : in out Positioner; - X, Y : in Long_Float); - - function Set_Coords - (This : in out Positioner; - X, Y : in Long_Float) - return Boolean; - - - - - procedure Set_Ecks_Bounds - (This : in out Positioner; - Low, High : in Long_Float); - - procedure Set_Ecks_Step - (This : in out Positioner; - Value : in Long_Float); - - function Get_Ecks_Minimum - (This : in Positioner) - return Long_Float; - - procedure Set_Ecks_Minimum - (This : in out Positioner; - Value : in Long_Float); - - function Get_Ecks_Maximum - (This : in Positioner) - return Long_Float; - - procedure Set_Ecks_Maximum - (This : in out Positioner; - Value : in Long_Float); - - function Get_Ecks - (This : in Positioner) - return Long_Float; - - procedure Set_Ecks - (This : in out Positioner; - Value : in Long_Float); - - function Set_Ecks - (This : in out Positioner; - Value : in Long_Float) - return Boolean; - - - - - procedure Set_Why_Bounds - (This : in out Positioner; - Low, High : in Long_Float); - - procedure Set_Why_Step - (This : in out Positioner; - Value : in Long_Float); - - function Get_Why_Minimum - (This : in Positioner) - return Long_Float; - - procedure Set_Why_Minimum - (This : in out Positioner; - Value : in Long_Float); - - function Get_Why_Maximum - (This : in Positioner) - return Long_Float; - - procedure Set_Why_Maximum - (This : in out Positioner; - Value : in Long_Float); - - function Get_Why - (This : in Positioner) - return Long_Float; - - procedure Set_Why - (This : in out Positioner; - Value : in Long_Float); - - function Set_Why - (This : in out Positioner; - Value : in Long_Float) - return Boolean; - - - - - procedure Draw - (This : in out Positioner); - - procedure Draw - (This : in out Positioner; - X, Y, W, H : in Integer); - - function Handle - (This : in out Positioner; - Event : in Event_Kind) - return Event_Outcome; - - function Handle - (This : in out Positioner; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome; - - -private - - - type Positioner is new Widget with null record; - - overriding procedure Initialize - (This : in out Positioner); - - overriding procedure Finalize - (This : in out Positioner); - - procedure Extra_Init - (This : in out Positioner; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Positioner) - with Inline; - - - pragma Inline (Get_Coords); - pragma Inline (Set_Coords); - - pragma Inline (Set_Ecks_Bounds); - pragma Inline (Set_Ecks_Step); - pragma Inline (Get_Ecks_Minimum); - pragma Inline (Set_Ecks_Minimum); - pragma Inline (Get_Ecks_Maximum); - pragma Inline (Set_Ecks_Maximum); - pragma Inline (Get_Ecks); - pragma Inline (Set_Ecks); - - pragma Inline (Set_Why_Bounds); - pragma Inline (Set_Why_Step); - pragma Inline (Get_Why_Minimum); - pragma Inline (Set_Why_Minimum); - pragma Inline (Get_Why_Maximum); - pragma Inline (Set_Why_Maximum); - pragma Inline (Get_Why); - pragma Inline (Set_Why); - - pragma Inline (Draw); - pragma Inline (Handle); - - -end FLTK.Widgets.Positioners; - - diff --git a/src/fltk-widgets-progress_bars.adb b/src/fltk-widgets-progress_bars.adb deleted file mode 100644 index 7e25c85..0000000 --- a/src/fltk-widgets-progress_bars.adb +++ /dev/null @@ -1,219 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Progress_Bars is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_progress - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_progress, "new_fl_progress"); - pragma Inline (new_fl_progress); - - procedure free_fl_progress - (P : in Storage.Integer_Address); - pragma Import (C, free_fl_progress, "free_fl_progress"); - pragma Inline (free_fl_progress); - - - - - function fl_progress_get_minimum - (P : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_progress_draw, "fl_progress_draw"); - pragma Inline (fl_progress_draw); - - function fl_progress_handle - (P : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_progress_handle, "fl_progress_handle"); - pragma Inline (fl_progress_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Progress_Bar) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Progress_Bar) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_progress (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Progress_Bar; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Progress_Bar) is - begin - This.Draw_Ptr := fl_progress_draw'Address; - This.Handle_Ptr := fl_progress_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Widget (This).Draw; - end Draw; - - -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 71b0b92..0000000 --- a/src/fltk-widgets-progress_bars.ads +++ /dev/null @@ -1,95 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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); - - -private - - - type Progress_Bar is new Widget with null record; - - overriding procedure Initialize - (This : in out Progress_Bar); - - overriding procedure Finalize - (This : in out Progress_Bar); - - procedure Extra_Init - (This : in out Progress_Bar; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Progress_Bar) - with Inline; - - - 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); - - -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 b4a8bc3..0000000 --- a/src/fltk-widgets-valuators-adjusters.adb +++ /dev/null @@ -1,188 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Valuators.Adjusters is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_adjuster - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_adjuster, "new_fl_adjuster"); - pragma Inline (new_fl_adjuster); - - procedure free_fl_adjuster - (A : in Storage.Integer_Address); - pragma Import (C, free_fl_adjuster, "free_fl_adjuster"); - pragma Inline (free_fl_adjuster); - - - - - function fl_adjuster_is_soft - (A : in Storage.Integer_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 Storage.Integer_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_value_damage - (A : in Storage.Integer_Address); - pragma Import (C, fl_adjuster_value_damage, "fl_adjuster_value_damage"); - pragma Inline (fl_adjuster_value_damage); - - procedure fl_adjuster_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_adjuster_draw, "fl_adjuster_draw"); - pragma Inline (fl_adjuster_draw); - - function fl_adjuster_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_adjuster_handle, "fl_adjuster_handle"); - pragma Inline (fl_adjuster_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Adjuster) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Adjuster) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_adjuster (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Adjuster; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Adjuster) is - begin - This.Draw_Ptr := fl_adjuster_draw'Address; - This.Handle_Ptr := fl_adjuster_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 Value_Damage - (This : in out Adjuster) is - begin - fl_adjuster_value_damage (This.Void_Ptr); - end Value_Damage; - - - procedure Draw - (This : in out Adjuster) is - begin - Valuator (This).Draw; - end Draw; - - - function Handle - (This : in out Adjuster; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (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 6211e99..0000000 --- a/src/fltk-widgets-valuators-adjusters.ads +++ /dev/null @@ -1,85 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Value_Damage - (This : in out Adjuster); - - 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 Initialize - (This : in out Adjuster); - - overriding procedure Finalize - (This : in out Adjuster); - - procedure Extra_Init - (This : in out Adjuster; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Adjuster) - with Inline; - - - pragma Inline (Is_Soft); - pragma Inline (Set_Soft); - - pragma Inline (Value_Damage); - 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 294a076..0000000 --- a/src/fltk-widgets-valuators-counters-simple.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Counters.Simple is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_simple_counter - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Simple_Counter) is - begin - Extra_Final (Counter (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Simple_Counter) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_simple_counter (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Simple_Counter; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Counter (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Simple_Counter) is - begin - This.Draw_Ptr := fl_simple_counter_draw'Address; - This.Handle_Ptr := fl_simple_counter_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 9ff57fe..0000000 --- a/src/fltk-widgets-valuators-counters-simple.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Simple_Counter is new Counter with null record; - - overriding procedure Initialize - (This : in out Simple_Counter); - - overriding procedure Finalize - (This : in out Simple_Counter); - - procedure Extra_Init - (This : in out Simple_Counter; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Simple_Counter) - with Inline; - - -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 30001a8..0000000 --- a/src/fltk-widgets-valuators-counters.adb +++ /dev/null @@ -1,301 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Counters is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_counter - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_counter, "new_fl_counter"); - pragma Inline (new_fl_counter); - - procedure free_fl_counter - (A : in Storage.Integer_Address); - pragma Import (C, free_fl_counter, "free_fl_counter"); - pragma Inline (free_fl_counter); - - - - - function fl_counter_get_step - (C : in Storage.Integer_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_top - (C : in Storage.Integer_Address; - T : in Interfaces.C.double); - pragma Import (C, fl_counter_set_step_top, "fl_counter_set_step_top"); - pragma Inline (fl_counter_set_step_top); - - procedure fl_counter_set_lstep - (C : in Storage.Integer_Address; - T : in Interfaces.C.double); - pragma Import (C, fl_counter_set_lstep, "fl_counter_set_lstep"); - pragma Inline (fl_counter_set_lstep); - - procedure fl_counter_set_step_both - (C : in Storage.Integer_Address; - S, L : in Interfaces.C.double); - pragma Import (C, fl_counter_set_step_both, "fl_counter_set_step_both"); - pragma Inline (fl_counter_set_step_both); - - - - - function fl_counter_get_textcolor - (C : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_counter_draw, "fl_counter_draw"); - pragma Inline (fl_counter_draw); - - function fl_counter_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_counter_handle, "fl_counter_handle"); - pragma Inline (fl_counter_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Counter) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Counter) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_counter (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Counter; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Counter) is - begin - This.Draw_Ptr := fl_counter_draw'Address; - This.Handle_Ptr := fl_counter_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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_Top - (This : in out Counter; - To : in Long_Float) is - begin - fl_counter_set_step_top (This.Void_Ptr, Interfaces.C.double (To)); - end Set_Step_Top; - - - 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; - - - procedure Set_Step_Both - (This : in out Counter; - Short, Long : in Long_Float) is - begin - fl_counter_set_step_both - (This.Void_Ptr, - Interfaces.C.double (Short), - Interfaces.C.double (Long)); - end Set_Step_Both; - - - - - 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 - Valuator (This).Draw; - end Draw; - - - function Handle - (This : in out Counter; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (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 0b2b31c..0000000 --- a/src/fltk-widgets-valuators-counters.ads +++ /dev/null @@ -1,133 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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_Top - (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); - - procedure Set_Step_Both - (This : in out Counter; - Short, Long : 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 Initialize - (This : in out Counter); - - overriding procedure Finalize - (This : in out Counter); - - procedure Extra_Init - (This : in out Counter; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Counter) - with Inline; - - - 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 9b01946..0000000 --- a/src/fltk-widgets-valuators-dials-fill.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Dials.Fill is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_fill_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Fill_Dial) is - begin - Extra_Final (Dial (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Fill_Dial) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_fill_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Fill_Dial; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Dial (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Fill_Dial) is - begin - This.Draw_Ptr := fl_fill_dial_draw'Address; - This.Handle_Ptr := fl_fill_dial_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 a09582e..0000000 --- a/src/fltk-widgets-valuators-dials-fill.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Fill_Dial is new Dial with null record; - - overriding procedure Initialize - (This : in out Fill_Dial); - - overriding procedure Finalize - (This : in out Fill_Dial); - - procedure Extra_Init - (This : in out Fill_Dial; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Fill_Dial) - with Inline; - - -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 16f9bef..0000000 --- a/src/fltk-widgets-valuators-dials-line.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Dials.Line is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_line_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Line_Dial) is - begin - Extra_Final (Dial (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Line_Dial) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_line_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Line_Dial; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Dial (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Line_Dial) is - begin - This.Draw_Ptr := fl_line_dial_draw'Address; - This.Handle_Ptr := fl_line_dial_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 be8f554..0000000 --- a/src/fltk-widgets-valuators-dials-line.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Line_Dial is new Dial with null record; - - overriding procedure Initialize - (This : in out Line_Dial); - - overriding procedure Finalize - (This : in out Line_Dial); - - procedure Extra_Init - (This : in out Line_Dial; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Line_Dial) - with Inline; - - -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 02106f1..0000000 --- a/src/fltk-widgets-valuators-dials.adb +++ /dev/null @@ -1,302 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Dials is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_dial - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_dial, "new_fl_dial"); - pragma Inline (new_fl_dial); - - procedure free_fl_dial - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_dial, "free_fl_dial"); - pragma Inline (free_fl_dial); - - - - - function fl_dial_get_angle1 - (D : in Storage.Integer_Address) - return Interfaces.C.short; - pragma Import (C, fl_dial_get_angle1, "fl_dial_get_angle1"); - pragma Inline (fl_dial_get_angle1); - - procedure fl_dial_set_angle1 - (D : in Storage.Integer_Address; - T : in Interfaces.C.short); - pragma Import (C, fl_dial_set_angle1, "fl_dial_set_angle1"); - pragma Inline (fl_dial_set_angle1); - - function fl_dial_get_angle2 - (D : in Storage.Integer_Address) - return Interfaces.C.short; - pragma Import (C, fl_dial_get_angle2, "fl_dial_get_angle2"); - pragma Inline (fl_dial_get_angle2); - - procedure fl_dial_set_angle2 - (D : in Storage.Integer_Address; - T : in Interfaces.C.short); - pragma Import (C, fl_dial_set_angle2, "fl_dial_set_angle2"); - pragma Inline (fl_dial_set_angle2); - - procedure fl_dial_set_angles - (D : in Storage.Integer_Address; - A, B : in Interfaces.C.short); - pragma Import (C, fl_dial_set_angles, "fl_dial_set_angles"); - pragma Inline (fl_dial_set_angles); - - - - - procedure fl_dial_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_dial_draw, "fl_dial_draw"); - pragma Inline (fl_dial_draw); - - procedure fl_dial_draw2 - (D : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_dial_draw2, "fl_dial_draw2"); - pragma Inline (fl_dial_draw2); - - function fl_dial_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_dial_handle, "fl_dial_handle"); - pragma Inline (fl_dial_handle); - - function fl_dial_handle2 - (D : in Storage.Integer_Address; - E, X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_dial_handle2, "fl_dial_handle2"); - pragma Inline (fl_dial_handle2); - - - - - function fl_widget_get_type - (D : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_widget_get_type, "fl_widget_get_type"); - pragma Inline (fl_widget_get_type); - - procedure fl_widget_set_type - (D : in Storage.Integer_Address; - T : in Interfaces.C.unsigned_char); - pragma Import (C, fl_widget_set_type, "fl_widget_set_type"); - pragma Inline (fl_widget_set_type); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Dial) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Dial) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Dial; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Dial) is - begin - This.Draw_Ptr := fl_dial_draw'Address; - This.Handle_Ptr := fl_dial_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - function Get_First_Angle - (This : in Dial) - return Short_Integer is - begin - return Short_Integer (fl_dial_get_angle1 (This.Void_Ptr)); - end Get_First_Angle; - - - procedure Set_First_Angle - (This : in out Dial; - To : in Short_Integer) is - begin - fl_dial_set_angle1 (This.Void_Ptr, Interfaces.C.short (To)); - end Set_First_Angle; - - - function Get_Second_Angle - (This : in Dial) - return Short_Integer is - begin - return Short_Integer (fl_dial_get_angle2 (This.Void_Ptr)); - end Get_Second_Angle; - - - procedure Set_Second_Angle - (This : in out Dial; - To : in Short_Integer) is - begin - fl_dial_set_angle2 (This.Void_Ptr, Interfaces.C.short (To)); - end Set_Second_Angle; - - - procedure Set_Angles - (This : in out Dial; - One, Two : in Short_Integer) is - begin - fl_dial_set_angles - (This.Void_Ptr, - Interfaces.C.short (One), - Interfaces.C.short (Two)); - end Set_Angles; - - - - - procedure Draw - (This : in out Dial) is - begin - Valuator (This).Draw; - end Draw; - - - procedure Draw - (This : in out Dial; - X, Y, W, H : in Integer) is - begin - fl_dial_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 Dial; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (Event); - end Handle; - - - function Handle - (This : in out Dial; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome is - begin - return Event_Outcome'Val (fl_dial_handle2 - (This.Void_Ptr, - Event_Kind'Pos (Event), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H))); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Handle; - - - - - function Get_Dial_Type - (This : in Dial) - return Dial_Kind is - begin - return Dial_Kind'Val (fl_widget_get_type (This.Void_Ptr)); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Dial_Type; - - - package body Extra is - - procedure Set_Dial_Type - (This : in out Dial; - To : in Dial_Kind) is - begin - fl_widget_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 f3c2b69..0000000 --- a/src/fltk-widgets-valuators-dials.ads +++ /dev/null @@ -1,125 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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_First_Angle - (This : in Dial) - return Short_Integer; - - procedure Set_First_Angle - (This : in out Dial; - To : in Short_Integer); - - function Get_Second_Angle - (This : in Dial) - return Short_Integer; - - procedure Set_Second_Angle - (This : in out Dial; - To : in Short_Integer); - - procedure Set_Angles - (This : in out Dial; - One, Two : in Short_Integer); - - - - - procedure Draw - (This : in out Dial); - - procedure Draw - (This : in out Dial; - X, Y, W, H : in Integer); - - function Handle - (This : in out Dial; - Event : in Event_Kind) - return Event_Outcome; - - function Handle - (This : in out Dial; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome; - - - - - function Get_Dial_Type - (This : in Dial) - return Dial_Kind; - - 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 Initialize - (This : in out Dial); - - overriding procedure Finalize - (This : in out Dial); - - procedure Extra_Init - (This : in out Dial; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Dial) - with Inline; - - - 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); - - pragma Inline (Get_Dial_Type); - - -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 a3966e5..0000000 --- a/src/fltk-widgets-valuators-rollers.adb +++ /dev/null @@ -1,139 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Rollers is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_roller - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_roller, "new_fl_roller"); - pragma Inline (new_fl_roller); - - procedure free_fl_roller - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_roller, "free_fl_roller"); - pragma Inline (free_fl_roller); - - - - - procedure fl_roller_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_roller_draw, "fl_roller_draw"); - pragma Inline (fl_roller_draw); - - function fl_roller_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_roller_handle, "fl_roller_handle"); - pragma Inline (fl_roller_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Roller) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Roller) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_roller (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Roller; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Roller) is - begin - This.Draw_Ptr := fl_roller_draw'Address; - This.Handle_Ptr := fl_roller_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure Draw - (This : in out Roller) is - begin - Valuator (This).Draw; - end Draw; - - - function Handle - (This : in out Roller; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (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 aa9a9a5..0000000 --- a/src/fltk-widgets-valuators-rollers.ads +++ /dev/null @@ -1,67 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Roller); - - overriding procedure Finalize - (This : in out Roller); - - procedure Extra_Init - (This : in out Roller; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Roller) - with Inline; - - - 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 504e390..0000000 --- a/src/fltk-widgets-valuators-sliders-fill.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Fill is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_fill_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Fill_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Fill_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_fill_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Fill_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Fill_Slider) is - begin - This.Draw_Ptr := fl_fill_slider_draw'Address; - This.Handle_Ptr := fl_fill_slider_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 d13e604..0000000 --- a/src/fltk-widgets-valuators-sliders-fill.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Fill_Slider is new Slider with null record; - - overriding procedure Initialize - (This : in out Fill_Slider); - - overriding procedure Finalize - (This : in out Fill_Slider); - - procedure Extra_Init - (This : in out Fill_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Fill_Slider) - with Inline; - - -end FLTK.Widgets.Valuators.Sliders.Fill; - - diff --git a/src/fltk-widgets-valuators-sliders-horizontal.adb b/src/fltk-widgets-valuators-sliders-horizontal.adb deleted file mode 100644 index 1abde1b..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Horizontal is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_horizontal_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Horizontal_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Horizontal_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_horizontal_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Horizontal_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Horizontal_Slider) is - begin - This.Draw_Ptr := fl_horizontal_slider_draw'Address; - This.Handle_Ptr := fl_horizontal_slider_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 3002f31..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Horizontal_Slider is new Slider with null record; - - overriding procedure Initialize - (This : in out Horizontal_Slider); - - overriding procedure Finalize - (This : in out Horizontal_Slider); - - procedure Extra_Init - (This : in out Horizontal_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Horizontal_Slider) - with Inline; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal; - - diff --git a/src/fltk-widgets-valuators-sliders-horizontal_fill.adb b/src/fltk-widgets-valuators-sliders-horizontal_fill.adb deleted file mode 100644 index 2376474..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal_fill.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Horizontal_Fill is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_hor_fill_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Horizontal_Fill_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Horizontal_Fill_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_hor_fill_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Horizontal_Fill_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Horizontal_Fill_Slider) is - begin - This.Draw_Ptr := fl_hor_fill_slider_draw'Address; - This.Handle_Ptr := fl_hor_fill_slider_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Horizontal_Fill_Slider is - begin - return This : Horizontal_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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal_Fill; - - diff --git a/src/fltk-widgets-valuators-sliders-horizontal_fill.ads b/src/fltk-widgets-valuators-sliders-horizontal_fill.ads deleted file mode 100644 index e6e8938..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal_fill.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Valuators.Sliders.Horizontal_Fill is - - - type Horizontal_Fill_Slider is new Slider with private; - - type Horizontal_Fill_Slider_Reference (Data : not null access Horizontal_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 Horizontal_Fill_Slider; - - end Forge; - - -private - - - type Horizontal_Fill_Slider is new Slider with null record; - - overriding procedure Initialize - (This : in out Horizontal_Fill_Slider); - - overriding procedure Finalize - (This : in out Horizontal_Fill_Slider); - - procedure Extra_Init - (This : in out Horizontal_Fill_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Horizontal_Fill_Slider) - with Inline; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal_Fill; - - diff --git a/src/fltk-widgets-valuators-sliders-horizontal_nice.adb b/src/fltk-widgets-valuators-sliders-horizontal_nice.adb deleted file mode 100644 index d0a8fa8..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal_nice.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Horizontal_Nice is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_hor_nice_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Horizontal_Nice_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Horizontal_Nice_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_hor_nice_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Horizontal_Nice_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Horizontal_Nice_Slider) is - begin - This.Draw_Ptr := fl_hor_nice_slider_draw'Address; - This.Handle_Ptr := fl_hor_nice_slider_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Horizontal_Nice_Slider is - begin - return This : Horizontal_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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal_Nice; - - diff --git a/src/fltk-widgets-valuators-sliders-horizontal_nice.ads b/src/fltk-widgets-valuators-sliders-horizontal_nice.ads deleted file mode 100644 index a71d8f2..0000000 --- a/src/fltk-widgets-valuators-sliders-horizontal_nice.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Valuators.Sliders.Horizontal_Nice is - - - type Horizontal_Nice_Slider is new Slider with private; - - type Horizontal_Nice_Slider_Reference (Data : not null access Horizontal_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 Horizontal_Nice_Slider; - - end Forge; - - -private - - - type Horizontal_Nice_Slider is new Slider with null record; - - overriding procedure Initialize - (This : in out Horizontal_Nice_Slider); - - overriding procedure Finalize - (This : in out Horizontal_Nice_Slider); - - procedure Extra_Init - (This : in out Horizontal_Nice_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Horizontal_Nice_Slider) - with Inline; - - -end FLTK.Widgets.Valuators.Sliders.Horizontal_Nice; - - diff --git a/src/fltk-widgets-valuators-sliders-nice.adb b/src/fltk-widgets-valuators-sliders-nice.adb deleted file mode 100644 index ba99a62..0000000 --- a/src/fltk-widgets-valuators-sliders-nice.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Nice is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_nice_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Nice_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Nice_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_nice_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Nice_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Nice_Slider) is - begin - This.Draw_Ptr := fl_nice_slider_draw'Address; - This.Handle_Ptr := fl_nice_slider_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 c835ccf..0000000 --- a/src/fltk-widgets-valuators-sliders-nice.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - -private - - - type Nice_Slider is new Slider with null record; - - overriding procedure Initialize - (This : in out Nice_Slider); - - overriding procedure Finalize - (This : in out Nice_Slider); - - procedure Extra_Init - (This : in out Nice_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Nice_Slider) - with Inline; - - -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 d27c4fa..0000000 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ /dev/null @@ -1,262 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Scrollbars is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_scrollbar - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_scrollbar, "new_fl_scrollbar"); - pragma Inline (new_fl_scrollbar); - - procedure free_fl_scrollbar - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_scrollbar, "free_fl_scrollbar"); - pragma Inline (free_fl_scrollbar); - - - - - function fl_scrollbar_get_linesize - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_scrollbar_draw, "fl_scrollbar_draw"); - pragma Inline (fl_scrollbar_draw); - - function fl_scrollbar_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_scrollbar_handle, "fl_scrollbar_handle"); - pragma Inline (fl_scrollbar_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- End of the line - procedure scrollbar_extra_final_hook - (Ada_Obj : in Storage.Integer_Address); - pragma Export (C, scrollbar_extra_final_hook, "scrollbar_extra_final_hook"); - - procedure scrollbar_extra_final_hook - (Ada_Obj : in Storage.Integer_Address) - is - My_Scrollbar : Scrollbar; - for My_Scrollbar'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Scrollbar); - begin - Extra_Final (My_Scrollbar); - end scrollbar_extra_final_hook; - - - procedure Extra_Final - (This : in out Scrollbar) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Scrollbar) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_scrollbar (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Radio signal successfully intercepted - procedure scrollbar_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr); - pragma Export (C, scrollbar_extra_init_hook, "scrollbar_extra_init_hook"); - - procedure scrollbar_extra_init_hook - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.Strings.chars_ptr) - is - My_Scrollbar : Scrollbar; - for My_Scrollbar'Address use Storage.To_Address (Ada_Obj); - pragma Import (Ada, My_Scrollbar); - begin - Extra_Init - (My_Scrollbar, - Integer (X), Integer (Y), - Integer (W), Integer (H), - Interfaces.C.Strings.Value (C_Str)); - end scrollbar_extra_init_hook; - - - procedure Extra_Init - (This : in out Scrollbar; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Scrollbar) is - begin - This.Draw_Ptr := fl_scrollbar_draw'Address; - This.Handle_Ptr := fl_scrollbar_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Slider (This).Draw; - end Draw; - - - function Handle - (This : in out Scrollbar; - Event : in Event_Kind) - return Event_Outcome is - begin - return Slider (This).Handle (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 307e19b..0000000 --- a/src/fltk-widgets-valuators-sliders-scrollbars.ads +++ /dev/null @@ -1,99 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Scrollbar); - - overriding procedure Finalize - (This : in out Scrollbar); - - procedure Extra_Init - (This : in out Scrollbar; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Scrollbar) - with Inline; - - - 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 d60e46a..0000000 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.adb +++ /dev/null @@ -1,117 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_hor_value_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Horizontal_Value_Slider) is - begin - Extra_Final (Value_Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Horizontal_Value_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_hor_value_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Horizontal_Value_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Value_Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Horizontal_Value_Slider) is - begin - This.Draw_Ptr := fl_hor_value_slider_draw'Address; - This.Handle_Ptr := fl_hor_value_slider_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (X, Y, W, H : in Integer; - Text : in String := "") - return Horizontal_Value_Slider is - begin - return This : Horizontal_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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - -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 c666a4d..0000000 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.ads +++ /dev/null @@ -1,52 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -package FLTK.Widgets.Valuators.Sliders.Value.Horizontal is - - - type Horizontal_Value_Slider is new Value_Slider with private; - - type Horizontal_Value_Slider_Reference (Data : not null access Horizontal_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 Horizontal_Value_Slider; - - end Forge; - - -private - - - type Horizontal_Value_Slider is new Value_Slider with null record; - - overriding procedure Initialize - (This : in out Horizontal_Value_Slider); - - overriding procedure Finalize - (This : in out Horizontal_Value_Slider); - - procedure Extra_Init - (This : in out Horizontal_Value_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Horizontal_Value_Slider) - with Inline; - - -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 54188b3..0000000 --- a/src/fltk-widgets-valuators-sliders-value.adb +++ /dev/null @@ -1,228 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders.Value is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_value_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Value_Slider) is - begin - Extra_Final (Slider (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Value_Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_value_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Value_Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Slider (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Value_Slider) is - begin - This.Draw_Ptr := fl_value_slider_draw'Address; - This.Handle_Ptr := fl_value_slider_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Slider (This).Draw; - end Draw; - - - function Handle - (This : in out Value_Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Slider (This).Handle (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 ac49524..0000000 --- a/src/fltk-widgets-valuators-sliders-value.ads +++ /dev/null @@ -1,101 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Value_Slider); - - overriding procedure Finalize - (This : in out Value_Slider); - - procedure Extra_Init - (This : in out Value_Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Value_Slider) - with Inline; - - - 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 bac5378..0000000 --- a/src/fltk-widgets-valuators-sliders.adb +++ /dev/null @@ -1,352 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators.Sliders is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_slider - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_slider, "new_fl_slider"); - pragma Inline (new_fl_slider); - - function new_fl_slider2 - (K : in Interfaces.C.unsigned_char; - X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_slider2, "new_fl_slider2"); - pragma Inline (new_fl_slider2); - - procedure free_fl_slider - (D : in Storage.Integer_Address); - pragma Import (C, free_fl_slider, "free_fl_slider"); - pragma Inline (free_fl_slider); - - - - - procedure fl_slider_set_bounds - (S : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - T : in Interfaces.C.double); - 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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_slider_draw, "fl_slider_draw"); - pragma Inline (fl_slider_draw); - - procedure fl_slider_draw2 - (S : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_slider_draw2, "fl_slider_draw2"); - pragma Inline (fl_slider_draw2); - - function fl_slider_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_slider_handle, "fl_slider_handle"); - pragma Inline (fl_slider_handle); - - function fl_slider_handle2 - (S : in Storage.Integer_Address; - E, X, Y, W, H : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_slider_handle2, "fl_slider_handle2"); - pragma Inline (fl_slider_handle2); - - - - - function fl_widget_get_type - (S : in Storage.Integer_Address) - return Interfaces.C.unsigned_char; - pragma Import (C, fl_widget_get_type, "fl_widget_get_type"); - pragma Inline (fl_widget_get_type); - - procedure fl_widget_set_type - (S : in Storage.Integer_Address; - T : in Interfaces.C.unsigned_char); - pragma Import (C, fl_widget_set_type, "fl_widget_set_type"); - pragma Inline (fl_widget_set_type); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Slider) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Slider) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Slider; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Slider) is - begin - This.Draw_Ptr := fl_slider_draw'Address; - This.Handle_Ptr := fl_slider_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - - function Create - (Kind : in Slider_Kind; - X, Y, W, H : in Integer; - Text : in String := "") - return Slider is - begin - return This : Slider do - This.Void_Ptr := new_fl_slider2 - (Slider_Kind'Pos (Kind), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - procedure 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 Long_Float) is - begin - fl_slider_set_slider_size (This.Void_Ptr, Interfaces.C.double (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 - Valuator (This).Draw; - end Draw; - - - procedure Draw - (This : in out Slider; - X, Y, W, H : in Integer) is - begin - fl_slider_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 Slider; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (Event); - end Handle; - - - function Handle - (This : in out Slider; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome is - begin - return Event_Outcome'Val (fl_slider_handle2 - (This.Void_Ptr, - Event_Kind'Pos (Event), - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H))); - end Handle; - - - - - function Get_Slider_Type - (This : in Slider) - return Slider_Kind is - begin - return Slider_Kind'Val (fl_widget_get_type (This.Void_Ptr)); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Get_Slider_Type; - - - package body Extra is - - procedure Set_Slider_Type - (This : in out Slider; - To : in Slider_Kind) is - begin - fl_widget_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 c89cb56..0000000 --- a/src/fltk-widgets-valuators-sliders.ads +++ /dev/null @@ -1,142 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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; - - function Create - (Kind : in Slider_Kind; - X, Y, W, H : in Integer; - Text : in String := "") - return Slider; - - end Forge; - - - - - 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 Long_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); - - procedure Draw - (This : in out Slider; - X, Y, W, H : in Integer); - - function Handle - (This : in out Slider; - Event : in Event_Kind) - return Event_Outcome; - - function Handle - (This : in out Slider; - Event : in Event_Kind; - X, Y, W, H : in Integer) - return Event_Outcome; - - - - - function Get_Slider_Type - (This : in Slider) - return Slider_Kind; - - 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 Initialize - (This : in out Slider); - - overriding procedure Finalize - (This : in out Slider); - - procedure Extra_Init - (This : in out Slider; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Slider) - with Inline; - - - 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); - - pragma Inline (Get_Slider_Type); - - -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 01f51bd..0000000 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ /dev/null @@ -1,404 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Valuators.Value_Inputs is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_value_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_resize - (TD : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int); - pragma Import (C, fl_value_input_resize, "fl_value_input_resize"); - pragma Inline (fl_value_input_resize); - - - - - procedure fl_value_input_draw - (W : in Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - -- Making a long distance telephone call - procedure fl_text_input_extra_final - (Ada_Obj : in Storage.Integer_Address); - pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final"); - pragma Inline (fl_text_input_extra_final); - - - procedure Extra_Final - (This : in out Value_Input) is - begin - fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address)); - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Value_Input) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_value_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - -- Black magic, don't try this at home kids - procedure fl_text_input_extra_init - (Ada_Obj : in Storage.Integer_Address; - X, Y, W, H : in Interfaces.C.int; - C_Str : in Interfaces.C.char_array); - pragma Import (C, fl_text_input_extra_init, "fl_text_input_extra_init"); - pragma Inline (fl_text_input_extra_init); - - - procedure Extra_Init - (This : in out Value_Input; - X, Y, W, H : in Integer; - Text : in String) is - begin - Wrapper (This.My_Input).Void_Ptr := fl_value_input_get_input (This.Void_Ptr); - Wrapper (This.My_Input).Needs_Dealloc := False; - fl_text_input_extra_init - (Storage.To_Integer (This.My_Input'Address), - Interfaces.C.int (This.My_Input.Get_X), - Interfaces.C.int (This.My_Input.Get_Y), - Interfaces.C.int (This.My_Input.Get_W), - Interfaces.C.int (This.My_Input.Get_H), - Interfaces.C.To_C (This.My_Input.Get_Label)); - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Value_Input) is - begin - This.Draw_Ptr := fl_value_input_draw'Address; - This.Handle_Ptr := fl_value_input_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ------------------ - -- Attributes -- - ------------------ - - function Text_Field - (This : in out Value_Input) - return FLTK.Widgets.Inputs.Text.Text_Input_Reference is - begin - return (Data => This.My_Input'Unchecked_Access); - end Text_Field; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 Resize - (This : in out Value_Input; - X, Y, W, H : in Integer) is - begin - fl_value_input_resize - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - procedure Draw - (This : in out Value_Input) is - begin - Valuator (This).Draw; - end Draw; - - - function Handle - (This : in out Value_Input; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (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 384d387..0000000 --- a/src/fltk-widgets-valuators-value_inputs.ads +++ /dev/null @@ -1,167 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Widgets.Inputs.Text; - - -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 Text_Field - (This : in out Value_Input) - return FLTK.Widgets.Inputs.Text.Text_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 Resize - (This : in out Value_Input; - X, Y, W, H : in Integer); - - - - - procedure Draw - (This : in out Value_Input); - - function Handle - (This : in out Value_Input; - Event : in Event_Kind) - return Event_Outcome; - - -private - - - type Value_Input is new Valuator with record - My_Input : aliased Inputs.Text.Text_Input; - end record; - - overriding procedure Initialize - (This : in out Value_Input); - - overriding procedure Finalize - (This : in out Value_Input); - - procedure Extra_Init - (This : in out Value_Input; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (This : in out Value_Input) - with Inline; - - - pragma Inline (Text_Field); - - 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 (Resize); - - 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 de6adf7..0000000 --- a/src/fltk-widgets-valuators-value_outputs.adb +++ /dev/null @@ -1,265 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - -use type - - Interfaces.C.int; - - -package body FLTK.Widgets.Valuators.Value_Outputs is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_value_output - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Value_Output) is - begin - Extra_Final (Valuator (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Value_Output) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_value_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Value_Output; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Valuator (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Value_Output) is - begin - This.Draw_Ptr := fl_value_output_draw'Address; - This.Handle_Ptr := fl_value_output_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 - Valuator (This).Draw; - end Draw; - - - function Handle - (This : in out Value_Output; - Event : in Event_Kind) - return Event_Outcome is - begin - return Valuator (This).Handle (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 c5e383d..0000000 --- a/src/fltk-widgets-valuators-value_outputs.ads +++ /dev/null @@ -1,115 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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 Initialize - (This : in out Value_Output); - - overriding procedure Finalize - (This : in out Value_Output); - - procedure Extra_Init - (This : in out Value_Output; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Value_Output) - with Inline; - - - 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 197111f..0000000 --- a/src/fltk-widgets-valuators.adb +++ /dev/null @@ -1,395 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C.Strings; - - -package body FLTK.Widgets.Valuators is - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_valuator - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_valuator, "new_fl_valuator"); - pragma Inline (new_fl_valuator); - - procedure free_fl_valuator - (V : in Storage.Integer_Address); - pragma Import (C, free_fl_valuator, "free_fl_valuator"); - pragma Inline (free_fl_valuator); - - - - - function fl_valuator_clamp - (V : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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_top - (V : in Storage.Integer_Address; - T : in Interfaces.C.double); - pragma Import (C, fl_valuator_set_step_top, "fl_valuator_set_step_top"); - pragma Inline (fl_valuator_set_step_top); - - procedure fl_valuator_set_step_bottom - (V : in Storage.Integer_Address; - B : in Interfaces.C.int); - pragma Import (C, fl_valuator_set_step_bottom, "fl_valuator_set_step_bottom"); - pragma Inline (fl_valuator_set_step_bottom); - - procedure fl_valuator_set_step - (V : in Storage.Integer_Address; - T : in Interfaces.C.double; - B : in Interfaces.C.int); - pragma Import (C, fl_valuator_set_step, "fl_valuator_set_step"); - pragma Inline (fl_valuator_set_step); - - function fl_valuator_get_value - (V : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address; - A, B : in Interfaces.C.double); - pragma Import (C, fl_valuator_range, "fl_valuator_range"); - pragma Inline (fl_valuator_range); - - - - - procedure fl_valuator_value_damage - (V : in Storage.Integer_Address); - pragma Import (C, fl_valuator_value_damage, "fl_valuator_value_damage"); - pragma Inline (fl_valuator_value_damage); - - procedure fl_valuator_draw - (V : in Storage.Integer_Address); - pragma Import (C, fl_valuator_draw, "fl_valuator_draw"); - pragma Inline (fl_valuator_draw); - - function fl_valuator_handle - (V : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_valuator_handle, "fl_valuator_handle"); - pragma Inline (fl_valuator_handle); - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Valuator) is - begin - Extra_Final (Widget (This)); - end Extra_Final; - - - procedure Finalize - (This : in out Valuator) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_valuator (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Valuator; - X, Y, W, H : in Integer; - Text : in String) is - begin - Extra_Init (Widget (This), X, Y, W, H, Text); - end Extra_Init; - - - procedure Initialize - (This : in out Valuator) is - begin - This.Draw_Ptr := fl_valuator_draw'Address; - This.Handle_Ptr := fl_valuator_handle'Address; - end Initialize; - - - 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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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_Top - (This : in out Valuator; - To : in Long_Float) is - begin - fl_valuator_set_step_top - (This.Void_Ptr, - Interfaces.C.double (To)); - end Set_Step_Top; - - - procedure Set_Step_Bottom - (This : in out Valuator; - To : in Integer) is - begin - fl_valuator_set_step_bottom - (This.Void_Ptr, - Interfaces.C.int (To)); - end Set_Step_Bottom; - - - procedure Set_Step - (This : in out Valuator; - Top : in Long_Float; - Bottom : in Integer) is - begin - fl_valuator_set_step - (This.Void_Ptr, - Interfaces.C.double (Top), - Interfaces.C.int (Bottom)); - 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; - - - - - procedure Value_Damage - (This : in out Valuator) is - begin - fl_valuator_value_damage (This.Void_Ptr); - end Value_Damage; - - -end FLTK.Widgets.Valuators; - - diff --git a/src/fltk-widgets-valuators.ads b/src/fltk-widgets-valuators.ads deleted file mode 100644 index 83df44f..0000000 --- a/src/fltk-widgets-valuators.ads +++ /dev/null @@ -1,154 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -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_Top - (This : in out Valuator; - To : in Long_Float); - - procedure Set_Step_Bottom - (This : in out Valuator; - To : in Integer); - - procedure Set_Step - (This : in out Valuator; - Top : in Long_Float; - Bottom : in Integer); - - 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); - - - - - procedure Value_Damage - (This : in out Valuator); - - -private - - - type Valuator is new Widget with null record; - - overriding procedure Initialize - (This : in out Valuator); - - overriding procedure Finalize - (This : in out Valuator); - - procedure Extra_Init - (This : in out Valuator; - X, Y, W, H : in Integer; - Text : in String) - with Inline; - - procedure Extra_Final - (This : in out Valuator) - with Inline; - - - 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_Top); - pragma Inline (Set_Step_Bottom); - 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 (Value_Damage); - - -end FLTK.Widgets.Valuators; - - diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb deleted file mode 100644 index beae56d..0000000 --- a/src/fltk-widgets.adb +++ /dev/null @@ -1,1262 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Assertions, - 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; - - -package body FLTK.Widgets is - - - package Chk renames Ada.Assertions; - - - 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); - - - - - ------------------------ - -- Functions From C -- - ------------------------ - - function new_fl_widget - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return Storage.Integer_Address; - pragma Import (C, new_fl_widget, "new_fl_widget"); - pragma Inline (new_fl_widget); - - procedure free_fl_widget - (F : in Storage.Integer_Address); - pragma Import (C, free_fl_widget, "free_fl_widget"); - pragma Inline (free_fl_widget); - - - - - procedure fl_widget_activate - (W : in Storage.Integer_Address); - pragma Import (C, fl_widget_activate, "fl_widget_activate"); - pragma Inline (fl_widget_activate); - - procedure fl_widget_deactivate - (W : in Storage.Integer_Address); - pragma Import (C, fl_widget_deactivate, "fl_widget_deactivate"); - pragma Inline (fl_widget_deactivate); - - function fl_widget_active - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_clear_active, "fl_widget_clear_active"); - pragma Inline (fl_widget_clear_active); - - - - - function fl_widget_changed - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_clear_changed, "fl_widget_clear_changed"); - pragma Inline (fl_widget_clear_changed); - - function fl_widget_output - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_clear_output, "fl_widget_clear_output"); - pragma Inline (fl_widget_clear_output); - - function fl_widget_visible - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_widget_window, "fl_widget_window"); - pragma Inline (fl_widget_window); - - function fl_widget_top_window - (W : in Storage.Integer_Address) - return Storage.Integer_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 Storage.Integer_Address; - X, Y : out Interfaces.C.int) - return Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_set_deimage, "fl_widget_set_deimage"); - pragma Inline (fl_widget_set_deimage); - - - - - function fl_widget_damage - (W : in Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_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 Storage.Integer_Address); - pragma Import (C, fl_widget_redraw, "fl_widget_redraw"); - pragma Inline (fl_widget_redraw); - - procedure fl_widget_redraw_label - (W : in Storage.Integer_Address); - pragma Import (C, fl_widget_redraw_label, "fl_widget_redraw_label"); - pragma Inline (fl_widget_redraw_label); - - - - - procedure fl_widget_draw - (W : in Storage.Integer_Address); - pragma Import (C, fl_widget_draw, "fl_widget_draw"); - pragma Inline (fl_widget_draw); - - function fl_widget_handle - (W : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_widget_handle, "fl_widget_handle"); - pragma Inline (fl_widget_handle); - - - - - ---------------------- - -- Exported Hooks -- - ---------------------- - - procedure Callback_Hook - (W, U : in Storage.Integer_Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (Storage.To_Address (U)); - begin - Ada_Widget.Callback.all (Ada_Widget.all); - end Callback_Hook; - - - procedure Draw_Hook - (U : in Storage.Integer_Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (Storage.To_Address (U)); - begin - Ada_Widget.Draw; - end Draw_Hook; - - - function Handle_Hook - (U : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (Storage.To_Address (U)); - begin - return Event_Outcome'Pos (Ada_Widget.Handle (Event_Kind'Val (E))); - end Handle_Hook; - - - - - ------------------- - -- Destructors -- - ------------------- - - procedure Extra_Final - (This : in out Widget) - is - Maybe_Parent : access FLTK.Widgets.Groups.Group'Class := This.Parent; - begin - if Maybe_Parent /= null then - Maybe_Parent.Remove (This); - end if; - end Extra_Final; - - - procedure Finalize - (This : in out Widget) is - begin - Extra_Final (This); - if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_widget (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; - end if; - end Finalize; - - - - - -------------------- - -- Constructors -- - -------------------- - - procedure Extra_Init - (This : in out Widget; - X, Y, W, H : in Integer; - Text : in String) is - begin - fl_widget_set_user_data - (This.Void_Ptr, - Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Extra_Init; - - - procedure Initialize - (This : in out Widget) is - begin - This.Draw_Ptr := fl_widget_draw'Address; - This.Handle_Ptr := fl_widget_handle'Address; - end Initialize; - - - package body Forge is - - function Create - (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)); - Extra_Init (This, X, Y, W, H, Text); - end return; - end Create; - - end Forge; - - - - - ----------------------- - -- API Subprograms -- - ----------------------- - - 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 : Storage.Integer_Address := fl_widget_get_parent (This.Void_Ptr); - Actual_Parent : access FLTK.Widgets.Groups.Group'Class; - begin - if Parent_Ptr /= Null_Pointer then - Parent_Ptr := fl_widget_get_user_data (Parent_Ptr); - pragma Assert (Parent_Ptr /= Null_Pointer); - Actual_Parent := Group_Convert.To_Pointer (Storage.To_Address (Parent_Ptr)); - end if; - return Actual_Parent; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 : Storage.Integer_Address := fl_widget_window (This.Void_Ptr); - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Window_Ptr /= Null_Pointer then - Window_Ptr := fl_widget_get_user_data (Window_Ptr); - pragma Assert (Window_Ptr /= Null_Pointer); - Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr)); - end if; - return Actual_Window; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - end Nearest_Window; - - - function Top_Window - (This : in Widget) - return access FLTK.Widgets.Groups.Windows.Window'Class - is - Window_Ptr : Storage.Integer_Address := fl_widget_top_window (This.Void_Ptr); - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Window_Ptr /= Null_Pointer then - Window_Ptr := fl_widget_get_user_data (Window_Ptr); - pragma Assert (Window_Ptr /= Null_Pointer); - Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr)); - end if; - return Actual_Window; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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 : Storage.Integer_Address := fl_widget_top_window_offset - (This.Void_Ptr, - Interfaces.C.int (Offset_X), - Interfaces.C.int (Offset_Y)); - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; - begin - if Window_Ptr /= Null_Pointer then - Window_Ptr := fl_widget_get_user_data (Window_Ptr); - pragma Assert (Window_Ptr /= Null_Pointer); - Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr)); - end if; - return Actual_Window; - exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; - 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, Storage.To_Integer (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 - (This : in out Widget) - is - procedure my_draw - (V : in Storage.Integer_Address); - for my_draw'Address use This.Draw_Ptr; - pragma Import (Ada, my_draw); - begin - my_draw (This.Void_Ptr); - end Draw; - - - procedure Draw_Label - (This : in Widget; - X, Y, W, H : in Integer; - 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 - function my_handle - (V : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - for my_handle'Address use This.Handle_Ptr; - pragma Import (Ada, my_handle); - begin - return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - exception - when Constraint_Error => raise Internal_FLTK_Error; - end Handle; - - -end FLTK.Widgets; - diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads deleted file mode 100644 index 5765196..0000000 --- a/src/fltk-widgets.ads +++ /dev/null @@ -1,513 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - FLTK.Images; - -limited with - - FLTK.Widgets.Groups.Windows; - -private with - - System.Address_To_Access_Conversions, - Interfaces.C, - FLTK.Widget_Callback_Conversions; - - -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); - - 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; - Draw_Ptr : System.Address; - Handle_Ptr : System.Address; - end record; - - overriding procedure Initialize - (This : in out Widget); - - overriding procedure Finalize - (This : in out Widget); - - -- Widgets that might cause problems for this setup in the future: - -- Menus (gets various Menu_Items added to it) - -- Groups.Text_Displays (gets a Text_Buffer attached) - -- Groups.Text_Displays.Text_Editors (also gets a Text_Buffer attached) - -- If weird Init/Final errors start mysteriously occuring then check there first. - - -- Extra_Init functionality is also duplicated in FLTK.File_Choosers - -- for reasons of hierarchy visibility. Really, the File_Chooser should be in - -- the Widget hierarchy like Color_Chooser but for some reason it isn't. - - procedure Extra_Init - (This : in out Widget; - X, Y, W, H : in Integer; - Text : in String); - - procedure Extra_Final - (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 Storage.Integer_Address); - pragma Export (C, Callback_Hook, "widget_callback_hook"); - - procedure Draw_Hook - (U : in Storage.Integer_Address); - pragma Export (C, Draw_Hook, "widget_draw_hook"); - - function Handle_Hook - (U : in Storage.Integer_Address; - E : in Interfaces.C.int) - return Interfaces.C.int; - pragma Export (C, Handle_Hook, "widget_handle_hook"); - - - package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); - package Callback_Convert renames FLTK.Widget_Callback_Conversions; - - - function fl_widget_get_user_data - (W : in Storage.Integer_Address) - return Storage.Integer_Address; - 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 Storage.Integer_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 Storage.Integer_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 3afb984..0000000 --- a/src/fltk.adb +++ /dev/null @@ -1,385 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Interfaces.C; - -use type - - Interfaces.C.int, - Interfaces.C.unsigned_long; - - -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 /= Null_Pointer; - end Is_Valid; - - - procedure Initialize - (This : in out Wrapper) is - begin - This.Void_Ptr := Null_Pointer; - 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 3a0e332..0000000 --- a/src/fltk.ads +++ /dev/null @@ -1,576 +0,0 @@ - - --- Programmed by Jedidiah Barber --- Released into the public domain - - -with - - Ada.Finalization; - -private with - - Interfaces.C, - System.Storage_Elements; - - -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; - - function Is_Valid - (Object : in Wrapper) - return Boolean; - - -- If this is ever raised it means FLTK has returned a value or otherwise - -- acted in a way that the binding really did not expect. - Internal_FLTK_Error : exception; - - - - - -- 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 - - - package Storage renames System.Storage_Elements; - use type Interfaces.C.size_t, Storage.Integer_Address; - - - Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address); - - - pragma Linker_Options ("-lfltk"); - pragma Linker_Options ("-lfltk_images"); - pragma Linker_Options ("-lfltk_gl"); - - - function c_pointer_size - return Interfaces.C.size_t; - pragma Import (C, c_pointer_size, "c_pointer_size"); - - -- If this fails then we are on an architecture that for whatever reason - -- has significant problems interfacing between C and Ada - pragma Assert - (c_pointer_size * Interfaces.C.CHAR_BIT = Storage.Integer_Address'Size, - "Size of C void pointers and size of Ada address values do not match"); - - - - - -- Note: This has to be Limited because otherwise the various init subprograms - -- wouldn't work, the widget callbacks wouldn't work, deallocation would be - -- a mess, really just all sorts of problems. - type Wrapper is new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : Storage.Integer_Address := Null_Pointer; - 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; - |