From 47dc4ac9eccd2e808b4c4d8e9e2be3702e1a6444 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 27 Jan 2025 11:51:38 +1300 Subject: Added Fl_Table --- body/c_fl_scroll.cpp | 15 + body/c_fl_scroll.h | 4 + body/c_fl_table.cpp | 511 +++++++++ body/c_fl_table.h | 135 +++ body/fltk-widgets-groups-scrolls.adb | 42 +- body/fltk-widgets-groups-tables.adb | 1971 ++++++++++++++++++++++++++++++++++ body/fltk-widgets-groups.adb | 4 +- doc/fl_group.html | 4 +- doc/fl_table.html | 1343 +++++++++++++++++++++++ doc/index.html | 3 +- progress.txt | 5 +- spec/fltk-widgets-groups-tables.ads | 614 +++++++++++ spec/fltk-widgets-groups.ads | 4 +- 13 files changed, 4646 insertions(+), 9 deletions(-) create mode 100644 body/c_fl_table.cpp create mode 100644 body/c_fl_table.h create mode 100644 body/fltk-widgets-groups-tables.adb create mode 100644 doc/fl_table.html create mode 100644 spec/fltk-widgets-groups-tables.ads diff --git a/body/c_fl_scroll.cpp b/body/c_fl_scroll.cpp index 5fd3240..3707b52 100644 --- a/body/c_fl_scroll.cpp +++ b/body/c_fl_scroll.cpp @@ -10,6 +10,21 @@ +// Telprot stopovers + +extern "C" void scroll_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l); +void fl_scroll_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) { + scroll_extra_init_hook(adaobj, x, y, w, h, label); +} + +extern "C" void scroll_extra_final_hook(void * aobj); +void fl_scroll_extra_final(void * adaobj) { + scroll_extra_final_hook(adaobj); +} + + + + // Exports from Ada extern "C" void widget_draw_hook(void * ud); diff --git a/body/c_fl_scroll.h b/body/c_fl_scroll.h index fe8674e..60cf9a0 100644 --- a/body/c_fl_scroll.h +++ b/body/c_fl_scroll.h @@ -8,6 +8,10 @@ #define FL_SCROLL_GUARD +extern "C" void fl_scroll_extra_init(void * adaobj, int x, int y, int w, int h, const char * label); +extern "C" void fl_scroll_extra_final(void * adaobj); + + typedef void* SCROLL; diff --git a/body/c_fl_table.cpp b/body/c_fl_table.cpp new file mode 100644 index 0000000..b7b83e2 --- /dev/null +++ b/body/c_fl_table.cpp @@ -0,0 +1,511 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_fl_table.h" + + + + +// Enum and macro constants + +const int fl_context_none = Fl_Table::CONTEXT_NONE; +const int fl_context_startpage = Fl_Table::CONTEXT_STARTPAGE; +const int fl_context_endpage = Fl_Table::CONTEXT_ENDPAGE; +const int fl_context_row_header = Fl_Table::CONTEXT_ROW_HEADER; +const int fl_context_col_header = Fl_Table::CONTEXT_COL_HEADER; +const int fl_context_cell = Fl_Table::CONTEXT_CELL; +const int fl_context_table = Fl_Table::CONTEXT_TABLE; +const int fl_context_rc_resize = Fl_Table::CONTEXT_RC_RESIZE; + + + + +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + +extern "C" void table_draw_cell_hook(void * ud, int e, int r, int c, int x, int y, int w, int h); + + + + +// Non-friend protected access + +class Friend_Table : Fl_Table { +public: + using Fl_Table::hscrollbar; + using Fl_Table::vscrollbar; + using Fl_Table::table; + + using Fl_Table::is_fltk_container; + + using Fl_Table::scroll_cb; + + using Fl_Table::col_scroll_position; + using Fl_Table::row_scroll_position; + + using Fl_Table::change_cursor; + using Fl_Table::ResizeFlag; + using Fl_Table::cursor2rowcol; + + using Fl_Table::recalc_dimensions; + using Fl_Table::table_resized; + using Fl_Table::table_scrolled; + + using Fl_Table::redraw_range; + using Fl_Table::damage_zone; + using Fl_Table::find_cell; + using Fl_Table::get_bounds; + using Fl_Table::row_col_clamp; +}; + + + + +// Attaching all relevant hooks and friends + +class My_Table : public Fl_Table { +public: + using Fl_Table::Fl_Table; + + friend void fl_table_draw(TABLE t); + friend void fl_table_draw_cell(TABLE t, int e, int r, int c, int x, int y, int w, int h); + friend int fl_table_handle(TABLE t, int e); + + void draw(); + void draw_cell(Fl_Table::TableContext e, int r=0, int c=0, int x=0, int y=0, int w=0, int h=0); + int handle(int e); +}; + +void My_Table::draw() { + widget_draw_hook(this->user_data()); +} + +void My_Table::draw_cell(Fl_Table::TableContext e, int r, int c, int x, int y, int w, int h) { + table_draw_cell_hook(this->user_data(), static_cast(e), r, c, x, y, w, h); +} + +int My_Table::handle(int e) { + return widget_handle_hook(this->user_data(), e); +} + + + + +// Flattened C API + +TABLE new_fl_table(int x, int y, int w, int h, char * label) { + My_Table *t = new My_Table(x, y, w, h, label); + return t; +} + +void free_fl_table(TABLE t) { + delete static_cast(t); +} + + + + +void * fl_table_hscrollbar(TABLE t) { + return (static_cast(t)->*(&Friend_Table::hscrollbar)); +} + +void * fl_table_vscrollbar(TABLE t) { + return (static_cast(t)->*(&Friend_Table::vscrollbar)); +} + +void * fl_table_table(TABLE t) { + return (static_cast(t)->*(&Friend_Table::table)); +} + + + + +void fl_table_add(TABLE t, void * w) { + static_cast(t)->add(static_cast(w)); +} + +void fl_table_insert(TABLE t, void * w, int p) { + Fl_Widget &ref = *(static_cast(w)); + static_cast(t)->insert(ref, p); +} + +void fl_table_insert2(TABLE t, void * w, void * b) { + Fl_Widget &ref = *(static_cast(w)); + static_cast(t)->insert(ref, static_cast(b)); +} + +void fl_table_remove(TABLE t, void * w) { + Fl_Widget &ref = *(static_cast(w)); + static_cast(t)->remove(ref); +} + + + + +void * fl_table_child(TABLE t, int p) { + return static_cast(t)->child(p); +} + +int fl_table_find(TABLE t, void * w) { + return static_cast(t)->find(static_cast(w)); +} + +int fl_table_children(TABLE t) { + return static_cast(t)->children(); +} + +int fl_table_is_fltk_container(TABLE t) { + return (static_cast(t)->*(&Friend_Table::is_fltk_container))(); +} + + + + +void fl_table_begin(TABLE t) { + static_cast(t)->begin(); +} + +void fl_table_end(TABLE t) { + static_cast(t)->end(); +} + + + + +void fl_table_set_callback(TABLE t, void * f) { + static_cast(t)->callback + (reinterpret_cast(f), static_cast(t)->user_data()); +} + +int fl_table_callback_col(TABLE t) { + return static_cast(t)->callback_col(); +} + +int fl_table_callback_row(TABLE t) { + return static_cast(t)->callback_row(); +} + +int fl_table_callback_context(TABLE t) { + return static_cast(t)->callback_context(); +} + +void fl_table_do_callback(TABLE t, int x, int r, int c) { + static_cast(t)->do_callback(static_cast(x), r, c); +} + +void fl_table_when(TABLE t, unsigned int w) { + static_cast(t)->when(static_cast(w)); +} + +void fl_table_scroll_cb(void * s, TABLE t) { + Friend_Table::scroll_cb(static_cast(s), t); +} + + + + +int fl_table_get_col_header(TABLE t) { + return static_cast(t)->col_header(); +} + +void fl_table_set_col_header(TABLE t, int f) { + static_cast(t)->col_header(f); +} + +unsigned int fl_table_get_col_header_color(TABLE t) { + return static_cast(t)->col_header_color(); +} + +void fl_table_set_col_header_color(TABLE t, unsigned int c) { + static_cast(t)->col_header_color(static_cast(c)); +} + +int fl_table_get_col_header_height(TABLE t) { + return static_cast(t)->col_header_height(); +} + +void fl_table_set_col_header_height(TABLE t, int h) { + static_cast(t)->col_header_height(h); +} + +int fl_table_get_col_width(TABLE t, int c) { + return static_cast(t)->col_width(c); +} + +void fl_table_set_col_width(TABLE t, int c, int w) { + static_cast(t)->col_width(c, w); +} + +void fl_table_col_width_all(TABLE t, int w) { + static_cast(t)->col_width_all(w); +} + +int fl_table_get_cols(TABLE t) { + return static_cast(t)->cols(); +} + +void fl_table_set_cols(TABLE t, int c) { + static_cast(t)->cols(c); +} + +int fl_table_get_col_position(TABLE t) { + return static_cast(t)->col_position(); +} + +void fl_table_set_col_position(TABLE t, int c) { + static_cast(t)->col_position(c); +} + +long fl_table_col_scroll_position(TABLE t, int c) { + return (static_cast(t)->*(&Friend_Table::col_scroll_position))(c); +} + +int fl_table_get_col_resize(TABLE t) { + return static_cast(t)->col_resize(); +} + +void fl_table_set_col_resize(TABLE t, int f) { + static_cast(t)->col_resize(f); +} + +int fl_table_get_col_resize_min(TABLE t) { + return static_cast(t)->col_resize_min(); +} + +void fl_table_set_col_resize_min(TABLE t, int v) { + static_cast(t)->col_resize_min(v); +} + + + + +int fl_table_get_row_header(TABLE t) { + return static_cast(t)->row_header(); +} + +void fl_table_set_row_header(TABLE t, int f) { + static_cast(t)->row_header(f); +} + +unsigned int fl_table_get_row_header_color(TABLE t) { + return static_cast(t)->row_header_color(); +} + +void fl_table_set_row_header_color(TABLE t, unsigned int c) { + static_cast(t)->row_header_color(static_cast(c)); +} + +int fl_table_get_row_header_width(TABLE t) { + return static_cast(t)->row_header_width(); +} + +void fl_table_set_row_header_width(TABLE t, int w) { + static_cast(t)->row_header_width(w); +} + +int fl_table_get_row_height(TABLE t, int r) { + return static_cast(t)->row_height(r); +} + +void fl_table_set_row_height(TABLE t, int r, int h) { + static_cast(t)->row_height(r, h); +} + +void fl_table_row_height_all(TABLE t, int h) { + static_cast(t)->row_height_all(h); +} + +int fl_table_get_rows(TABLE t) { + return static_cast(t)->rows(); +} + +void fl_table_set_rows(TABLE t, int r) { + static_cast(t)->rows(r); +} + +int fl_table_get_row_position(TABLE t) { + return static_cast(t)->row_position(); +} + +void fl_table_set_row_position(TABLE t, int r) { + static_cast(t)->row_position(r); +} + +long fl_table_row_scroll_position(TABLE t, int r) { + return (static_cast(t)->*(&Friend_Table::row_scroll_position))(r); +} + +int fl_table_get_row_resize(TABLE t) { + return static_cast(t)->row_resize(); +} + +void fl_table_set_row_resize(TABLE t, int f) { + static_cast(t)->row_resize(f); +} + +int fl_table_get_row_resize_min(TABLE t) { + return static_cast(t)->row_resize_min(); +} + +void fl_table_set_row_resize_min(TABLE t, int v) { + static_cast(t)->row_resize_min(v); +} + +int fl_table_get_top_row(TABLE t) { + return static_cast(t)->top_row(); +} + +void fl_table_set_top_row(TABLE t, int r) { + static_cast(t)->top_row(r); +} + + + + +void fl_table_change_cursor(TABLE t, int c) { + (static_cast(t)->*(&Friend_Table::change_cursor))(static_cast(c)); +} + +int fl_table_cursor2rowcol(TABLE t, int &r, int &c, int &f) { + Friend_Table::ResizeFlag ref; + return (static_cast(t)->*(&Friend_Table::cursor2rowcol))(r, c, ref); + f = static_cast(ref); +} + +void fl_table_visible_cells(TABLE t, int &r1, int &r2, int &c1, int &c2) { + static_cast(t)->visible_cells(r1, r2, c1, c2); +} + +void fl_table_get_selection(TABLE t, int &rt, int &cl, int &rb, int &cr) { + static_cast(t)->get_selection(rt, cl, rb, cr); +} + +void fl_table_set_selection(TABLE t, int rt, int cl, int rb, int cr) { + static_cast(t)->set_selection(rt, cl, rb, cr); +} + +int fl_table_is_selected(TABLE t, int r, int c) { + return static_cast(t)->is_selected(r, c); +} + +int fl_table_move_cursor(TABLE t, int r, int c, int s) { + return static_cast(t)->move_cursor(r, c, s); +} + +int fl_table_get_tab_cell_nav(TABLE t) { +#if FLTK_ABI_VERSION >= 10303 + return static_cast(t)->tab_cell_nav(); +#else + (void)(t); + return 0; +#endif +} + +void fl_table_set_tab_cell_nav(TABLE t, int v) { +#if FLTK_ABI_VERSION >= 10303 + static_cast(t)->tab_cell_nav(v); +#else + (void)(t); + (void)(v); +#endif +} + +int fl_table_get_table_box(TABLE t) { + return static_cast(t)->table_box(); +} + +void fl_table_set_table_box(TABLE t, int v) { + static_cast(t)->table_box(static_cast(v)); +} + + + + +int fl_table_get_scrollbar_size(TABLE t) { +#if FLTK_ABI_VERSION >= 10301 + return static_cast(t)->scrollbar_size(); +#else + (void)(t); + return 0; +#endif +} + +void fl_table_set_scrollbar_size(TABLE t, int v) { +#if FLTK_ABI_VERSION >= 10301 + static_cast(t)->scrollbar_size(v); +#else + (void)(t); + (void)(v); +#endif +} + +void fl_table_resize(TABLE t, int x, int y, int w, int h) { + static_cast(t)->resize(x, y, w, h); +} + +int fl_table_is_interactive_resize(TABLE t) { + return static_cast(t)->is_interactive_resize(); +} + +void fl_table_init_sizes(TABLE t) { + static_cast(t)->init_sizes(); +} + +void fl_table_recalc_dimensions(TABLE t) { + (static_cast(t)->*(&Friend_Table::recalc_dimensions))(); +} + +void fl_table_table_resized(TABLE t) { + (static_cast(t)->*(&Friend_Table::table_resized))(); +} + +void fl_table_table_scrolled(TABLE t) { + (static_cast(t)->*(&Friend_Table::table_scrolled))(); +} + + + + +void fl_table_draw(TABLE t) { + static_cast(t)->Fl_Table::draw(); +} + +void fl_table_draw_cell(TABLE t, int e, int r, int c, int x, int y, int w, int h) { + static_cast(t)->Fl_Table::draw_cell + (static_cast(e), r, c, x, y, w, h); +} + +void fl_table_redraw_range(TABLE t, int rt, int rb, int cl, int cr) { + (static_cast(t)->*(&Friend_Table::redraw_range))(rt, rb, cl, cr); +} + +void fl_table_damage_zone(TABLE t, int rt, int cl, int rb, int cr, int rr, int rc) { + (static_cast(t)->*(&Friend_Table::damage_zone))(rt, cl, rb, cr, rr, rc); +} + +int fl_table_find_cell(TABLE t, int e, int r, int c, int &x, int &y, int &w, int &h) { + return (static_cast(t)->*(&Friend_Table::find_cell)) + (static_cast(e), r, c, x, y, w, h); +} + +void fl_table_get_bounds(TABLE t, int e, int &x, int &y, int &w, int &h) { + (static_cast(t)->*(&Friend_Table::get_bounds)) + (static_cast(e), x, y, w, h); +} + +int fl_table_row_col_clamp(TABLE t, int e, int &r, int &c) { + return (static_cast(t)->*(&Friend_Table::row_col_clamp)) + (static_cast(e), r, c); +} + +int fl_table_handle(TABLE t, int e) { + return static_cast(t)->Fl_Table::handle(e); +} + + diff --git a/body/c_fl_table.h b/body/c_fl_table.h new file mode 100644 index 0000000..a291301 --- /dev/null +++ b/body/c_fl_table.h @@ -0,0 +1,135 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_TABLE_GUARD +#define FL_TABLE_GUARD + + +extern "C" const int fl_context_none; +extern "C" const int fl_context_startpage; +extern "C" const int fl_context_endpage; +extern "C" const int fl_context_row_header; +extern "C" const int fl_context_col_header; +extern "C" const int fl_context_cell; +extern "C" const int fl_context_table; +extern "C" const int fl_context_rc_resize; + + +typedef void* TABLE; + + +extern "C" TABLE new_fl_table(int x, int y, int w, int h, char * label); +extern "C" void free_fl_table(TABLE t); + + +extern "C" void * fl_table_hscrollbar(TABLE t); +extern "C" void * fl_table_vscrollbar(TABLE t); +extern "C" void * fl_table_table(TABLE t); + + +extern "C" void fl_table_add(TABLE t, void * w); +extern "C" void fl_table_insert(TABLE t, void * w, int p); +extern "C" void fl_table_insert2(TABLE t, void * w, void * b); +extern "C" void fl_table_remove(TABLE t, void * w); + + +extern "C" void * fl_table_child(TABLE t, int p); +extern "C" int fl_table_find(TABLE t, void * w); +extern "C" int fl_table_children(TABLE t); +extern "C" int fl_table_is_fltk_container(TABLE t); + + +extern "C" void fl_table_begin(TABLE t); +extern "C" void fl_table_end(TABLE t); + + +extern "C" void fl_table_set_callback(TABLE t, void * f); +extern "C" int fl_table_callback_col(TABLE t); +extern "C" int fl_table_callback_row(TABLE t); +extern "C" int fl_table_callback_context(TABLE t); +extern "C" void fl_table_do_callback(TABLE t, int x, int r, int c); +extern "C" void fl_table_when(TABLE t, unsigned int w); +extern "C" void fl_table_scroll_cb(void * s, TABLE t); + + +extern "C" int fl_table_get_col_header(TABLE t); +extern "C" void fl_table_set_col_header(TABLE t, int f); +extern "C" unsigned int fl_table_get_col_header_color(TABLE t); +extern "C" void fl_table_set_col_header_color(TABLE t, unsigned int c); +extern "C" int fl_table_get_col_header_height(TABLE t); +extern "C" void fl_table_set_col_header_height(TABLE t, int h); +extern "C" int fl_table_get_col_width(TABLE t, int c); +extern "C" void fl_table_set_col_width(TABLE t, int c, int w); +extern "C" void fl_table_col_width_all(TABLE t, int w); +extern "C" int fl_table_get_cols(TABLE t); +extern "C" void fl_table_set_cols(TABLE t, int c); +extern "C" int fl_table_get_col_position(TABLE t); +extern "C" void fl_table_set_col_position(TABLE t, int c); +extern "C" long fl_table_col_scroll_position(TABLE t, int c); +extern "C" int fl_table_get_col_resize(TABLE t); +extern "C" void fl_table_set_col_resize(TABLE t, int f); +extern "C" int fl_table_get_col_resize_min(TABLE t); +extern "C" void fl_table_set_col_resize_min(TABLE t, int v); + + +extern "C" int fl_table_get_row_header(TABLE t); +extern "C" void fl_table_set_row_header(TABLE t, int f); +extern "C" unsigned int fl_table_get_row_header_color(TABLE t); +extern "C" void fl_table_set_row_header_color(TABLE t, unsigned int c); +extern "C" int fl_table_get_row_header_width(TABLE t); +extern "C" void fl_table_set_row_header_width(TABLE t, int w); +extern "C" int fl_table_get_row_height(TABLE t, int r); +extern "C" void fl_table_set_row_height(TABLE t, int r, int h); +extern "C" void fl_table_row_height_all(TABLE t, int h); +extern "C" int fl_table_get_rows(TABLE t); +extern "C" void fl_table_set_rows(TABLE t, int r); +extern "C" int fl_table_get_row_position(TABLE t); +extern "C" void fl_table_set_row_position(TABLE t, int r); +extern "C" long fl_table_row_scroll_position(TABLE t, int r); +extern "C" int fl_table_get_row_resize(TABLE t); +extern "C" void fl_table_set_row_resize(TABLE t, int f); +extern "C" int fl_table_get_row_resize_min(TABLE t); +extern "C" void fl_table_set_row_resize_min(TABLE t, int v); +extern "C" int fl_table_get_top_row(TABLE t); +extern "C" void fl_table_set_top_row(TABLE t, int r); + + +extern "C" void fl_table_change_cursor(TABLE t, int c); +extern "C" int fl_table_cursor2rowcol(TABLE t, int &r, int &c, int &f); +extern "C" void fl_table_visible_cells(TABLE t, int &r1, int &r2, int &c1, int &c2); +extern "C" void fl_table_get_selection(TABLE t, int &rt, int &cl, int &rb, int &cr); +extern "C" void fl_table_set_selection(TABLE t, int rt, int cl, int rb, int cr); +extern "C" int fl_table_is_selected(TABLE t, int r, int c); +extern "C" int fl_table_move_cursor(TABLE t, int r, int c, int s); +extern "C" int fl_table_get_tab_cell_nav(TABLE t); +extern "C" void fl_table_set_tab_cell_nav(TABLE t, int v); +extern "C" int fl_table_get_table_box(TABLE t); +extern "C" void fl_table_set_table_box(TABLE t, int v); + + +extern "C" int fl_table_get_scrollbar_size(TABLE t); +extern "C" void fl_table_set_scrollbar_size(TABLE t, int v); +extern "C" void fl_table_resize(TABLE t, int x, int y, int w, int h); +extern "C" int fl_table_is_interactive_resize(TABLE t); +extern "C" void fl_table_init_sizes(TABLE t); +extern "C" void fl_table_recalc_dimensions(TABLE t); +extern "C" void fl_table_table_resized(TABLE t); +extern "C" void fl_table_table_scrolled(TABLE t); + + +extern "C" void fl_table_draw(TABLE t); +extern "C" void fl_table_draw_cell(TABLE t, int e, int r, int c, int x, int y, int w, int h); +extern "C" void fl_table_redraw_range(TABLE t, int rt, int rb, int cl, int cr); +extern "C" void fl_table_damage_zone(TABLE t, int rt, int cl, int rb, int cr, int rr, int rc); +extern "C" int fl_table_find_cell(TABLE t, int e, int r, int c, int &x, int &y, int &w, int &h); +extern "C" void fl_table_get_bounds(TABLE t, int e, int &x, int &y, int &w, int &h); +extern "C" int fl_table_row_col_clamp(TABLE t, int e, int &r, int &c); +extern "C" int fl_table_handle(TABLE t, int e); + + +#endif + + diff --git a/body/fltk-widgets-groups-scrolls.adb b/body/fltk-widgets-groups-scrolls.adb index a4885dc..fa1b03e 100644 --- a/body/fltk-widgets-groups-scrolls.adb +++ b/body/fltk-widgets-groups-scrolls.adb @@ -6,7 +6,7 @@ with - Interfaces.C; + Interfaces.C.Strings; use type @@ -105,6 +105,22 @@ package body FLTK.Widgets.Groups.Scrolls is -- Destructors -- ------------------- + -- I used the FFI to bypass namespace rules and all I got was this lousy tshirt + procedure scroll_extra_final_hook + (Ada_Obj : in Storage.Integer_Address); + pragma Export (C, scroll_extra_final_hook, "scroll_extra_final_hook"); + + procedure scroll_extra_final_hook + (Ada_Obj : in Storage.Integer_Address) + is + My_Scroll : Scroll; + for My_Scroll'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Scroll); + begin + Extra_Final (My_Scroll); + end scroll_extra_final_hook; + + -- It's the only way to be sure procedure fl_scrollbar_extra_final (Ada_Obj : in Storage.Integer_Address); @@ -138,6 +154,30 @@ package body FLTK.Widgets.Groups.Scrolls is -- Constructors -- -------------------- + -- Quite right sir, stop the boat! + procedure scroll_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, scroll_extra_init_hook, "scroll_extra_init_hook"); + + procedure scroll_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_Scroll : Scroll; + for My_Scroll'Address use Storage.To_Address (Ada_Obj); + pragma Import (Ada, My_Scroll); + begin + Extra_Init + (My_Scroll, + Integer (X), Integer (Y), + Integer (W), Integer (H), + Interfaces.C.Strings.Value (C_Str)); + end scroll_extra_init_hook; + + -- Hold on, I know a shortcut procedure fl_scrollbar_extra_init (Ada_Obj : in Storage.Integer_Address; diff --git a/body/fltk-widgets-groups-tables.adb b/body/fltk-widgets-groups-tables.adb new file mode 100644 index 0000000..9e7fd38 --- /dev/null +++ b/body/fltk-widgets-groups-tables.adb @@ -0,0 +1,1971 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + Ada.Characters.Latin_1, + Interfaces.C, + System.Address_To_Access_Conversions; + +use type + + Interfaces.C.int; + + +package body FLTK.Widgets.Groups.Tables is + + + package Chk renames Ada.Assertions; + package Latin renames Ada.Characters.Latin_1; + + + + + ------------------------ + -- Constants From C -- + ------------------------ + + fl_context_none : constant Interfaces.C.int; + pragma Import (C, fl_context_none, "fl_context_none"); + + fl_context_startpage : constant Interfaces.C.int; + pragma Import (C, fl_context_startpage, "fl_context_startpage"); + + fl_context_endpage : constant Interfaces.C.int; + pragma Import (C, fl_context_endpage, "fl_context_endpage"); + + fl_context_row_header : constant Interfaces.C.int; + pragma Import (C, fl_context_row_header, "fl_context_row_header"); + + fl_context_col_header : constant Interfaces.C.int; + pragma Import (C, fl_context_col_header, "fl_context_col_header"); + + fl_context_cell : constant Interfaces.C.int; + pragma Import (C, fl_context_cell, "fl_context_cell"); + + fl_context_table : constant Interfaces.C.int; + pragma Import (C, fl_context_table, "fl_context_table"); + + fl_context_rc_resize : constant Interfaces.C.int; + pragma Import (C, fl_context_rc_resize, "fl_context_rc_resize"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_table + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_table, "new_fl_table"); + pragma Inline (new_fl_table); + + procedure free_fl_table + (T : in Storage.Integer_Address); + pragma Import (C, free_fl_table, "free_fl_table"); + pragma Inline (free_fl_table); + + + + + function fl_table_hscrollbar + (T : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_table_hscrollbar, "fl_table_hscrollbar"); + pragma Inline (fl_table_hscrollbar); + + function fl_table_vscrollbar + (T : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_table_vscrollbar, "fl_table_vscrollbar"); + pragma Inline (fl_table_vscrollbar); + + function fl_table_table + (T : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_table_table, "fl_table_table"); + pragma Inline (fl_table_table); + + + + + procedure fl_table_add + (T, W : in Storage.Integer_Address); + pragma Import (C, fl_table_add, "fl_table_add"); + pragma Inline (fl_table_add); + + procedure fl_table_insert + (T, W : in Storage.Integer_Address; + P : in Interfaces.C.int); + pragma Import (C, fl_table_insert, "fl_table_insert"); + pragma Inline (fl_table_insert); + + procedure fl_table_insert2 + (T, W, B : in Storage.Integer_Address); + pragma Import (C, fl_table_insert2, "fl_table_insert2"); + pragma Inline (fl_table_insert2); + + procedure fl_table_remove + (T, W : in Storage.Integer_Address); + pragma Import (C, fl_table_remove, "fl_table_remove"); + pragma Inline (fl_table_remove); + + + + + function fl_table_child + (T : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Import (C, fl_table_child, "fl_table_child"); + pragma Inline (fl_table_child); + + function fl_table_find + (T, W : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_find, "fl_table_find"); + pragma Inline (fl_table_find); + + function fl_table_children + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_children, "fl_table_children"); + pragma Inline (fl_table_children); + + function fl_table_is_fltk_container + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_is_fltk_container, "fl_table_is_fltk_container"); + pragma Inline (fl_table_is_fltk_container); + + + + + procedure fl_table_begin + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_begin, "fl_table_begin"); + pragma Inline (fl_table_begin); + + procedure fl_table_end + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_end, "fl_table_end"); + pragma Inline (fl_table_end); + + + + + procedure fl_table_set_callback + (T, F : in Storage.Integer_Address); + pragma Import (C, fl_table_set_callback, "fl_table_set_callback"); + pragma Inline (fl_table_set_callback); + + function fl_table_callback_col + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_callback_col, "fl_table_callback_col"); + pragma Inline (fl_table_callback_col); + + function fl_table_callback_row + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_callback_row, "fl_table_callback_row"); + pragma Inline (fl_table_callback_row); + + function fl_table_callback_context + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_callback_context, "fl_table_callback_context"); + pragma Inline (fl_table_callback_context); + + procedure fl_table_do_callback + (T : in Storage.Integer_Address; + X, R, C : in Interfaces.C.int); + pragma Import (C, fl_table_do_callback, "fl_table_do_callback"); + pragma Inline (fl_table_do_callback); + + procedure fl_table_when + (T : in Storage.Integer_Address; + W : in Interfaces.C.unsigned); + pragma Import (C, fl_table_when, "fl_table_when"); + pragma Inline (fl_table_when); + + procedure fl_table_scroll_cb + (S, T : in Storage.Integer_Address); + pragma Import (C, fl_table_scroll_cb, "fl_table_scroll_cb"); + pragma Inline (fl_table_scroll_cb); + + + + + function fl_table_get_col_header + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_header, "fl_table_get_col_header"); + pragma Inline (fl_table_get_col_header); + + procedure fl_table_set_col_header + (T : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_header, "fl_table_set_col_header"); + pragma Inline (fl_table_set_col_header); + + function fl_table_get_col_header_color + (T : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_table_get_col_header_color, "fl_table_get_col_header_color"); + pragma Inline (fl_table_get_col_header_color); + + procedure fl_table_set_col_header_color + (T : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_table_set_col_header_color, "fl_table_set_col_header_color"); + pragma Inline (fl_table_set_col_header_color); + + function fl_table_get_col_header_height + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_header_height, "fl_table_get_col_header_height"); + pragma Inline (fl_table_get_col_header_height); + + procedure fl_table_set_col_header_height + (T : in Storage.Integer_Address; + H : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_header_height, "fl_table_set_col_header_height"); + pragma Inline (fl_table_set_col_header_height); + + function fl_table_get_col_width + (T : in Storage.Integer_Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_width, "fl_table_get_col_width"); + pragma Inline (fl_table_get_col_width); + + procedure fl_table_set_col_width + (T : in Storage.Integer_Address; + C, W : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_width, "fl_table_set_col_width"); + pragma Inline (fl_table_set_col_width); + + procedure fl_table_col_width_all + (T : in Storage.Integer_Address; + W : in Interfaces.C.int); + pragma Import (C, fl_table_col_width_all, "fl_table_col_width_all"); + pragma Inline (fl_table_col_width_all); + + function fl_table_get_cols + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_cols, "fl_table_get_cols"); + pragma Inline (fl_table_get_cols); + + procedure fl_table_set_cols + (T : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_table_set_cols, "fl_table_set_cols"); + pragma Inline (fl_table_set_cols); + + function fl_table_get_col_position + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_position, "fl_table_get_col_position"); + pragma Inline (fl_table_get_col_position); + + procedure fl_table_set_col_position + (T : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_position, "fl_table_set_col_position"); + pragma Inline (fl_table_set_col_position); + + function fl_table_col_scroll_position + (T : in Storage.Integer_Address; + C : in Interfaces.C.int) + return Interfaces.C.long; + pragma Import (C, fl_table_col_scroll_position, "fl_table_col_scroll_position"); + pragma Inline (fl_table_col_scroll_position); + + function fl_table_get_col_resize + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_resize, "fl_table_get_col_resize"); + pragma Inline (fl_table_get_col_resize); + + procedure fl_table_set_col_resize + (T : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_resize, "fl_table_set_col_resize"); + pragma Inline (fl_table_set_col_resize); + + function fl_table_get_col_resize_min + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_col_resize_min, "fl_table_get_col_resize_min"); + pragma Inline (fl_table_get_col_resize_min); + + procedure fl_table_set_col_resize_min + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_set_col_resize_min, "fl_table_set_col_resize_min"); + pragma Inline (fl_table_set_col_resize_min); + + + + + function fl_table_get_row_header + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_header, "fl_table_get_row_header"); + pragma Inline (fl_table_get_row_header); + + procedure fl_table_set_row_header + (T : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_header, "fl_table_set_row_header"); + pragma Inline (fl_table_set_row_header); + + function fl_table_get_row_header_color + (T : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_table_get_row_header_color, "fl_table_get_row_header_color"); + pragma Inline (fl_table_get_row_header_color); + + procedure fl_table_set_row_header_color + (T : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_table_set_row_header_color, "fl_table_set_row_header_color"); + pragma Inline (fl_table_set_row_header_color); + + function fl_table_get_row_header_width + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_header_width, "fl_table_get_row_header_width"); + pragma Inline (fl_table_get_row_header_width); + + procedure fl_table_set_row_header_width + (T : in Storage.Integer_Address; + W : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_header_width, "fl_table_set_row_header_width"); + pragma Inline (fl_table_set_row_header_width); + + function fl_table_get_row_height + (T : in Storage.Integer_Address; + R : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_height, "fl_table_get_row_height"); + pragma Inline (fl_table_get_row_height); + + procedure fl_table_set_row_height + (T : in Storage.Integer_Address; + R, H : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_height, "fl_table_set_row_height"); + pragma Inline (fl_table_set_row_height); + + procedure fl_table_row_height_all + (T : in Storage.Integer_Address; + H : in Interfaces.C.int); + pragma Import (C, fl_table_row_height_all, "fl_table_row_height_all"); + pragma Inline (fl_table_row_height_all); + + function fl_table_get_rows + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_rows, "fl_table_get_rows"); + pragma Inline (fl_table_get_rows); + + procedure fl_table_set_rows + (T : in Storage.Integer_Address; + R : in Interfaces.C.int); + pragma Import (C, fl_table_set_rows, "fl_table_set_rows"); + pragma Inline (fl_table_set_rows); + + function fl_table_get_row_position + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_position, "fl_table_get_row_position"); + pragma Inline (fl_table_get_row_position); + + procedure fl_table_set_row_position + (T : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_position, "fl_table_set_row_position"); + pragma Inline (fl_table_set_row_position); + + function fl_table_row_scroll_position + (T : in Storage.Integer_Address; + R : in Interfaces.C.int) + return Interfaces.C.long; + pragma Import (C, fl_table_row_scroll_position, "fl_table_row_scroll_position"); + pragma Inline (fl_table_row_scroll_position); + + function fl_table_get_row_resize + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_resize, "fl_table_get_row_resize"); + pragma Inline (fl_table_get_row_resize); + + procedure fl_table_set_row_resize + (T : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_resize, "fl_table_set_row_resize"); + pragma Inline (fl_table_set_row_resize); + + function fl_table_get_row_resize_min + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_row_resize_min, "fl_table_get_row_resize_min"); + pragma Inline (fl_table_get_row_resize_min); + + procedure fl_table_set_row_resize_min + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_set_row_resize_min, "fl_table_set_row_resize_min"); + pragma Inline (fl_table_set_row_resize_min); + + function fl_table_get_top_row + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_top_row, "fl_table_get_top_row"); + pragma Inline (fl_table_get_top_row); + + procedure fl_table_set_top_row + (T : in Storage.Integer_Address; + R : in Interfaces.C.int); + pragma Import (C, fl_table_set_top_row, "fl_table_set_top_row"); + pragma Inline (fl_table_set_top_row); + + + + + procedure fl_table_change_cursor + (T : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_table_change_cursor, "fl_table_change_cursor"); + pragma Inline (fl_table_change_cursor); + + function fl_table_cursor2rowcol + (T : in Storage.Integer_Address; + R, C, F : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_cursor2rowcol, "fl_table_cursor2rowcol"); + pragma Inline (fl_table_cursor2rowcol); + + procedure fl_table_visible_cells + (T : in Storage.Integer_Address; + R1, R2, C1, C2 : out Interfaces.C.int); + pragma Import (C, fl_table_visible_cells, "fl_table_visible_cells"); + pragma Inline (fl_table_visible_cells); + + procedure fl_table_get_selection + (T : in Storage.Integer_Address; + RT, CL, RB, CR : out Interfaces.C.int); + pragma Import (C, fl_table_get_selection, "fl_table_get_selection"); + pragma Inline (fl_table_get_selection); + + procedure fl_table_set_selection + (T : in Storage.Integer_Address; + RT, CL, RB, CR : in Interfaces.C.int); + pragma Import (C, fl_table_set_selection, "fl_table_set_selection"); + pragma Inline (fl_table_set_selection); + + function fl_table_is_selected + (T : in Storage.Integer_Address; + R, C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_is_selected, "fl_table_is_selected"); + pragma Inline (fl_table_is_selected); + + function fl_table_move_cursor + (T : in Storage.Integer_Address; + R, C, S : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_move_cursor, "fl_table_move_cursor"); + pragma Inline (fl_table_move_cursor); + + function fl_table_get_tab_cell_nav + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_tab_cell_nav, "fl_table_get_tab_cell_nav"); + pragma Inline (fl_table_get_tab_cell_nav); + + procedure fl_table_set_tab_cell_nav + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_set_tab_cell_nav, "fl_table_set_tab_cell_nav"); + pragma Inline (fl_table_set_tab_cell_nav); + + function fl_table_get_table_box + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_table_box, "fl_table_get_table_box"); + pragma Inline (fl_table_get_table_box); + + procedure fl_table_set_table_box + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_set_table_box, "fl_table_set_table_box"); + pragma Inline (fl_table_set_table_box); + + + + + function fl_table_get_scrollbar_size + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_get_scrollbar_size, "fl_table_get_scrollbar_size"); + pragma Inline (fl_table_get_scrollbar_size); + + procedure fl_table_set_scrollbar_size + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_set_scrollbar_size, "fl_table_set_scrollbar_size"); + pragma Inline (fl_table_set_scrollbar_size); + + procedure fl_table_resize + (T : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_table_resize, "fl_table_resize"); + pragma Inline (fl_table_resize); + + function fl_table_is_interactive_resize + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_is_interactive_resize, "fl_table_is_interactive_resize"); + pragma Inline (fl_table_is_interactive_resize); + + procedure fl_table_init_sizes + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_init_sizes, "fl_table_init_sizes"); + pragma Inline (fl_table_init_sizes); + + procedure fl_table_recalc_dimensions + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_recalc_dimensions, "fl_table_recalc_dimensions"); + pragma Inline (fl_table_recalc_dimensions); + + procedure fl_table_table_resized + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_table_resized, "fl_table_table_resized"); + pragma Inline (fl_table_table_resized); + + procedure fl_table_table_scrolled + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_table_scrolled, "fl_table_table_scrolled"); + pragma Inline (fl_table_table_scrolled); + + + + + procedure fl_table_draw + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_draw, "fl_table_draw"); + pragma Inline (fl_table_draw); + + procedure fl_table_draw_cell + (T : in Storage.Integer_Address; + E, R, C, X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_table_draw_cell, "fl_table_draw_cell"); + pragma Inline (fl_table_draw_cell); + + procedure fl_table_redraw_range + (T : in Storage.Integer_Address; + RT, RB, CL, CR : in Interfaces.C.int); + pragma Import (C, fl_table_redraw_range, "fl_table_redraw_range"); + pragma Inline (fl_table_redraw_range); + + procedure fl_table_damage_zone + (T : in Storage.Integer_Address; + RT, CL, RB, CR, RR, RC : in Interfaces.C.int); + pragma Import (C, fl_table_damage_zone, "fl_table_damage_zone"); + pragma Inline (fl_table_damage_zone); + + function fl_table_find_cell + (T : in Storage.Integer_Address; + E, R, C : in Interfaces.C.int; + X, Y, W, H : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_find_cell, "fl_table_find_cell"); + pragma Inline (fl_table_find_cell); + + procedure fl_table_get_bounds + (T : in Storage.Integer_Address; + E : in Interfaces.C.int; + X, Y, W, H : out Interfaces.C.int); + pragma Import (C, fl_table_get_bounds, "fl_table_get_bounds"); + pragma Inline (fl_table_get_bounds); + + function fl_table_row_col_clamp + (T : in Storage.Integer_Address; + E : in Interfaces.C.int; + R, C : in out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_row_col_clamp, "fl_table_row_col_clamp"); + pragma Inline (fl_table_row_col_clamp); + + function fl_table_handle + (T : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_handle, "fl_table_handle"); + pragma Inline (fl_table_handle); + + + + + ------------------------ + -- Internal Utility -- + ------------------------ + + function To_Cint + (Context : in Table_Context) + return Interfaces.C.int is + begin + case Context is + when No_Context => return fl_context_none; + when Start_Page => return fl_context_startpage; + when End_Page => return fl_context_endpage; + when Row_Header => return fl_context_row_header; + when Column_Header => return fl_context_col_header; + when Within_Cell => return fl_context_cell; + when Dead_Zone => return fl_context_table; + when Row_Column_Resize => return fl_context_rc_resize; + end case; + end To_Cint; + + + function To_Context + (Value : in Interfaces.C.int) + return Table_Context is + begin + if Value = fl_context_none then + return No_Context; + elsif Value = fl_context_startpage then + return Start_Page; + elsif Value = fl_context_endpage then + return End_Page; + elsif Value = fl_context_row_header then + return Row_Header; + elsif Value = fl_context_col_header then + return Column_Header; + elsif Value = fl_context_cell then + return Within_Cell; + elsif Value = fl_context_table then + return Dead_Zone; + elsif Value = fl_context_rc_resize then + return Row_Column_Resize; + else + raise Constraint_Error; + end if; + end To_Context; + + + + + ---------------------- + -- Exported Hooks -- + ---------------------- + + package Table_Convert is new System.Address_To_Access_Conversions (Table'Class); + + procedure Table_Draw_Cell_Hook + (UD : in Storage.Integer_Address; + E, R, C, X, Y, W, H : in Interfaces.C.int); + pragma Export (C, Table_Draw_Cell_Hook, "table_draw_cell_hook"); + + procedure Table_Draw_Cell_Hook + (UD : in Storage.Integer_Address; + E, R, C, X, Y, W, H : in Interfaces.C.int) + is + Ada_Table : access Table'Class; + Context : Table_Context; + Row, Column : Natural; + begin + pragma Assert (UD /= Null_Pointer); + Ada_Table := Table_Convert.To_Pointer (Storage.To_Address (UD)); + Context := To_Context (E); + case Context is + when Row_Header => + Row := Positive (R + 1); + Column := Natural (C); + when Column_Header => + Row := Natural (R); + Column := Positive (C + 1); + when Within_Cell => + Row := Positive (R + 1); + Column := Positive (C + 1); + when others => + Row := Natural (R); + Column := Natural (C); + end case; + Ada_Table.Draw_Cell + (Context, Row, Column, + Integer (X), Integer (Y), Integer (W), Integer (H)); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "User data null pointer passed to Fl_Table::draw_cell override hook"; + when Constraint_Error => raise Internal_FLTK_Error with + "Unexpected int values passed to Fl_Table::draw_cell override hook of" & Latin.LF & + Latin.HT & "row = " & Interfaces.C.int'Image (R) & Latin.LF & + Latin.HT & "column = " & Interfaces.C.int'Image (C); + end Table_Draw_Cell_Hook; + + + + + ------------------- + -- Destructors -- + ------------------- + + -- Attempting to divide by zero + 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); + + + -- Close the door; Open the nExt + procedure fl_scroll_extra_final + (Ada_Obj : in Storage.Integer_Address); + pragma Import (C, fl_scroll_extra_final, "fl_scroll_extra_final"); + pragma Inline (fl_scroll_extra_final); + + + procedure Extra_Final + (This : in out Table) is + begin + fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address)); + fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address)); + fl_scroll_extra_final (Storage.To_Integer (This.Playing_Area'Address)); + Extra_Final (Group (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Table) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_table (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + -- Engage silent drive! + 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); + + + -- Conducting Penrose experiment + procedure fl_scroll_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_scroll_extra_init, "fl_scroll_extra_init"); + pragma Inline (fl_scroll_extra_init); + + + procedure Extra_Init + (This : in out Table; + X, Y, W, H : in Integer; + Text : in String) is + begin + Widget (This.Horizon).Void_Ptr := fl_table_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)); + This.Horizon.Set_Callback (Scroll_Callback'Access); + + Widget (This.Vertigo).Void_Ptr := fl_table_vscrollbar (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)); + This.Vertigo.Set_Callback (Scroll_Callback'Access); + + Widget (This.Playing_Area).Void_Ptr := fl_table_table (This.Void_Ptr); + Widget (This.Playing_Area).Needs_Dealloc := False; + fl_scroll_extra_init + (Storage.To_Integer (This.Playing_Area'Address), + Interfaces.C.int (This.Playing_Area.Get_X), + Interfaces.C.int (This.Playing_Area.Get_Y), + Interfaces.C.int (This.Playing_Area.Get_W), + Interfaces.C.int (This.Playing_Area.Get_H), + Interfaces.C.To_C (This.Playing_Area.Get_Label)); + + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Table) is + begin + This.Draw_Ptr := fl_table_draw'Address; + This.Handle_Ptr := fl_table_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Table is + begin + return This : Table do + This.Void_Ptr := new_fl_table + (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 + (Parent : in out Groups.Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Table is + begin + return This : Table := Create (X, Y, W, H, Text) do + Parent.Add (This); + end return; + end Create; + + end Forge; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function H_Bar + (This : in out Table) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference is + begin + return (Data => This.Horizon'Unchecked_Access); + end H_Bar; + + + function V_Bar + (This : in out Table) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference is + begin + return (Data => This.Vertigo'Unchecked_Access); + end V_Bar; + + + function Scroll_Area + (This : in out Table) + return Scrolls.Scroll_Reference is + begin + return (Data => This.Playing_Area'Unchecked_Access); + end Scroll_Area; + + + + + procedure Add + (This : in out Table; + Item : in out Widget'Class) is + begin + fl_table_add (This.Void_Ptr, Item.Void_Ptr); + end Add; + + + procedure Insert + (This : in out Table; + Item : in out Widget'Class; + Place : in Index) is + begin + fl_table_insert + (This.Void_Ptr, + Item.Void_Ptr, + Interfaces.C.int (Place) - 1); + end Insert; + + + procedure Insert + (This : in out Table; + Item : in out Widget'Class; + Before : in Widget'Class) is + begin + fl_table_insert2 + (This.Void_Ptr, + Item.Void_Ptr, + Before.Void_Ptr); + end Insert; + + + procedure Remove + (This : in out Table; + Item : in out Widget'Class) is + begin + fl_table_remove (This.Void_Ptr, Item.Void_Ptr); + end Remove; + + + procedure Clear + (This : in out Table) is + begin + This.Set_Rows (0); + This.Set_Columns (0); + This.Playing_Area.Clear; + end Clear; + + + + + function Has_Child + (This : in Table; + 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 Table; + Place : in Index) + return Widget_Reference + is + Widget_Ptr : Storage.Integer_Address := + fl_table_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 with + "Fl_Table::child returned a widget with no user data reference back to Ada"; + end Child; + + + function Child + (This : in Table; + Place : in Cursor) + return Widget_Reference is + begin + return This.Child (Place.My_Index); + end Child; + + + function Find + (This : in Table; + Item : in Widget'Class) + return Extended_Index + is + Result : Interfaces.C.int := fl_table_find (This.Void_Ptr, Item.Void_Ptr); + begin + if Result = fl_table_children (This.Void_Ptr) then + return No_Index; + end if; + return Extended_Index (Result + 1); + end Find; + + + function Number_Of_Children + (This : in Table) + return Natural is + begin + return Natural (fl_table_children (This.Void_Ptr)); + end Number_Of_Children; + + + function Used_As_Container + (This : in Table) + return Boolean is + begin + return fl_table_is_fltk_container (This.Void_Ptr) /= 0; + end Used_As_Container; + + + + + procedure Begin_Current + (This : in out Table) is + begin + fl_table_begin (This.Void_Ptr); + end Begin_Current; + + + procedure End_Current + (This : in out Table) is + begin + fl_table_end (This.Void_Ptr); + end End_Current; + + + + + procedure Set_Callback + (This : in out Table; + Func : in Widget_Callback) is + begin + if Func /= null then + This.Callback := Func; + fl_table_set_callback (This.Void_Ptr, Storage.To_Integer (Callback_Hook'Address)); + end if; + end Set_Callback; + + + function Callback_Column + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_callback_col (This.Void_Ptr); + begin + return Positive (Result + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::callback_col returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Callback_Column; + + + function Callback_Row + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_callback_row (This.Void_Ptr); + begin + return Positive (Result + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::callback_row returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Callback_Row; + + + function Callback_Context + (This : in Table) + return Table_Context + is + Result : Interfaces.C.int := fl_table_callback_context (This.Void_Ptr); + begin + return To_Context (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::callback_context returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Callback_Context; + + + procedure Do_Callback + (This : in out Table; + Context : in Table_Context; + Row, Column : in Positive) is + begin + fl_table_do_callback + (This.Void_Ptr, + To_Cint (Context), + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Column) - 1); + end Do_Callback; + + + procedure Set_When + (This : in out Table; + Value : in Callback_Flag) is + begin + fl_table_when (This.Void_Ptr, Interfaces.C.unsigned (Value)); + end Set_When; + + + procedure Scroll_Callback + (Item : in out Widget'Class) is + begin + fl_table_scroll_cb (Item.Void_Ptr, Item.Parent.Void_Ptr); + end Scroll_Callback; + + + + + function Column_Headers_Enabled + (This : in Table) + return Boolean is + begin + return fl_table_get_col_header (This.Void_Ptr) /= 0; + end Column_Headers_Enabled; + + + procedure Set_Column_Headers + (This : in out Table; + Value : in Boolean) is + begin + fl_table_set_col_header (This.Void_Ptr, Boolean'Pos (Value)); + end Set_Column_Headers; + + + function Get_Column_Header_Color + (This : in Table) + return Color is + begin + return Color (fl_table_get_col_header_color (This.Void_Ptr)); + end Get_Column_Header_Color; + + + procedure Set_Column_Header_Color + (This : in out Table; + Value : in Color) is + begin + fl_table_set_col_header_color (This.Void_Ptr, Interfaces.C.unsigned (Value)); + end Set_Column_Header_Color; + + + function Get_Column_Header_Height + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_col_header_height (This.Void_Ptr); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::col_header_height returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Column_Header_Height; + + + procedure Set_Column_Header_Height + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_col_header_height (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Column_Header_Height; + + + function Get_Column_Width + (This : in Table; + Column : in Positive) + return Positive + is + Result : Interfaces.C.int := fl_table_get_col_width + (This.Void_Ptr, Interfaces.C.int (Column) - 1); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::col_width returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Column_Width; + + + procedure Set_Column_Width + (This : in out Table; + Column : in Positive; + Value : in Positive) is + begin + fl_table_set_col_width + (This.Void_Ptr, + Interfaces.C.int (Column) - 1, + Interfaces.C.int (Value)); + end Set_Column_Width; + + + procedure Set_All_Columns_Width + (This : in out Table; + Value : in Positive) is + begin + fl_table_col_width_all (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_All_Columns_Width; + + + function Get_Columns + (This : in Table) + return Natural + is + Result : Interfaces.C.int := fl_table_get_cols (This.Void_Ptr); + begin + return Natural (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::cols returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Columns; + + + procedure Set_Columns + (This : in out Table; + Value : in Natural) is + begin + fl_table_set_cols (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Columns; + + + function Get_Column_Position + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_col_position (This.Void_Ptr); + begin + return Positive (Result + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::col_position returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Column_Position; + + + procedure Set_Column_Position + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_col_position (This.Void_Ptr, Interfaces.C.int (Value) - 1); + end Set_Column_Position; + + + function Get_Column_Scroll_Position + (This : in Table; + Column : in Positive) + return Long_Integer is + begin + return Long_Integer (fl_table_col_scroll_position + (This.Void_Ptr, + Interfaces.C.int (Column) - 1)); + end Get_Column_Scroll_Position; + + + function Column_Resize_Allowed + (This : in Table) + return Boolean is + begin + return fl_table_get_col_resize (This.Void_Ptr) /= 0; + end Column_Resize_Allowed; + + + procedure Set_Column_Resize + (This : in out Table; + Value : in Boolean) is + begin + fl_table_set_col_resize (This.Void_Ptr, Boolean'Pos (Value)); + end Set_Column_Resize; + + + function Get_Column_Resize_Minimum + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_col_resize_min (This.Void_Ptr); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::col_resize_min returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Column_Resize_Minimum; + + + procedure Set_Column_Resize_Minimum + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_col_resize_min (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Column_Resize_Minimum; + + + + + function Row_Headers_Enabled + (This : in Table) + return Boolean is + begin + return fl_table_get_row_header (This.Void_Ptr) /= 0; + end Row_Headers_Enabled; + + + procedure Set_Row_Headers + (This : in out Table; + Value : in Boolean) is + begin + fl_table_set_row_header (This.Void_Ptr, Boolean'Pos (Value)); + end Set_Row_Headers; + + + function Get_Row_Header_Color + (This : in Table) + return Color is + begin + return Color (fl_table_get_row_header_color (This.Void_Ptr)); + end Get_Row_Header_Color; + + + procedure Set_Row_Header_Color + (This : in out Table; + Value : in Color) is + begin + fl_table_set_row_header_color (This.Void_Ptr, Interfaces.C.unsigned (Value)); + end Set_Row_Header_Color; + + + function Get_Row_Header_Width + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_row_header_width (This.Void_Ptr); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::row_header_width returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Row_Header_Width; + + + procedure Set_Row_Header_Width + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_row_header_width (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Row_Header_Width; + + + function Get_Row_Height + (This : in Table; + Row : in Positive) + return Positive + is + Result : Interfaces.C.int := fl_table_get_row_height + (This.Void_Ptr, Interfaces.C.int (Row) - 1); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::row_height returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Row_Height; + + + procedure Set_Row_Height + (This : in out Table; + Row : in Positive; + Value : in Positive) is + begin + fl_table_set_row_height + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Value)); + end Set_Row_Height; + + + procedure Set_All_Rows_Height + (This : in out Table; + Value : in Positive) is + begin + fl_table_row_height_all (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_All_Rows_Height; + + + function Get_Rows + (This : in Table) + return Natural + is + Result : Interfaces.C.int := fl_table_get_rows (This.Void_Ptr); + begin + return Natural (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::rows returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Rows; + + + procedure Set_Rows + (This : in out Table; + Value : in Natural) is + begin + fl_table_set_rows (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Rows; + + + function Get_Row_Position + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_row_position (This.Void_Ptr); + begin + return Positive (Result + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::row_position returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Row_Position; + + + procedure Set_Row_Position + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_row_position (This.Void_Ptr, Interfaces.C.int (Value) - 1); + end Set_Row_Position; + + + function Get_Row_Scroll_Position + (This : in Table; + Row : in Positive) + return Long_Integer is + begin + return Long_Integer (fl_table_row_scroll_position + (This.Void_Ptr, + Interfaces.C.int (Row) - 1)); + end Get_Row_Scroll_Position; + + + function Row_Resize_Allowed + (This : in Table) + return Boolean is + begin + return fl_table_get_row_resize (This.Void_Ptr) /= 0; + end Row_Resize_Allowed; + + + procedure Set_Row_Resize + (This : in out Table; + Value : in Boolean) is + begin + fl_table_set_row_resize (This.Void_Ptr, Boolean'Pos (Value)); + end Set_Row_Resize; + + + function Get_Row_Resize_Minimum + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_row_resize_min (This.Void_Ptr); + begin + return Positive (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::row_resize_min returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Row_Resize_Minimum; + + + procedure Set_Row_Resize_Minimum + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_row_resize_min (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Row_Resize_Minimum; + + + function Get_Top_Row + (This : in Table) + return Positive + is + Result : Interfaces.C.int := fl_table_get_top_row (This.Void_Ptr); + begin + return Positive (Result + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::top_row returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Top_Row; + + + procedure Set_Top_Row + (This : in out Table; + Value : in Positive) is + begin + fl_table_set_top_row (This.Void_Ptr, Interfaces.C.int (Value) - 1); + end Set_Top_Row; + + + + + procedure Set_Cursor_Kind + (This : in out Table; + Kind : in Mouse_Cursor_Kind) is + begin + fl_table_change_cursor (This.Void_Ptr, Cursor_Values (Kind)); + end Set_Cursor_Kind; + + + procedure Cursor_To_Row_Column + (This : in Table; + Row, Column : out Positive; + Context : out Table_Context; + Resize : out Resize_Flag) + is + C_Row, C_Column, C_Flag : Interfaces.C.int; + Result : Interfaces.C.int := fl_table_cursor2rowcol + (This.Void_Ptr, C_Row, C_Column, C_Flag); + begin + Row := Positive (C_Row + 1); + Column := Positive (C_Column + 1); + Context := To_Context (Result); + Resize := Resize_Flag'Val (C_Flag); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::cursor2rowcol returned unexpected values with" & Latin.LF & + Latin.HT & "row = " & Interfaces.C.int'Image (C_Row) & Latin.LF & + Latin.HT & "column = " & Interfaces.C.int'Image (C_Column) & Latin.LF & + Latin.HT & "context = " & Interfaces.C.int'Image (Result) & Latin.LF & + Latin.HT & "resize = " & Interfaces.C.int'Image (C_Flag); + end Cursor_To_Row_Column; + + + procedure Get_Visible_Cells + (This : in Table; + Row_Top : out Positive; + Column_Left : out Positive; + Row_Bottom : out Natural; + Column_Right : out Natural) + is + C_Row_Top, C_Row_Bottom, C_Column_Left, C_Column_Right : Interfaces.C.int; + begin + fl_table_visible_cells + (This.Void_Ptr, + C_Row_Top, C_Row_Bottom, + C_Column_Left, C_Column_Right); + Row_Top := Positive (C_Row_Top + 1); + Row_Bottom := Positive (C_Row_Bottom + 1); + Column_Left := Natural (C_Column_Left + 1); + Column_Right := Natural (C_Column_Right + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::visible_cells returned unexpected values with" & Latin.LF & + Latin.HT & "row_top = " & Interfaces.C.int'Image (C_Row_Top) & Latin.LF & + Latin.HT & "row_bottom = " & Interfaces.C.int'Image (C_Row_Bottom) & Latin.LF & + Latin.HT & "column_left = " & Interfaces.C.int'Image (C_Column_Left) & Latin.LF & + Latin.HT & "column_right = " & Interfaces.C.int'Image (C_Column_Right); + end Get_Visible_Cells; + + + procedure Get_Selection + (This : in Table; + Row_Top : out Positive; + Column_Left : out Positive; + Row_Bottom : out Positive; + Column_Right : out Positive) + is + C_Row_Top, C_Column_Left, C_Row_Bottom, C_Column_Right : Interfaces.C.int; + begin + fl_table_get_selection + (This.Void_Ptr, + C_Row_Top, C_Column_Left, + C_Row_Bottom, C_Column_Right); + Row_Top := Positive (C_Row_Top + 1); + Column_Left := Positive (C_Column_Left + 1); + Row_Bottom := Positive (C_Row_Bottom + 1); + Column_Right := Positive (C_Column_Right + 1); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::get_selection returned unexpected values with" & Latin.LF & + Latin.HT & "row_top = " & Interfaces.C.int'Image (C_Row_Top) & Latin.LF & + Latin.HT & "column_left = " & Interfaces.C.int'Image (C_Column_Left) & Latin.LF & + Latin.HT & "row_bottom = " & Interfaces.C.int'Image (C_Row_Bottom) & Latin.LF & + Latin.HT & "column_right = " & Interfaces.C.int'Image (C_Column_Right); + end Get_Selection; + + + procedure Set_Selection + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive) is + begin + fl_table_set_selection + (This.Void_Ptr, + Interfaces.C.int (Row_Top) - 1, + Interfaces.C.int (Column_Left) - 1, + Interfaces.C.int (Row_Bottom) - 1, + Interfaces.C.int (Column_Right) - 1); + end Set_Selection; + + + function Is_Selected + (This : in Table; + Row, Column : in Positive) + return Boolean + is + Result : Interfaces.C.int := fl_table_is_selected + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Column) - 1); + begin + return Boolean'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::is_selected returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Is_Selected; + + + procedure Move_Cursor + (This : in out Table; + Row, Column : in Positive; + Shift_Select : in Boolean := True) + is + Result : Interfaces.C.int := fl_table_move_cursor + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Column) - 1, + Boolean'Pos (Shift_Select)); + begin + pragma Assert (Result in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Table::move_cursor returned unexpected value of " & + Interfaces.C.int'Image (Result); + end Move_Cursor; + + + function Move_Cursor + (This : in out Table; + Row, Column : in Positive; + Shift_Select : in Boolean := True) + return Boolean + is + Result : Interfaces.C.int := fl_table_move_cursor + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Column) - 1, + Boolean'Pos (Shift_Select)); + begin + return Boolean'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::move_cursor returned unexpected value of " & + Interfaces.C.int'Image (Result); + end Move_Cursor; + + + function Get_Tab_Mode + (This : in Table) + return Tab_Navigation + is + Result : Interfaces.C.int := fl_table_get_tab_cell_nav (This.Void_Ptr); + begin + return Tab_Navigation'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::tab_cell_nav returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Tab_Mode; + + + procedure Set_Tab_Mode + (This : in out Table; + Value : in Tab_Navigation) is + begin + fl_table_set_tab_cell_nav (This.Void_Ptr, Tab_Navigation'Pos (Value)); + end Set_Tab_Mode; + + + function Get_Table_Box + (This : in Table) + return Box_Kind + is + Result : Interfaces.C.int := fl_table_get_table_box (This.Void_Ptr); + begin + return Box_Kind'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::table_box returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Table_Box; + + + procedure Set_Table_Box + (This : in out Table; + Box : in Box_Kind) is + begin + fl_table_set_table_box (This.Void_Ptr, Box_Kind'Pos (Box)); + end Set_Table_Box; + + + + + function Get_Scrollbar_Size + (This : in Table) + return Integer is + begin + return Integer (fl_table_get_scrollbar_size (This.Void_Ptr)); + end Get_Scrollbar_Size; + + + procedure Set_Scrollbar_Size + (This : in out Table; + Value : in Integer) is + begin + fl_table_set_scrollbar_size (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Scrollbar_Size; + + + procedure Resize + (This : in out Table; + X, Y, W, H : in Integer) is + begin + fl_table_resize + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + function Is_Interactive_Resize + (This : in Table) + return Boolean + is + Result : Interfaces.C.int := fl_table_is_interactive_resize (This.Void_Ptr); + begin + return Boolean'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table::is_interactive_resize returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Is_Interactive_Resize; + + + procedure Reset_Sizes + (This : in out Table) is + begin + fl_table_init_sizes (This.Void_Ptr); + end Reset_Sizes; + + + procedure Recalculate_Dimensions + (This : in out Table) is + begin + fl_table_recalc_dimensions (This.Void_Ptr); + end Recalculate_Dimensions; + + + procedure Table_Resized + (This : in out Table) is + begin + fl_table_table_resized (This.Void_Ptr); + end Table_Resized; + + + procedure Table_Scrolled + (This : in out Table) is + begin + fl_table_table_scrolled (This.Void_Ptr); + end Table_Scrolled; + + + + + procedure Draw + (This : in out Table) is + begin + Group (This).Draw; + end Draw; + + + procedure Draw_Cell + (This : in out Table; + Context : in Table_Context; + Row, Column : in Natural := 0; + X, Y, W, H : in Integer := 0) + is + C_Row, C_Column : Interfaces.C.int; + begin + case Context is + when Row_Header => + C_Row := Interfaces.C.int (Row) - 1; + C_Column := Interfaces.C.int (Column); + when Column_Header => + C_Row := Interfaces.C.int (Row); + C_Column := Interfaces.C.int (Column) - 1; + when Within_Cell => + C_Row := Interfaces.C.int (Row) - 1; + C_Column := Interfaces.C.int (Column) - 1; + when others => + C_Row := Interfaces.C.int (Row); + C_Column := Interfaces.C.int (Column); + end case; + fl_table_draw_cell + (This.Void_Ptr, + To_Cint (Context), + C_Row, C_Column, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Draw_Cell; + + + procedure Redraw_Range + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive) is + begin + fl_table_redraw_range + (This.Void_Ptr, + Interfaces.C.int (Row_Top) - 1, + Interfaces.C.int (Row_Bottom) - 1, + Interfaces.C.int (Column_Left) - 1, + Interfaces.C.int (Column_Right) - 1); + end Redraw_Range; + + + procedure Damage_Zone + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive; + Reach_Row : in Positive := 1; + Reach_Column : in Positive := 1) is + begin + fl_table_damage_zone + (This.Void_Ptr, + Interfaces.C.int (Row_Top) - 1, + Interfaces.C.int (Column_Left) - 1, + Interfaces.C.int (Row_Bottom) - 1, + Interfaces.C.int (Column_Right) - 1, + Interfaces.C.int (Reach_Row) - 1, + Interfaces.C.int (Reach_Column) - 1); + end Damage_Zone; + + + procedure Cell_Dimensions + (This : in Table; + Context : in Table_Context; + Row, Column : in Positive; + X, Y, W, H : out Integer) + is + Result : Interfaces.C.int := fl_table_find_cell + (This.Void_Ptr, + To_Cint (Context), + Interfaces.C.int (Row) - 1, + Interfaces.C.int (Column) - 1, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + begin + if Result = -1 then + raise Out_Of_Range_Error with + "Row = " & Integer'Image (Row) & ", Column = " & Integer'Image (Column); + else + pragma Assert (Result = 0); + end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Table::find_cell returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Cell_Dimensions; + + + procedure Bounding_Region + (This : in Table; + Context : in Table_Context; + X, Y, W, H : out Integer) is + begin + fl_table_get_bounds + (This.Void_Ptr, + To_Cint (Context), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Bounding_Region; + + + procedure Row_Column_Clamp + (This : in Table; + Context : in Table_Context; + Row, Column : in out Integer) + is + C_Row : Interfaces.C.int := Interfaces.C.int (Row) - 1; + C_Column : Interfaces.C.int := Interfaces.C.int (Column) - 1; + Result : Interfaces.C.int := fl_table_row_col_clamp + (This.Void_Ptr, + To_Cint (Context), + C_Row, C_Column); + begin + pragma Assert (Result in 0 .. 1); + Row := Integer (C_Row) + 1; + Column := Integer (C_Column) + 1; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Table::row_col_clamp returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Row_Column_Clamp; + + + function Row_Column_Clamp + (This : in Table; + Context : in Table_Context; + Row, Column : in out Integer) + return Boolean + is + C_Row : Interfaces.C.int := Interfaces.C.int (Row) - 1; + C_Column : Interfaces.C.int := Interfaces.C.int (Column) - 1; + Result : Interfaces.C.int := fl_table_row_col_clamp + (This.Void_Ptr, + To_Cint (Context), + C_Row, C_Column); + begin + pragma Assert (Result in 0 .. 1); + Row := Integer (C_Row) + 1; + Column := Integer (C_Column) + 1; + return Boolean'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Table::row_col_clamp returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Row_Column_Clamp; + + + function Handle + (This : in out Table; + Event : in Event_Kind) + return Event_Outcome is + begin + return Group (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Groups.Tables; + + diff --git a/body/fltk-widgets-groups.adb b/body/fltk-widgets-groups.adb index e7c8780..3b2e287 100644 --- a/body/fltk-widgets-groups.adb +++ b/body/fltk-widgets-groups.adb @@ -388,8 +388,8 @@ package body FLTK.Widgets.Groups is function Find - (This : in Group; - Item : in out Widget'Class) + (This : in Group; + Item : in Widget'Class) return Extended_Index is Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr); diff --git a/doc/fl_group.html b/doc/fl_group.html index 5608697..80f9406 100644 --- a/doc/fl_group.html +++ b/doc/fl_group.html @@ -289,8 +289,8 @@ int find(const Fl_Widget &o) const; 
 function Find
-       (This : in     Group;
-        Item : in out Widget'Class)
+       (This : in Group;
+        Item : in Widget'Class)
     return Extended_Index;
diff --git a/doc/fl_table.html b/doc/fl_table.html new file mode 100644 index 0000000..710ac5c --- /dev/null +++ b/doc/fl_table.html @@ -0,0 +1,1343 @@ + + + + + + Fl_Table Binding Map + + + + + + +

Fl_Table Binding Map

+ + +Back to Index + + + + + + + + + + +
Package name
Fl_TableFLTK.Widgets.Groups.Tables
+ +

Note:

+This Table type should really be abstract but cannot be for technical binding reasons. +If you try to use it directly you will get issues with the draw_cell method. Either +extend it and override that subprogram or use types already extended from it.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Types
Fl_TableTable
 Table_Reference
TableContextTable_Context
ResizeFlagResize_Flag
intTab_Navigation
+ + + + + + + + + + + +
Errors
intOut_Of_Range_Error
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Protected Attributes
+int botrow;
+
Intentionally left unbound.
+int current_col;
+
Intentionally left unbound.
+int current_row;
+
Intentionally left unbound.
+Fl_Scrollbar * hscrollbar;
+
+function H_Bar
+       (This : in out Table)
+    return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+int leftcol;
+
Intentionally left unbound.
+int leftcol_scrollpos;
+
Intentionally left unbound.
+int rightcol;
+
Intentionally left unbound.
+int select_col;
+
Intentionally left unbound.
+int select_row;
+
Intentionally left unbound.
+Fl_Scroll * table;
+
+function Scroll_Area
+       (This : in out Table)
+    return Scrolls.Scroll_Reference;
+
+int table_h;
+
Intentionally left unbound.
+int table_w;
+
Intentionally left unbound.
+int tih;
+
Intentionally left unbound.
+int tiw;
+
Intentionally left unbound.
+int tix;
+
Intentionally left unbound.
+int tiy;
+
Intentionally left unbound.
+int toh;
+
Intentionally left unbound.
+int toprow;
+
Intentionally left unbound.
+int toprow_scrollpos;
+
Intentionally left unbound.
+int tow;
+
Intentionally left unbound.
+int tox;
+
Intentionally left unbound.
+int toy;
+
Intentionally left unbound.
+Fl_Scrollbar * vscrollbar;
+
+function V_Bar
+       (This : in out Table)
+    return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+int wih;
+
Intentionally left unbound.
+int wiw;
+
Intentionally left unbound.
+int wix;
+
Intentionally left unbound.
+int wiy;
+
Intentionally left unbound.
+ + + + + + + + + + + + + + + + +
Constructors
+Fl_Table(int X, int Y, int W, int H, const char *l=0);
+
+function Create
+       (X, Y, W, H : in Integer;
+        Text       : in String := "")
+    return Table;
+
Rely on the automatic use of begin when a group is created, or use begin/end +explicitly, or add each widget to its intended parent group manually.
+function Create
+       (Parent     : in out Groups.Group'Class;
+        X, Y, W, H : in     Integer;
+        Text       : in     String := "")
+    return Table;
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Functions and Procedures
+void add(Fl_Widget &wgt);
+
+void add(Fl_Widget *wgt);
+
+procedure Add
+       (This : in out Table;
+        Item : in out Widget'Class);
+
+Fl_Widget * const * array();
+
Use iterators instead.
+void begin();
+
+procedure Begin_Current
+       (This : in out Table);
+
+void callback(Fl_Widget *, void *);
+
(This signature is wrong due to Doxygen weirdness.)
+procedure Set_Callback
+       (This : in out Table;
+        Func : in     Widget_Callback);
+
+int callback_col();
+
+function Callback_Column
+       (This : in Table)
+    return Positive;
+
+TableContext callback_context();
+
+function Callback_Context
+       (This : in Table)
+    return Table_Context;
+
+int callback_row();
+
+function Callback_Row
+       (This : in Table)
+    return Positive;
+
Check if the index value is in range manually.
+function Has_Child
+       (This  : in Table;
+        Place : in Index)
+    return Boolean;
+
 
+function Has_Child
+       (Place : in Cursor)
+    return Boolean;
+
+Fl_Widget * child(int n) const;
+
+function Child
+       (This  : in Table;
+        Place : in Index)
+    return Widget_Reference
+with Pre => This.Has_Child (Place);
+
 
+function Child
+       (This  : in Table;
+        Place : in Cursor)
+    return Widget_Reference;
+
+int children() const;
+
+function Number_Of_Children
+       (This : in Table)
+    return Natural;
+
+virtual void clear();
+
+procedure Clear
+       (This : in out Table);
+
+int col_header();
+
+function Column_Headers_Enabled
+       (This : in Table)
+    return Boolean;
+
+void col_header(int flag);
+
+procedure Set_Column_Headers
+       (This  : in out Table;
+        Value : in     Boolean);
+
+Fl_Color col_header_color();
+
+function Get_Column_Header_Color
+       (This : in Table)
+    return Color;
+
+void col_header_color(Fl_Color val);
+
+procedure Set_Column_Header_Color
+       (This  : in out Table;
+        Value : in     Color);
+
+int col_header_height();
+
+function Get_Column_Header_Height
+       (This : in Table)
+    return Positive;
+
+void col_header_height(int height);
+
+procedure Set_Column_Header_Height
+       (This  : in out Table;
+        Value : in     Positive);
+
+int col_position();
+
+function Get_Column_Position
+       (This : in Table)
+    return Positive;
+
+void col_position(int col);
+
+procedure Set_Column_Position
+       (This  : in out Table;
+        Value : in     Positive);
+
+int col_resize();
+
+function Column_Resize_Allowed
+       (This : in Table)
+    return Boolean;
+
+void col_resize(int flag);
+
+procedure Set_Column_Resize
+       (This  : in out Table;
+        Value : in     Boolean);
+
+int col_resize_min();
+
+function Get_Column_Resize_Minimum
+       (This : in Table)
+    return Positive;
+
+void col_resize_min(int val);
+
+procedure Set_Column_Resize_Minimum
+       (This  : in out Table;
+        Value : in     Positive);
+
+int col_width(int col);
+
+function Get_Column_Width
+       (This   : in Table;
+        Column : in Positive)
+    return Positive;
+
+void col_width(int col, int width);
+
+procedure Set_Column_Width
+       (This   : in out Table;
+        Column : in     Positive;
+        Value  : in     Positive);
+
+void col_width_all(int width);
+
+procedure Set_All_Columns_Width
+       (This  : in out Table;
+        Value : in     Positive);
+
+int cols();
+
+function Get_Columns
+       (This : in Table)
+    return Natural;
+
+virtual void cols(int val);
+
+procedure Set_Columns
+       (This  : in out Table;
+        Value : in     Natural);
+
+void do_callback(TableContext context, int row, int col);
+
+procedure Do_Callback
+       (This        : in out Table;
+        Context     : in     Table_Context;
+        Row, Column : in     Positive);
+
+void draw(void);
+
+procedure Draw
+       (This : in out Table);
+
+void end();
+
+procedure End_Current
+       (This : in out Table);
+
+int find(const Fl_Widget &wgt) const;
+
+int find(const Fl_Widget *wgt) const;
+
+function Find
+       (This : in Table;
+        Item : in Widget'Class)
+    return Extended_Index;
+
+void get_selection(int &row_top, int &col_left,
+    int &row_bot, int &col_right);
+
+procedure Get_Selection
+       (This         : in     Table;
+        Row_Top      :    out Positive;
+        Column_Left  :    out Positive;
+        Row_Bottom   :    out Positive;
+        Column_Right :    out Positive);
+
+void init_sizes();
+
+procedure Reset_Sizes
+       (This : in out Table);
+
+void insert(Fl_Widget &wgt, Fl_Widget &w2);
+
+procedure Insert
+       (This   : in out Table;
+        Item   : in out Widget'Class;
+        Before : in     Widget'Class);
+
+void insert(Fl_Widget &wgt, int n);
+
+procedure Insert
+       (This  : in out Table;
+        Item  : in out Widget'Class;
+        Place : in     Index);
+
+int is_interactive_resize();
+
+function Is_Interactive_Resize
+       (This : in Table)
+    return Boolean;
+
+int is_selected(int r, int c);
+
+function Is_Selected
+       (This        : in Table;
+        Row, Column : in Positive)
+    return Boolean;
+
+int move_cursor(int R, int C);
+
+int move_cursor(int R, int C, int shiftselect);
+
+procedure Move_Cursor
+       (This         : in out Table;
+        Row, Column  : in     Positive;
+        Shift_Select : in     Boolean := True);
+
+function Move_Cursor
+       (This         : in out Table;
+        Row, Column  : in     Positive;
+        Shift_Select : in     Boolean := True)
+    return Boolean;
+
+void remove(Fl_Widget &wgt);
+
+procedure Remove
+       (This : in out Table;
+        Item : in out Widget'Class);
+
+void resize(int X, int Y, int W, int H);
+
+procedure Resize
+       (This       : in out Table;
+        X, Y, W, H : in     Integer);
+
+int row_header();
+
+function Row_Headers_Enabled
+       (This : in Table)
+    return Boolean;
+
+void row_header(int flag);
+
+procedure Set_Row_Headers
+       (This  : in out Table;
+        Value : in     Boolean);
+
+Fl_Color row_header_color();
+
+function Get_Row_Header_Color
+       (This : in Table)
+    return Color;
+
+void row_header_color(Fl_Color val);
+
+procedure Set_Row_Header_Color
+       (This  : in out Table;
+        Value : in     Color);
+
+int row_header_width();
+
+function Get_Row_Header_Width
+       (This : in Table)
+    return Positive;
+
+void row_header_width(int width);
+
+procedure Set_Row_Header_Width
+       (This  : in out Table;
+        Value : in     Positive);
+
+int row_height(int row);
+
+function Get_Row_Height
+       (This : in Table;
+        Row  : in Positive)
+    return Positive;
+
+void row_height(int row, int height);
+
+procedure Set_Row_Height
+       (This  : in out Table;
+        Row   : in     Positive;
+        Value : in     Positive);
+
+void row_height_all(int height);
+
+procedure Set_All_Rows_Height
+       (This  : in out Table;
+        Value : in     Positive);
+
+int row_position();
+
+function Get_Row_Position
+       (This : in Table)
+    return Positive;
+
+void row_position(int row);
+
+procedure Set_Row_Position
+       (This  : in out Table;
+        Value : in     Positive);
+
+int row_resize();
+
+function Row_Resize_Allowed
+       (This : in Table)
+    return Boolean;
+
+void row_resize(int flag);
+
+procedure Set_Row_Resize
+       (This  : in out Table;
+        Value : in     Boolean);
+
+int row_resize_min();
+
+function Get_Row_Resize_Minimum
+       (This : in Table)
+    return Positive;
+
+void row_resize_min(int val);
+
+procedure Set_Row_Resize_Minimum
+       (This  : in out Table;
+        Value : in     Positive);
+
+int rows();
+
+function Get_Rows
+       (This : in Table)
+    return Natural;
+
+virtual void rows(int val);
+
+procedure Set_Rows
+       (This  : in out Table;
+        Value : in     Natural);
+
+int scrollbar_size() const;
+
+function Get_Scrollbar_Size
+       (This : in Table)
+    return Integer;
+
+void scrollbar_size(int newSize);
+
+procedure Set_Scrollbar_Size
+       (This  : in out Table;
+        Value : in     Integer);
+
+void set_selection(int row_top, int col_left,
+    int row_bot, int col_right);
+
+procedure Set_Selection
+       (This         : in out Table;
+        Row_Top      : in     Positive;
+        Column_Left  : in     Positive;
+        Row_Bottom   : in     Positive;
+        Column_Right : in     Positive);
+
+int tab_cell_nav() const;
+
+function Get_Tab_Mode
+       (This : in Table)
+    return Tab_Navigation;
+
+void tab_cell_nav(int val);
+
+procedure Set_Tab_Mode
+       (This  : in out Table;
+        Value : in     Tab_Navigation);
+
+void table_box(Fl_Boxtype val);
+
+procedure Set_Table_Box
+       (This : in out Table;
+        Box  : in     Box_Kind);
+
+Fl_Boxtype table_box(void);
+
+function Get_Table_Box
+       (This : in Table)
+    return Box_Kind;
+
+int top_row();
+
+function Get_Top_Row
+       (This : in Table)
+    return Positive;
+
+void top_row(int row);
+
+procedure Set_Top_Row
+       (This  : in out Table;
+        Value : in     Positive);
+
+void visible_cells(int &r1, int &r2, int &c1, int &c2);
+
+procedure Get_Visible_Cells
+       (This         : in     Table;
+        Row_Top      :    out Positive;
+        Column_Left  :    out Positive;
+        Row_Bottom   :    out Natural;
+        Column_Right :    out Natural);
+
+void when(Fl_When flags);
+
+procedure Set_When
+       (This  : in out Table;
+        Value : in     Callback_Flag);
+
+ + + + + + + + + + + +
Static Protected Functions and Procedures
+static void scroll_cb(Fl_Widget *, void *);
+
+procedure Scroll_Callback
+       (Item : in out Widget'Class);
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Protected Functions and Procedures
+void change_cursor(Fl_Cursor newcursor);
+
+procedure Set_Cursor_Kind
+       (This : in out Table;
+        Kind : in     Mouse_Cursor_Kind);
+
+long col_scroll_position(int col);
+
+function Get_Column_Scroll_Position
+       (This   : in Table;
+        Column : in Positive)
+    return Long_Integer;
+
+TableContext cursor2rowcol(int &R, int &C, ResizeFlag &resizeflag);
+
+procedure Cursor_To_Row_Column
+       (This        : in     Table;
+        Row, Column :    out Positive;
+        Context     :    out Table_Context;
+        Resize      :    out Resize_Flag);
+
+void damage_zone(int r1, int c1, int r2, int c2, int r3=0, int c3=0);
+
+procedure Damage_Zone
+       (This         : in out Table;
+        Row_Top      : in     Positive;
+        Column_Left  : in     Positive;
+        Row_Bottom   : in     Positive;
+        Column_Right : in     Positive;
+        Reach_Row    : in     Positive := 1;
+        Reach_Column : in     Positive := 1);
+
+virtual void draw_cell(TableContext context, int R=0, int C=0,
+    int X=0, int Y=0, int W=0, int H=0);
+
+procedure Draw_Cell
+       (This        : in out Table;
+        Context     : in     Table_Context;
+        Row, Column : in     Natural := 0;
+        X, Y, W, H  : in     Integer := 0);
+
+int find_cell(TableContext context, int R, int C,
+    int &X, int &Y, int &W, int &H);
+
+procedure Cell_Dimensions
+       (This        : in     Table;
+        Context     : in     Table_Context;
+        Row, Column : in     Positive;
+        X, Y, W, H  :    out Integer);
+
+void get_bounds(TableContext context, int &X, int &Y, int &W, int &H);
+
+procedure Bounding_Region
+       (This       : in     Table;
+        Context    : in     Table_Context;
+        X, Y, W, H :    out Integer);
+
+int handle(int e);
+
+function Handle
+       (This  : in out Table;
+        Event : in     Event_Kind)
+    return Event_Outcome;
+
+int is_fltk_container();
+
+function Used_As_Container
+       (This : in Table)
+    return Boolean;
+
+void recalc_dimensions();
+
+procedure Recalculate_Dimensions
+       (This : in out Table);
+
+void redraw_range(int topRow, int botRow, int leftCol, int rightCol);
+
+procedure Redraw_Range
+       (This         : in out Table;
+        Row_Top      : in     Positive;
+        Column_Left  : in     Positive;
+        Row_Bottom   : in     Positive;
+        Column_Right : in     Positive);
+
+int row_col_clamp(TableContext context, int &R, int &C);
+
+procedure Row_Column_Clamp
+       (This        : in     Table;
+        Context     : in     Table_Context;
+        Row, Column : in out Integer);
+
+function Row_Column_Clamp
+       (This        : in     Table;
+        Context     : in     Table_Context;
+        Row, Column : in out Integer)
+    return Boolean;
+
+long row_scroll_position(int row);
+
+function Get_Row_Scroll_Position
+       (This : in Table;
+        Row  : in Positive)
+    return Long_Integer;
+
+void table_resized();
+
+procedure Table_Resized
+       (This : in out Table);
+
+void table_scrolled();
+
+procedure Table_Scrolled
+       (This : in out Table);
+
+ + + + + diff --git a/doc/index.html b/doc/index.html index faff436..52590b3 100644 --- a/doc/index.html +++ b/doc/index.html @@ -115,7 +115,7 @@
  • Fl_Spinner
  • Fl_Surface_Device
  • Fl_Sys_Menu_Bar
    • -
  • Fl_Table
    • +
  • Fl_Table
  • Fl_Table_Row
  • Fl_Tabs
  • Fl_Text_Buffer
    • @@ -210,6 +210,7 @@
  • FLTK.Widgets.Groups.Scrolls
  • FLTK.Widgets.Groups.Spinners
  • FLTK.Widgets.Groups.Tabbed
    • +
  • FLTK.Widgets.Groups.Tables
  • FLTK.Widgets.Groups.Text_Displays
  • FLTK.Widgets.Groups.Text_Displays.Text_Editors
  • FLTK.Widgets.Groups.Tiled
    • diff --git a/progress.txt b/progress.txt index 4347f65..717585c 100644 --- a/progress.txt +++ b/progress.txt @@ -79,6 +79,7 @@ FLTK.Widgets.Groups.Packed FLTK.Widgets.Groups.Scrolls FLTK.Widgets.Groups.Spinners FLTK.Widgets.Groups.Tabbed +FLTK.Widgets.Groups.Tables FLTK.Widgets.Groups.Text_Displays FLTK.Widgets.Groups.Text_Displays.Text_Editors FLTK.Widgets.Groups.Tiled @@ -143,7 +144,6 @@ Fl_GDI_Printer_Graphics_Driver Fl_Glut_Window Fl_Postscript_Graphics_Driver Fl_Quartz_Graphics_Driver -Fl_Table Fl_Table_Row Fl_Tree Fl_Tree_Item @@ -204,6 +204,9 @@ code for Fl_Menu_Item::test_shortcut seems to use FL_SUBMENU to assume userdata points to another menu item array, not FL_SUBMENU_POINTER, is this still in the latest version? +Fl_Table::callback has wrong signature, still around and unfixed in 1.4 +possibly this hasn't been noticed because it's only visible to doxygen + diff --git a/spec/fltk-widgets-groups-tables.ads b/spec/fltk-widgets-groups-tables.ads new file mode 100644 index 0000000..7d398b5 --- /dev/null +++ b/spec/fltk-widgets-groups-tables.ads @@ -0,0 +1,614 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Widgets.Groups.Scrolls, + FLTK.Widgets.Valuators.Sliders.Scrollbars; + +private with + + Interfaces.C; + + +package FLTK.Widgets.Groups.Tables is + + + type Table is new Group with private; + + type Table_Reference (Data : not null access Table'Class) is limited null record + with Implicit_Dereference => Data; + + type Table_Context is + (No_Context, Start_Page, End_Page, Row_Header, + Column_Header, Within_Cell, Dead_Zone, Row_Column_Resize); + + type Resize_Flag is (Resize_None, Column_Left, Column_Right, Row_Above, Row_Below); + + type Tab_Navigation is (Widget_Focus, Navigate_Cells); + + + Out_Of_Range_Error : exception; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Table; + + function Create + (Parent : in out Groups.Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Table; + + end Forge; + + + + + function H_Bar + (This : in out Table) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + function V_Bar + (This : in out Table) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + function Scroll_Area + (This : in out Table) + return Scrolls.Scroll_Reference; + + + + + procedure Add + (This : in out Table; + Item : in out Widget'Class); + + procedure Insert + (This : in out Table; + Item : in out Widget'Class; + Place : in Index); + + procedure Insert + (This : in out Table; + Item : in out Widget'Class; + Before : in Widget'Class); + + procedure Remove + (This : in out Table; + Item : in out Widget'Class); + + procedure Clear + (This : in out Table); + + + + + function Has_Child + (This : in Table; + Place : in Index) + return Boolean; + + function Has_Child + (Place : in Cursor) + return Boolean; + + function Child + (This : in Table; + Place : in Index) + return Widget_Reference + with Pre => This.Has_Child (Place); + + function Child + (This : in Table; + Place : in Cursor) + return Widget_Reference; + + function Find + (This : in Table; + Item : in Widget'Class) + return Extended_Index; + + function Number_Of_Children + (This : in Table) + return Natural; + + function Used_As_Container + (This : in Table) + return Boolean; + + + + + procedure Begin_Current + (This : in out Table); + + procedure End_Current + (This : in out Table); + + + + + procedure Set_Callback + (This : in out Table; + Func : in Widget_Callback); + + function Callback_Column + (This : in Table) + return Positive; + + function Callback_Row + (This : in Table) + return Positive; + + function Callback_Context + (This : in Table) + return Table_Context; + + procedure Do_Callback + (This : in out Table; + Context : in Table_Context; + Row, Column : in Positive); + + procedure Set_When + (This : in out Table; + Value : in Callback_Flag); + + -- This is the callback used for the horizontal and vertical scrollbars + -- inside the Table object. Assigning it to other widgets will cause errors. + procedure Scroll_Callback + (Item : in out Widget'Class); + + + + + function Column_Headers_Enabled + (This : in Table) + return Boolean; + + procedure Set_Column_Headers + (This : in out Table; + Value : in Boolean); + + function Get_Column_Header_Color + (This : in Table) + return Color; + + procedure Set_Column_Header_Color + (This : in out Table; + Value : in Color); + + function Get_Column_Header_Height + (This : in Table) + return Positive; + + procedure Set_Column_Header_Height + (This : in out Table; + Value : in Positive); + + function Get_Column_Width + (This : in Table; + Column : in Positive) + return Positive; + + procedure Set_Column_Width + (This : in out Table; + Column : in Positive; + Value : in Positive); + + procedure Set_All_Columns_Width + (This : in out Table; + Value : in Positive); + + function Get_Columns + (This : in Table) + return Natural; + + procedure Set_Columns + (This : in out Table; + Value : in Natural); + + function Get_Column_Position + (This : in Table) + return Positive; + + procedure Set_Column_Position + (This : in out Table; + Value : in Positive); + + function Get_Column_Scroll_Position + (This : in Table; + Column : in Positive) + return Long_Integer; + + function Column_Resize_Allowed + (This : in Table) + return Boolean; + + procedure Set_Column_Resize + (This : in out Table; + Value : in Boolean); + + function Get_Column_Resize_Minimum + (This : in Table) + return Positive; + + procedure Set_Column_Resize_Minimum + (This : in out Table; + Value : in Positive); + + + + + function Row_Headers_Enabled + (This : in Table) + return Boolean; + + procedure Set_Row_Headers + (This : in out Table; + Value : in Boolean); + + function Get_Row_Header_Color + (This : in Table) + return Color; + + procedure Set_Row_Header_Color + (This : in out Table; + Value : in Color); + + function Get_Row_Header_Width + (This : in Table) + return Positive; + + procedure Set_Row_Header_Width + (This : in out Table; + Value : in Positive); + + function Get_Row_Height + (This : in Table; + Row : in Positive) + return Positive; + + procedure Set_Row_Height + (This : in out Table; + Row : in Positive; + Value : in Positive); + + procedure Set_All_Rows_Height + (This : in out Table; + Value : in Positive); + + function Get_Rows + (This : in Table) + return Natural; + + procedure Set_Rows + (This : in out Table; + Value : in Natural); + + function Get_Row_Position + (This : in Table) + return Positive; + + procedure Set_Row_Position + (This : in out Table; + Value : in Positive); + + function Get_Row_Scroll_Position + (This : in Table; + Row : in Positive) + return Long_Integer; + + function Row_Resize_Allowed + (This : in Table) + return Boolean; + + procedure Set_Row_Resize + (This : in out Table; + Value : in Boolean); + + function Get_Row_Resize_Minimum + (This : in Table) + return Positive; + + procedure Set_Row_Resize_Minimum + (This : in out Table; + Value : in Positive); + + function Get_Top_Row + (This : in Table) + return Positive; + + procedure Set_Top_Row + (This : in out Table; + Value : in Positive); + + + + + procedure Set_Cursor_Kind + (This : in out Table; + Kind : in Mouse_Cursor_Kind); + + procedure Cursor_To_Row_Column + (This : in Table; + Row, Column : out Positive; + Context : out Table_Context; + Resize : out Resize_Flag); + + -- Unsure if Row_Bottom and Column_Right can ever be zero, but just to be safe... + procedure Get_Visible_Cells + (This : in Table; + Row_Top : out Positive; + Column_Left : out Positive; + Row_Bottom : out Natural; + Column_Right : out Natural); + + procedure Get_Selection + (This : in Table; + Row_Top : out Positive; + Column_Left : out Positive; + Row_Bottom : out Positive; + Column_Right : out Positive); + + procedure Set_Selection + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive); + + function Is_Selected + (This : in Table; + Row, Column : in Positive) + return Boolean; + + procedure Move_Cursor + (This : in out Table; + Row, Column : in Positive; + Shift_Select : in Boolean := True); + + function Move_Cursor + (This : in out Table; + Row, Column : in Positive; + Shift_Select : in Boolean := True) + return Boolean; + + function Get_Tab_Mode + (This : in Table) + return Tab_Navigation; + + procedure Set_Tab_Mode + (This : in out Table; + Value : in Tab_Navigation); + + function Get_Table_Box + (This : in Table) + return Box_Kind; + + procedure Set_Table_Box + (This : in out Table; + Box : in Box_Kind); + + + + + function Get_Scrollbar_Size + (This : in Table) + return Integer; + + procedure Set_Scrollbar_Size + (This : in out Table; + Value : in Integer); + + procedure Resize + (This : in out Table; + X, Y, W, H : in Integer); + + function Is_Interactive_Resize + (This : in Table) + return Boolean; + + procedure Reset_Sizes + (This : in out Table); + + procedure Recalculate_Dimensions + (This : in out Table); + + procedure Table_Resized + (This : in out Table); + + procedure Table_Scrolled + (This : in out Table); + + + + + procedure Draw + (This : in out Table); + + -- Derived types must override this to handle drawing cells + procedure Draw_Cell + (This : in out Table; + Context : in Table_Context; + Row, Column : in Natural := 0; + X, Y, W, H : in Integer := 0); + + procedure Redraw_Range + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive); + + procedure Damage_Zone + (This : in out Table; + Row_Top : in Positive; + Column_Left : in Positive; + Row_Bottom : in Positive; + Column_Right : in Positive; + Reach_Row : in Positive := 1; + Reach_Column : in Positive := 1); + + procedure Cell_Dimensions + (This : in Table; + Context : in Table_Context; + Row, Column : in Positive; + X, Y, W, H : out Integer); + + procedure Bounding_Region + (This : in Table; + Context : in Table_Context; + X, Y, W, H : out Integer); + + procedure Row_Column_Clamp + (This : in Table; + Context : in Table_Context; + Row, Column : in out Integer); + + function Row_Column_Clamp + (This : in Table; + Context : in Table_Context; + Row, Column : in out Integer) + return Boolean; + + function Handle + (This : in out Table; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Table is new Group with record + Horizon, Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; + Playing_Area : aliased Scrolls.Scroll; + end record; + + overriding procedure Initialize + (This : in out Table); + + overriding procedure Finalize + (This : in out Table); + + procedure Extra_Init + (This : in out Table; + X, Y, W, H : in Integer; + Text : in String); + + procedure Extra_Final + (This : in out Table); + + + function To_Cint + (Context : in Table_Context) + return Interfaces.C.int; + + function To_Context + (Value : in Interfaces.C.int) + return Table_Context; + + + pragma Inline (H_Bar); + pragma Inline (V_Bar); + pragma Inline (Scroll_Area); + + pragma Inline (Add); + pragma Inline (Insert); + pragma Inline (Remove); + + pragma Inline (Has_Child); + pragma Inline (Find); + pragma Inline (Number_Of_Children); + pragma Inline (Used_As_Container); + + pragma Inline (Begin_Current); + pragma Inline (End_Current); + + pragma Inline (Set_Callback); + pragma Inline (Callback_Column); + pragma Inline (Callback_Row); + pragma Inline (Callback_Context); + pragma Inline (Do_Callback); + pragma Inline (Set_When); + pragma Inline (Scroll_Callback); + + pragma Inline (Column_Headers_Enabled); + pragma Inline (Set_Column_Headers); + pragma Inline (Get_Column_Header_Color); + pragma Inline (Set_Column_Header_Color); + pragma Inline (Get_Column_Header_Height); + pragma Inline (Set_Column_Header_Height); + pragma Inline (Get_Column_Width); + pragma Inline (Set_Column_Width); + pragma Inline (Set_All_Columns_Width); + pragma Inline (Get_Columns); + pragma Inline (Set_Columns); + pragma Inline (Get_Column_Position); + pragma Inline (Set_Column_Position); + pragma Inline (Get_Column_Scroll_Position); + pragma Inline (Column_Resize_Allowed); + pragma Inline (Set_Column_Resize); + pragma Inline (Get_Column_Resize_Minimum); + pragma Inline (Set_Column_Resize_Minimum); + + pragma Inline (Row_Headers_Enabled); + pragma Inline (Set_Row_Headers); + pragma Inline (Get_Row_Header_Color); + pragma Inline (Set_Row_Header_Color); + pragma Inline (Get_Row_Header_Width); + pragma Inline (Set_Row_Header_Width); + pragma Inline (Get_Row_Height); + pragma Inline (Set_Row_Height); + pragma Inline (Set_All_Rows_Height); + pragma Inline (Get_Rows); + pragma Inline (Set_Rows); + pragma Inline (Get_Row_Position); + pragma Inline (Set_Row_Position); + pragma Inline (Get_Row_Scroll_Position); + pragma Inline (Row_Resize_Allowed); + pragma Inline (Set_Row_Resize); + pragma Inline (Get_Row_Resize_Minimum); + pragma Inline (Set_Row_Resize_Minimum); + pragma Inline (Get_Top_Row); + pragma Inline (Set_Top_Row); + + pragma Inline (Set_Cursor_Kind); + pragma Inline (Set_Selection); + pragma Inline (Is_Selected); + pragma Inline (Move_Cursor); + pragma Inline (Get_Tab_Mode); + pragma Inline (Set_Tab_Mode); + pragma Inline (Get_Table_Box); + pragma Inline (Set_Table_Box); + + pragma Inline (Get_Scrollbar_Size); + pragma Inline (Set_Scrollbar_Size); + pragma Inline (Resize); + pragma Inline (Is_Interactive_Resize); + pragma Inline (Reset_Sizes); + pragma Inline (Recalculate_Dimensions); + pragma Inline (Table_Resized); + pragma Inline (Table_Scrolled); + + pragma Inline (Draw); + pragma Inline (Redraw_Range); + pragma Inline (Damage_Zone); + pragma Inline (Cell_Dimensions); + pragma Inline (Bounding_Region); + pragma Inline (Handle); + + +end FLTK.Widgets.Groups.Tables; + + diff --git a/spec/fltk-widgets-groups.ads b/spec/fltk-widgets-groups.ads index e66cffa..33c0cb3 100644 --- a/spec/fltk-widgets-groups.ads +++ b/spec/fltk-widgets-groups.ads @@ -102,8 +102,8 @@ package FLTK.Widgets.Groups is return Widget_Reference; function Find - (This : in Group; - Item : in out Widget'Class) + (This : in Group; + Item : in Widget'Class) return Extended_Index; function Number_Of_Children -- cgit