diff options
| -rw-r--r-- | body/c_fl_table_row.cpp | 129 | ||||
| -rw-r--r-- | body/c_fl_table_row.h | 38 | ||||
| -rw-r--r-- | body/fltk-widgets-groups-tables-row.adb | 372 | ||||
| -rw-r--r-- | body/fltk-widgets-groups-tables.adb | 15 | ||||
| -rw-r--r-- | doc/fl_table.html | 2 | ||||
| -rw-r--r-- | doc/fl_table_row.html | 231 | ||||
| -rw-r--r-- | doc/index.html | 3 | ||||
| -rw-r--r-- | progress.txt | 2 | ||||
| -rw-r--r-- | spec/fltk-widgets-groups-tables-row.ads | 137 | ||||
| -rw-r--r-- | spec/fltk-widgets-groups-tables.ads | 6 |
10 files changed, 926 insertions, 9 deletions
diff --git a/body/c_fl_table_row.cpp b/body/c_fl_table_row.cpp new file mode 100644 index 0000000..8094df4 --- /dev/null +++ b/body/c_fl_table_row.cpp @@ -0,0 +1,129 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <FL/Fl_Table_Row.H> +#include "c_fl_table_row.h" + + + + +// Exports from Ada + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + +extern "C" void 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_Row : Fl_Table_Row { +public: + using Fl_Table_Row::find_cell; +}; + + + + +// Attaching all relevant hooks and friends + +class My_Table_Row : public Fl_Table_Row { +public: + using Fl_Table_Row::Fl_Table_Row; + + friend void fl_table_row_draw(ROWTABLE t); + friend void fl_table_row_draw_cell(ROWTABLE t, int e, int r, int c, int x, int y, int w, int h); + friend int fl_table_row_handle(ROWTABLE 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_Row::draw() { + widget_draw_hook(this->user_data()); +} + +void My_Table_Row::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<int>(e), r, c, x, y, w, h); +} + +int My_Table_Row::handle(int e) { + return widget_handle_hook(this->user_data(), e); +} + + + + +// Flattened C API + +ROWTABLE new_fl_table_row(int x, int y, int w, int h, char * label) { + My_Table_Row *t = new My_Table_Row(x, y, w, h, label); + return t; +} + +void free_fl_table_row(ROWTABLE t) { + delete static_cast<My_Table_Row*>(t); +} + + + + +int fl_table_row_get_rows(ROWTABLE t) { + return static_cast<Fl_Table_Row*>(t)->rows(); +} + +void fl_table_row_set_rows(ROWTABLE t, int r) { + static_cast<Fl_Table_Row*>(t)->rows(r); +} + + + + +int fl_table_row_row_selected(ROWTABLE t, int r) { + return static_cast<Fl_Table_Row*>(t)->row_selected(r); +} + +int fl_table_row_select_row(ROWTABLE t, int r, int f) { + return static_cast<Fl_Table_Row*>(t)->select_row(r, f); +} + +void fl_table_row_select_all_rows(ROWTABLE t, int f) { + static_cast<Fl_Table_Row*>(t)->select_all_rows(f); +} + +int fl_table_row_get_type(ROWTABLE t) { + return static_cast<int>(static_cast<Fl_Table_Row*>(t)->type()); +} + +void fl_table_row_set_type(ROWTABLE t, int v) { + static_cast<Fl_Table_Row*>(t)->type(static_cast<Fl_Table_Row::TableRowSelectMode>(v)); +} + + + + +void fl_table_row_draw(ROWTABLE t) { + static_cast<My_Table_Row*>(t)->Fl_Table_Row::draw(); +} + +void fl_table_row_draw_cell(ROWTABLE t, int e, int r, int c, int x, int y, int w, int h) { + static_cast<My_Table_Row*>(t)->Fl_Table_Row::draw_cell + (static_cast<Fl_Table::TableContext>(e), r, c, x, y, w, h); +} + +int fl_table_row_find_cell(ROWTABLE t, int e, int r, int c, int &x, int &y, int &w, int &h) { + return (static_cast<Fl_Table_Row*>(t)->*(&Friend_Table_Row::find_cell)) + (static_cast<Fl_Table::TableContext>(e), r, c, x, y, w, h); +} + +int fl_table_row_handle(ROWTABLE t, int e) { + return static_cast<My_Table_Row*>(t)->Fl_Table_Row::handle(e); +} + + diff --git a/body/c_fl_table_row.h b/body/c_fl_table_row.h new file mode 100644 index 0000000..cb226c4 --- /dev/null +++ b/body/c_fl_table_row.h @@ -0,0 +1,38 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_TABLE_ROW_GUARD +#define FL_TABLE_ROW_GUARD + + +typedef void* ROWTABLE; + + +extern "C" ROWTABLE new_fl_table_row(int x, int y, int w, int h, char * label); +extern "C" void free_fl_table_row(ROWTABLE t); + + +extern "C" int fl_table_row_get_rows(ROWTABLE t); +extern "C" void fl_table_row_set_rows(ROWTABLE t, int r); + + +extern "C" int fl_table_row_row_selected(ROWTABLE t, int r); +extern "C" int fl_table_row_select_row(ROWTABLE t, int r, int f); +extern "C" void fl_table_row_select_all_rows(ROWTABLE t, int f); +extern "C" int fl_table_row_get_type(ROWTABLE t); +extern "C" void fl_table_row_set_type(ROWTABLE t, int v); + + +extern "C" void fl_table_row_draw(ROWTABLE t); +extern "C" void fl_table_row_draw_cell(ROWTABLE t, int e, int r, int c, int x, int y, int w, int h); +extern "C" int fl_table_row_find_cell(ROWTABLE t, int e, int r, int c, + int &x, int &y, int &w, int &h); +extern "C" int fl_table_row_handle(ROWTABLE t, int e); + + +#endif + + diff --git a/body/fltk-widgets-groups-tables-row.adb b/body/fltk-widgets-groups-tables-row.adb new file mode 100644 index 0000000..2063470 --- /dev/null +++ b/body/fltk-widgets-groups-tables-row.adb @@ -0,0 +1,372 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + Interfaces.C; + +use type + + Interfaces.C.int; + + +package body FLTK.Widgets.Groups.Tables.Row is + + + package Chk renames Ada.Assertions; + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_table_row + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_table_row, "new_fl_table_row"); + pragma Inline (new_fl_table_row); + + procedure free_fl_table_row + (T : in Storage.Integer_Address); + pragma Import (C, free_fl_table_row, "free_fl_table_row"); + pragma Inline (free_fl_table_row); + + + + + function fl_table_row_get_rows + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_row_get_rows, "fl_table_row_get_rows"); + pragma Inline (fl_table_row_get_rows); + + procedure fl_table_row_set_rows + (T : in Storage.Integer_Address; + R : in Interfaces.C.int); + pragma Import (C, fl_table_row_set_rows, "fl_table_row_set_rows"); + pragma Inline (fl_table_row_set_rows); + + + + + function fl_table_row_row_selected + (T : in Storage.Integer_Address; + R : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_row_row_selected, "fl_table_row_row_selected"); + pragma Inline (fl_table_row_row_selected); + + function fl_table_row_select_row + (T : in Storage.Integer_Address; + R, F : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_row_select_row, "fl_table_row_select_row"); + pragma Inline (fl_table_row_select_row); + + procedure fl_table_row_select_all_rows + (T : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_table_row_select_all_rows, "fl_table_row_select_all_rows"); + pragma Inline (fl_table_row_select_all_rows); + + function fl_table_row_get_type + (T : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_table_row_get_type, "fl_table_row_get_type"); + pragma Inline (fl_table_row_get_type); + + procedure fl_table_row_set_type + (T : in Storage.Integer_Address; + V : in Interfaces.C.int); + pragma Import (C, fl_table_row_set_type, "fl_table_row_set_type"); + pragma Inline (fl_table_row_set_type); + + + + + procedure fl_table_row_draw + (T : in Storage.Integer_Address); + pragma Import (C, fl_table_row_draw, "fl_table_row_draw"); + pragma Inline (fl_table_row_draw); + + procedure fl_table_row_draw_cell + (T : in Storage.Integer_Address; + E, R, C, X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_table_row_draw_cell, "fl_table_row_draw_cell"); + pragma Inline (fl_table_row_draw_cell); + + function fl_table_row_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_row_find_cell, "fl_table_row_find_cell"); + pragma Inline (fl_table_row_find_cell); + + function fl_table_row_handle + (T : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_table_row_handle, "fl_table_row_handle"); + pragma Inline (fl_table_row_handle); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Row_Table) is + begin + Extra_Final (Table (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Row_Table) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_table_row (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Row_Table; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Table (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Row_Table) is + begin + This.Draw_Ptr := fl_table_row_draw'Address; + This.Handle_Ptr := fl_table_row_handle'Address; + This.Draw_Cell_Ptr := fl_table_row_draw_cell'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Row_Table is + begin + return This : Row_Table do + This.Void_Ptr := new_fl_table_row + (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 Row_Table is + begin + return This : Row_Table := Create (X, Y, W, H, Text) do + Parent.Add (This); + end return; + end Create; + + end Forge; + + + + + procedure Clear + (This : in out Row_Table) is + begin + This.Set_Rows (0); -- Set_Rows is reimplemented. + This.Set_Columns (0); + This.Playing_Area.Clear; + end Clear; + + + + + function Get_Rows + (This : in Row_Table) + return Natural + is + Result : Interfaces.C.int := fl_table_row_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 Row_Table; + Value : in Natural) is + begin + fl_table_row_set_rows (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Rows; + + + + + function Is_Row_Selected + (This : in Row_Table; + Row : in Positive) + return Boolean + is + Result : Interfaces.C.int := fl_table_row_row_selected + (This.Void_Ptr, Interfaces.C.int (Row) - 1); + begin + return Boolean'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table_Row::row_selected returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Is_Row_Selected; + + + procedure Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected) + is + Result : Interfaces.C.int := fl_table_row_select_row + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Selection_State'Pos (Value)); + begin + if Result = -1 then + raise Range_Error with "Row = " & Positive'Image (Row); + else + pragma Assert (Result in 0 .. 1); + end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Table_Row::select_row returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Select_Row; + + + function Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected) + return Boolean + is + Result : Interfaces.C.int := fl_table_row_select_row + (This.Void_Ptr, + Interfaces.C.int (Row) - 1, + Selection_State'Pos (Value)); + begin + if Result = -1 then + raise Range_Error with "Row = " & Positive'Image (Row); + else + return Boolean'Val (Result); + end if; + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table_Row::select_row returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Select_Row; + + + procedure Select_All_Rows + (This : in out Row_Table; + Value : in Selection_State := Selected) is + begin + fl_table_row_select_all_rows (This.Void_Ptr, Selection_State'Pos (Value)); + end Select_All_Rows; + + + function Get_Row_Select_Mode + (This : in Row_Table) + return Row_Select_Mode + is + Result : Interfaces.C.int := fl_table_row_get_type (This.Void_Ptr); + begin + return Row_Select_Mode'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Table_Row::type returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Get_Row_Select_Mode; + + + procedure Set_Row_Select_Mode + (This : in out Row_Table; + Value : in Row_Select_Mode) is + begin + fl_table_row_set_type (This.Void_Ptr, Row_Select_Mode'Pos (Value)); + end Set_Row_Select_Mode; + + + + + procedure Cell_Dimensions + (This : in Row_Table; + Context : in Table_Context; + Row, Column : in Positive; + X, Y, W, H : out Integer) + is + Result : Interfaces.C.int := fl_table_row_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 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_Row::find_cell returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Cell_Dimensions; + + + function Handle + (This : in out Row_Table; + Event : in Event_Kind) + return Event_Outcome is + begin + return Table (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Groups.Tables.Row; + + diff --git a/body/fltk-widgets-groups-tables.adb b/body/fltk-widgets-groups-tables.adb index 9e7fd38..30cc642 100644 --- a/body/fltk-widgets-groups-tables.adb +++ b/body/fltk-widgets-groups-tables.adb @@ -824,8 +824,9 @@ package body FLTK.Widgets.Groups.Tables is procedure Initialize (This : in out Table) is begin - This.Draw_Ptr := fl_table_draw'Address; - This.Handle_Ptr := fl_table_handle'Address; + This.Draw_Ptr := fl_table_draw'Address; + This.Handle_Ptr := fl_table_handle'Address; + This.Draw_Cell_Ptr := fl_table_draw_cell'Address; end Initialize; @@ -1804,6 +1805,12 @@ package body FLTK.Widgets.Groups.Tables is Row, Column : in Natural := 0; X, Y, W, H : in Integer := 0) is + procedure my_draw_cell + (T : in Storage.Integer_Address; + E, R, C, X, Y, W, H : in Interfaces.C.int); + for my_draw_cell'Address use This.Draw_Cell_Ptr; + pragma Import (Ada, my_draw_cell); + C_Row, C_Column : Interfaces.C.int; begin case Context is @@ -1820,7 +1827,7 @@ package body FLTK.Widgets.Groups.Tables is C_Row := Interfaces.C.int (Row); C_Column := Interfaces.C.int (Column); end case; - fl_table_draw_cell + my_draw_cell (This.Void_Ptr, To_Cint (Context), C_Row, C_Column, @@ -1884,7 +1891,7 @@ package body FLTK.Widgets.Groups.Tables is Interfaces.C.int (H)); begin if Result = -1 then - raise Out_Of_Range_Error with + raise Range_Error with "Row = " & Integer'Image (Row) & ", Column = " & Integer'Image (Column); else pragma Assert (Result = 0); diff --git a/doc/fl_table.html b/doc/fl_table.html index 710ac5c..dfd2273 100644 --- a/doc/fl_table.html +++ b/doc/fl_table.html @@ -70,7 +70,7 @@ extend it and override that subprogram or use types already extended from it.</p <tr> <td>int</td> -<td>Out_Of_Range_Error</td> +<td>Range_Error</td> </tr> </table> diff --git a/doc/fl_table_row.html b/doc/fl_table_row.html new file mode 100644 index 0000000..9bfbf64 --- /dev/null +++ b/doc/fl_table_row.html @@ -0,0 +1,231 @@ +<!DOCTYPE html> + +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Fl_Table_Row Binding Map</title> + <link href="map.css" rel="stylesheet"> + </head> + + <body> + + +<h2>Fl_Table_Row Binding Map</h2> + + +<a href="index.html">Back to Index</a> + + +<table class="package"> + <tr><th colspan="2">Package name</th></tr> + + <tr> + <td>Fl_Table_Row</td> + <td>FLTK.Widgets.Groups.Tables.Row</td> + </tr> + +</table> + +<p><b>Note:</b><br /><br /> +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 since +it inherits that from Fl_Table with no change. Either extend it and override that +subprogram or use types already extended from it.</p> + + + +<table class="type"> + <tr><th colspan="2">Types</th></tr> + + <tr> + <td>Fl_Table_Row</td> + <td>Row_Table</td> + </tr> + + <tr> + <td> </td> + <td>Row_Table_Reference</td> + </tr> + + <tr> + <td>TableRowSelectMode</td> + <td>Row_Select_Mode</td> + </tr> + + <tr> + <td>int</td> + <td>Selection_State</td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Constructors</th></tr> + + <tr> +<td><pre> +Fl_Table_Row(int X, int Y, int W, int H, const char *l=0); +</pre></td> +<td><pre> +function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Row_Table; +</pre></td> + </tr> + + <tr> +<td>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.</td> +<td><pre> +function Create + (Parent : in out Groups.Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Row_Table; +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Functions and Procedures</th></tr> + + <tr> +<td><pre> +void clear(); +</pre></td> +<td><pre> +procedure Clear + (This : in out Row_Table); +</pre></td> + </tr> + + <tr> +<td><pre> +int row_selected(int row); +</pre></td> +<td><pre> +function Is_Row_Selected + (This : in Row_Table; + Row : in Positive) + return Boolean; +</pre></td> + </tr> + + <tr> +<td><pre> +int rows(); +</pre></td> +<td><pre> +function Get_Rows + (This : in Row_Table) + return Natural; +</pre></td> + </tr> + + <tr> +<td><pre> +void rows(int val); +</pre></td> +<td><pre> +procedure Set_Rows + (This : in out Row_Table; + Value : in Natural); +</pre></td> + </tr> + + <tr> +<td><pre> +void select_all_rows(int flag=1); +</pre></td> +<td><pre> +procedure Select_All_Rows + (This : in out Row_Table; + Value : in Selection_State := Selected); +</pre></td> + </tr> + + <tr> +<td><pre> +int select_row(int row, int flag=1); +</pre></td> +<td><pre> +procedure Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected); + +function Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected) + return Boolean; +</pre></td> + </tr> + + <tr> +<td><pre> +TableRowSelectMode type() const; +</pre></td> +<td><pre> +function Get_Row_Select_Mode + (This : in Row_Table) + return Row_Select_Mode; +</pre></td> + </tr> + + <tr> +<td><pre> +void type(TableRowSelectMode val); +</pre></td> +<td><pre> +procedure Set_Row_Select_Mode + (This : in out Row_Table; + Value : in Row_Select_Mode); +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Protected Functions and Procedures</th></tr> + + <tr> +<td><pre> +int find_cell(TableContext context, int R, int C, + int &X, int &Y, int &W, int &H); +</pre></td> +<td><pre> +procedure Cell_Dimensions + (This : in Row_Table; + Context : in Table_Context; + Row, Column : in Positive; + X, Y, W, H : out Integer); +</pre></td> + </tr> + + <tr> +<td><pre> +int handle(int event); +</pre></td> +<td><pre> +function Handle + (This : in out Row_Table; + Event : in Event_Kind) + return Event_Outcome; +</pre></td> + </tr> + +</table> + + + </body> +</html> + diff --git a/doc/index.html b/doc/index.html index 52590b3..e8f0a45 100644 --- a/doc/index.html +++ b/doc/index.html @@ -116,7 +116,7 @@ <li><a href="fl_surface_device.html">Fl_Surface_Device</a></li> <li><a href="fl_sys_menu_bar.html">Fl_Sys_Menu_Bar</a></li> <li><a href="fl_table.html">Fl_Table</a></li> - <li>Fl_Table_Row</li> + <li><a href="fl_table_row.html">Fl_Table_Row</a></li> <li><a href="fl_tabs.html">Fl_Tabs</a></li> <li><a href="fl_text_buffer.html">Fl_Text_Buffer</a></li> <li><a href="fl_text_display.html">Fl_Text_Display</a></li> @@ -211,6 +211,7 @@ <li><a href="fl_spinner.html">FLTK.Widgets.Groups.Spinners</a></li> <li><a href="fl_tabs.html">FLTK.Widgets.Groups.Tabbed</a></li> <li><a href="fl_table.html">FLTK.Widgets.Groups.Tables</a></li> + <li><a href="fl_table_row.html">FLTK.Widgets.Groups.Tables.Row</a></li> <li><a href="fl_text_display.html">FLTK.Widgets.Groups.Text_Displays</a></li> <li><a href="fl_text_editor.html">FLTK.Widgets.Groups.Text_Displays.Text_Editors</a></li> <li><a href="fl_tile.html">FLTK.Widgets.Groups.Tiled</a></li> diff --git a/progress.txt b/progress.txt index 717585c..6e2c8b8 100644 --- a/progress.txt +++ b/progress.txt @@ -80,6 +80,7 @@ FLTK.Widgets.Groups.Scrolls FLTK.Widgets.Groups.Spinners FLTK.Widgets.Groups.Tabbed FLTK.Widgets.Groups.Tables +FLTK.Widgets.Groups.Tables.Row FLTK.Widgets.Groups.Text_Displays FLTK.Widgets.Groups.Text_Displays.Text_Editors FLTK.Widgets.Groups.Tiled @@ -144,7 +145,6 @@ Fl_GDI_Printer_Graphics_Driver Fl_Glut_Window Fl_Postscript_Graphics_Driver Fl_Quartz_Graphics_Driver -Fl_Table_Row Fl_Tree Fl_Tree_Item Fl_Tree_Prefs diff --git a/spec/fltk-widgets-groups-tables-row.ads b/spec/fltk-widgets-groups-tables-row.ads new file mode 100644 index 0000000..e51068a --- /dev/null +++ b/spec/fltk-widgets-groups-tables-row.ads @@ -0,0 +1,137 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Groups.Tables.Row is + + + type Row_Table is new Table with private; + + type Row_Table_Reference (Data : not null access Row_Table'Class) is limited null record + with Implicit_Dereference => Data; + + type Row_Select_Mode is (Select_None, Select_Single, Select_Multiple); + + type Selection_State is (Deselected, Selected, Toggle); + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Row_Table; + + function Create + (Parent : in out Groups.Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Row_Table; + + end Forge; + + + + + procedure Clear + (This : in out Row_Table); + + + + + function Get_Rows + (This : in Row_Table) + return Natural; + + procedure Set_Rows + (This : in out Row_Table; + Value : in Natural); + + + + + function Is_Row_Selected + (This : in Row_Table; + Row : in Positive) + return Boolean; + + procedure Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected); + + function Select_Row + (This : in out Row_Table; + Row : in Positive; + Value : in Selection_State := Selected) + return Boolean; + + procedure Select_All_Rows + (This : in out Row_Table; + Value : in Selection_State := Selected); + + function Get_Row_Select_Mode + (This : in Row_Table) + return Row_Select_Mode; + + procedure Set_Row_Select_Mode + (This : in out Row_Table; + Value : in Row_Select_Mode); + + + + + procedure Cell_Dimensions + (This : in Row_Table; + Context : in Table_Context; + Row, Column : in Positive; + X, Y, W, H : out Integer); + + function Handle + (This : in out Row_Table; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Row_Table is new Table with null record; + + overriding procedure Initialize + (This : in out Row_Table); + + overriding procedure Finalize + (This : in out Row_Table); + + procedure Extra_Init + (This : in out Row_Table; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Row_Table) + with Inline; + + + pragma Inline (Get_Rows); + pragma Inline (Set_Rows); + + pragma Inline (Is_Row_Selected); + pragma Inline (Select_Row); + pragma Inline (Select_All_Rows); + pragma Inline (Get_Row_Select_Mode); + pragma Inline (Set_Row_Select_Mode); + + pragma Inline (Cell_Dimensions); + pragma Inline (Handle); + + +end FLTK.Widgets.Groups.Tables.Row; + + diff --git a/spec/fltk-widgets-groups-tables.ads b/spec/fltk-widgets-groups-tables.ads index 7d398b5..5b52623 100644 --- a/spec/fltk-widgets-groups-tables.ads +++ b/spec/fltk-widgets-groups-tables.ads @@ -11,7 +11,8 @@ with private with - Interfaces.C; + Interfaces.C, + System; package FLTK.Widgets.Groups.Tables is @@ -31,7 +32,7 @@ package FLTK.Widgets.Groups.Tables is type Tab_Navigation is (Widget_Focus, Navigate_Cells); - Out_Of_Range_Error : exception; + Range_Error : exception; @@ -493,6 +494,7 @@ private type Table is new Group with record Horizon, Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; Playing_Area : aliased Scrolls.Scroll; + Draw_Cell_Ptr : System.Address; end record; overriding procedure Initialize |