From 66fba2bf75c5fc3deb2690a6a66cf504f47b7652 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 11 Nov 2024 13:32:57 +1300 Subject: Fl_Browser_ binding added --- doc/fl_browser_.html | 744 ++++++++++++++++++++ doc/index.html | 3 +- progress.txt | 2 +- src/c_fl_browser_.cpp | 385 +++++++++++ src/c_fl_browser_.h | 83 +++ src/fltk-widgets-groups-browsers.adb | 1231 ++++++++++++++++++++++++++++++++++ src/fltk-widgets-groups-browsers.ads | 447 ++++++++++++ src/fltk-widgets.ads | 6 +- 8 files changed, 2896 insertions(+), 5 deletions(-) create mode 100644 doc/fl_browser_.html create mode 100644 src/c_fl_browser_.cpp create mode 100644 src/c_fl_browser_.h create mode 100644 src/fltk-widgets-groups-browsers.adb create mode 100644 src/fltk-widgets-groups-browsers.ads diff --git a/doc/fl_browser_.html b/doc/fl_browser_.html new file mode 100644 index 0000000..d69d368 --- /dev/null +++ b/doc/fl_browser_.html @@ -0,0 +1,744 @@ + + + + + + + Fl_Browser_ Binding Map + + + + + + +

Fl_Browser_ Binding Map

+ + +Back to Index + + + + + + + + + + +
Package name
Fl_Browser_FLTK.Widgets.Groups.Browsers
+ +

Note:

+As the name suggests, you will likely never actually touch Abstract_Browser directly. +Only through using or creating types derived from it.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Types
Fl_Browser_Abstract_Browser
 Abstract_Browser_Reference
enum modeScrollbar_Mode
void *Item_Cursor
int flagsSort_Order
+ + + + + + + + + + + + + + + + +
Attributes
+Fl_Scrollbar hscrollbar;
+
+function H_Bar
+       (This : in out Abstract_Browser)
+    return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+Fl_Scrollbar scrollbar;
+
+function V_Bar
+       (This : in out Abstract_Browser)
+    return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+ + + + + + + + + + + +
Constructors
+Fl_Browser_(int X, int Y, int W, int H, const char *L=0);
+
+function Create
+       (X, Y, W, H : in Integer;
+        Text       : in String := "")
+    return Abstract_Browser;
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Functions and Procedures
+int deselect(int docallbacks=0);
+
+function Deselect
+       (This         : in out Abstract_Browser;
+        Do_Callbacks : in     Boolean := False)
+    return Boolean;
+
+void display(void *item);
+
+procedure Display
+       (This : in out Abstract_Browser;
+        Item : in     Item_Cursor);
+
+int handle(int event);
+
+function Handle
+       (This  : in out Abstract_Browser;
+        Event : in     Event_Kind)
+    return Event_Outcome;
+
+uchar has_scrollbar() const;
+
+function Get_Scrollbar_Mode
+       (This : in Abstract_Browser)
+    return Scrollbar_Mode;
+
+void has_scrollbar(uchar mode);
+
+procedure Set_Scrollbar_Mode
+       (This : in out Abstract_Browser;
+        Mode : in     Scrollbar_Mode);
+
+int hposition() const;
+
+function Get_H_Position
+       (This : in Abstract_Browser)
+    return Integer;
+
+void hposition(int);
+
+procedure Set_H_Position
+       (This  : in out Abstract_Browser;
+        Value : in     Integer);
+
+int position() const;
+
+function Get_V_Position
+       (This : in Abstract_Browser)
+    return Integer;
+
+void position(int pos);
+
+procedure Set_V_Position
+       (This  : in out Abstract_Browser;
+        Value : in     Integer);
+
+void resize(int X, int Y, int W, int H);
+
+procedure Resize
+       (This       : in out Abstract_Browser;
+        X, Y, W, H : in     Integer);
+
+void scrollbar_left();
+
+procedure Set_Vertical_Left
+       (This : in out Abstract_Browser);
+
+void scrollbar_right();
+
+procedure Set_Vertical_Right
+       (This : in out Abstract_Browser);
+
+int scrollbar_size() const;
+
+function Get_Scrollbar_Size
+       (This : in Abstract_Browser)
+    return Integer;
+
+void scrollbar_size(int newSize);
+
+procedure Set_Scrollbar_Size
+       (This  : in out Abstract_Browser;
+        Value : in     Integer);
+
+int scrollbar_width() const;
+
Deprecated, see scrollbar_size
+void scrollbar_width(int width);
+
Deprecated, see scrollbar_size
+int select(void *item, int val=1, int docallbacks=0);
+
+function Set_Select
+       (This         : in out Abstract_Browser;
+        Item         : in     Item_Cursor;
+        State        : in     Boolean := True;
+        Do_Callbacks : in     Boolean := False)
+    return Boolean;
+
+int select_only(void *item, int docallbacks=0);
+
+function Select_Only
+       (This         : in out Abstract_Browser;
+        Item         : in     Item_Cursor;
+        Do_Callbacks : in     Boolean := False)
+    return Boolean;
+
+void sort(int flags=0);
+
+procedure Sort
+       (This  : in out Abstract_Browser;
+        Order : in     Sort_Order);
+
+Fl_Color textcolor() const;
+
+function Get_Text_Color
+       (This : in Abstract_Browser)
+    return Color;
+
+void textcolor(Fl_Color col);
+
+procedure Set_Text_Color
+       (This  : in out Abstract_Browser;
+        Value : in     Color);
+
+Fl_Font textfont() const;
+
+function Get_Text_Font
+       (This : in Abstract_Browser)
+    return Font_Kind;
+
+void textfont(Fl_Font font);
+
+procedure Set_Text_Font
+       (This : in out Abstract_Browser;
+        Font : in     Font_Kind);
+
+Fl_Fontsize textsize() const;
+
+function Get_Text_Size
+       (This : in Abstract_Browser)
+    return Font_Size;
+
+void textsize(Fl_Fontsize newSize);
+
+procedure Set_Text_Size
+       (This : in out Abstract_Browser;
+        Size : in     Font_Size);
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Protected Functions and Procedures
+void bbox(int &X, int &Y, int &W, int &H) const;
+
+procedure Bounding_Box
+       (This       : in     Abstract_Browser;
+        X, Y, W, H :    out Integer);
+
+void deleting(void *item);
+
+procedure Deleting
+       (This : in out Abstract_Browser;
+        Item : in     Item_Cursor);
+
+int displayed(void *item) const;
+
+function Is_Displayed
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Boolean;
+
+void draw();
+
+procedure Draw
+       (This : in out Abstract_Browser);
+
+void * find_item(int ypos);
+
+function Find_Item
+       (This  : in Abstract_Browser;
+        Y_Pos : in Integer)
+    return Item_Cursor;
+
+virtual int full_height() const;
+
+function Full_List_Height
+       (This : in Abstract_Browser)
+    return Integer;
+
+virtual int full_width() const;
+
+function Full_List_Width
+       (This : in Abstract_Browser)
+    return Integer;
+
+virtual int incr_height() const;
+
+function Average_Item_Height
+       (This : in Abstract_Browser)
+    return Integer;
+
+void inserting(void *a, void *b);
+
+procedure Inserting
+       (This : in out Abstract_Browser;
+        A, B : in     Item_Cursor);
+
+virtual void * item_at(int index) const;
+
+function Item_At
+       (This  : in Abstract_Browser;
+        Index : in Positive)
+    return Item_Cursor;
+
+virtual void item_draw(void *item,
+    int X, int Y, int W, int H) const =0;
+
+procedure Item_Draw
+       (This       : in Abstract_Browser;
+        Item       : in Item_Cursor;
+        X, Y, W, H : in Integer);
+
+virtual void * item_first() const =0;
+
+function Item_First
+       (This : in Abstract_Browser)
+    return Item_Cursor;
+
+virtual int item_height(void *item) const =0;
+
+function Item_Height
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Integer;
+
+virtual void * item_last() const;
+
+function Item_Last
+       (This : in Abstract_Browser)
+    return Item_Cursor;
+
+virtual void * item_next(void *item) const =0;
+
+function Item_Next
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Item_Cursor;
+
+virtual void * item_prev(void *item) const =0;
+
+function Item_Previous
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Item_Cursor;
+
+virtual int item_quick_height(void *item) const;
+
+function Item_Quick_Height
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Integer;
+
+virtual void item_select(void *item, int val=1);
+
+procedure Item_Select
+       (This  : in out Abstract_Browser;
+        Item  : in     Item_Cursor;
+        State : in     Boolean := True);
+
+virtual int item_selected(void *item) const;
+
+function Item_Selected
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Boolean;
+
+virtual void item_swap(void *a, void *b);
+
+procedure Item_Swap
+       (This : in out Abstract_Browser;
+        A, B : in     Item_Cursor);
+
+virtual const char * item_text(void *item) const;
+
+function Item_Text
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return String;
+
+virtual int item_width(void *item) const =0;
+
+function Item_Width
+       (This : in Abstract_Browser;
+        Item : in Item_Cursor)
+    return Integer;
+
+int leftedge() const;
+
+function Left_Edge
+       (This : in Abstract_Browser)
+    return Integer;
+
+void new_list();
+
+procedure New_List
+       (This : in out Abstract_Browser);
+
+void redraw_line(void *item);
+
+procedure Redraw_Line
+       (This : in out Abstract_Browser;
+        Item : in     Item_Cursor);
+
+void redraw_lines();
+
+procedure Redraw_List
+       (This : in out Abstract_Browser);
+
+void replacing(void *a, void *b);
+
+procedure Replacing
+       (This : in out Abstract_Browser;
+        A, B : in     Item_Cursor);
+
+void * selection() const;
+
+function Current_Selection
+       (This : in Abstract_Browser)
+    return Item_Cursor;
+
+void swapping(void *a, void *b);
+
+procedure Swapping
+       (This : in out Abstract_Browser;
+        A, B : in     Item_Cursor);
+
+void * top() const;
+
+function Top_Item
+       (This : in Abstract_Browser)
+    return Item_Cursor;
+
+ + + + + + diff --git a/doc/index.html b/doc/index.html index 89e6a49..49e17b1 100644 --- a/doc/index.html +++ b/doc/index.html @@ -25,7 +25,7 @@
  • Fl_BMP_Image
  • Fl_Box
  • Fl_Browser
    • -
  • Fl_Browser_
    • +
  • Fl_Browser_
  • Fl_Button
  • Fl_Cairo_Window
  • Fl_Chart
    • @@ -184,6 +184,7 @@
  • FLTK.Widgets.Clocks.Updated
  • FLTK.Widgets.Clocks.Updated.Round
  • FLTK.Widgets.Groups
    • +
  • FLTK.Widgets.Groups.Browsers
  • FLTK.Widgets.Groups.Color_Choosers
  • FLTK.Widgets.Groups.Help_Views
  • FLTK.Widgets.Groups.Input_Choices
    • diff --git a/progress.txt b/progress.txt index 9d13bc2..cc9ece1 100644 --- a/progress.txt +++ b/progress.txt @@ -67,6 +67,7 @@ FLTK.Widgets.Clocks FLTK.Widgets.Clocks.Updated FLTK.Widgets.Clocks.Updated.Round FLTK.Widgets.Groups +FLTK.Widgets.Groups.Browsers FLTK.Widgets.Groups.Color_Choosers FLTK.Widgets.Groups.Help_Views FLTK.Widgets.Groups.Input_Choices @@ -136,7 +137,6 @@ FLTK.Devices.Surfaces (incomplete API, otherwise polished) To-Do: Fl_Browser -Fl_Browser_ Fl_Cairo_Window Fl_Check_Browser Fl_Display_Device diff --git a/src/c_fl_browser_.cpp b/src/c_fl_browser_.cpp new file mode 100644 index 0000000..9d8678f --- /dev/null +++ b/src/c_fl_browser_.cpp @@ -0,0 +1,385 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_fl_browser_.h" + + + + +const int fl_sort_ascending = FL_SORT_ASCENDING; +const int fl_sort_descending = FL_SORT_DESCENDING; + + + + +// Exports from Ada + +extern "C" int browser_full_width_hook(void * b); +extern "C" int browser_full_height_hook(void * b); +extern "C" int browser_incr_height_hook(void * b); +extern "C" int browser_item_quick_height_hook(void * b, void * i); + +extern "C" int browser_item_width_hook(void * b, void * i); +extern "C" int browser_item_height_hook(void * b, void * i); +extern "C" void * browser_item_first_hook(void * b); +extern "C" void * browser_item_last_hook(void * b); +extern "C" void * browser_item_next_hook(void * b, void * i); +extern "C" void * browser_item_prev_hook(void * b, void * i); +extern "C" void * browser_item_at_hook(void * b, int n); +extern "C" void browser_item_select_hook(void * b, void * i, int s); +extern "C" int browser_item_selected_hook(void * b, void * i); +extern "C" void browser_item_swap_hook(void * b, void * one, void * two); +extern "C" const char * browser_item_text_hook(void * b, void * i); +extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h); + +extern "C" void widget_draw_hook(void * ud); +extern "C" int widget_handle_hook(void * ud, int e); + + + + +// Attaching all relevant hooks and friends + +class My_Browser_ : public Fl_Browser_ { +public: + using Fl_Browser_::Fl_Browser_; + + friend ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label); + + friend void * fl_abstract_browser_selection(ABSTRACTBROWSER b); + friend int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i); + friend void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y); + friend void * fl_abstract_browser_top(ABSTRACTBROWSER b); + + friend void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h); + friend int fl_abstract_browser_leftedge(ABSTRACTBROWSER b); + friend void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i); + friend void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b); + + friend int fl_abstract_browser_full_width(ABSTRACTBROWSER b); + friend int fl_abstract_browser_full_height(ABSTRACTBROWSER b); + friend int fl_abstract_browser_incr_height(ABSTRACTBROWSER b); + friend int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i); + + friend void fl_abstract_browser_new_list(ABSTRACTBROWSER b); + friend void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2); + friend void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item); + friend void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2); + friend void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2); + + friend void fl_abstract_browser_draw(ABSTRACTBROWSER b); + friend int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e); + +protected: + int full_width() const; + int full_height() const; + int incr_height() const; + int item_quick_height(void * item) const; + + int item_width(void * item) const; + int item_height(void * item) const; + void * item_first() const; + void * item_last() const; + void * item_next(void * item) const; + void * item_prev(void * item) const; + void * item_at(int index) const; + void item_select(void * item, int val=1); + int item_selected(void * item) const; + void item_swap(void * a, void * b); + const char * item_text(void * item) const; + void item_draw(void * item, int x, int y, int w, int h) const; + + void draw(); + int handle(int e); +}; + + +int My_Browser_::full_width() const { + return browser_full_width_hook(this->user_data()); +} + +int My_Browser_::full_height() const { + return browser_full_height_hook(this->user_data()); +} + +int My_Browser_::incr_height() const { + return browser_incr_height_hook(this->user_data()); +} + +int My_Browser_::item_quick_height(void * item) const { + return browser_item_quick_height_hook(this->user_data(), item); +} + + +int My_Browser_::item_width(void * item) const { + return browser_item_width_hook(this->user_data(), item); +} + +int My_Browser_::item_height(void * item) const { + return browser_item_height_hook(this->user_data(), item); +} + +void * My_Browser_::item_first() const { + return browser_item_first_hook(this->user_data()); +} + +void * My_Browser_::item_last() const { + return browser_item_last_hook(this->user_data()); +} + +void * My_Browser_::item_next(void * item) const { + return browser_item_next_hook(this->user_data(), item); +} + +void * My_Browser_::item_prev(void * item) const { + return browser_item_prev_hook(this->user_data(), item); +} + +void * My_Browser_::item_at(int index) const { + return browser_item_at_hook(this->user_data(), index); +} + +void My_Browser_::item_select(void * item, int val) { + browser_item_select_hook(this->user_data(), item, val); +} + +int My_Browser_::item_selected(void * item) const { + return browser_item_selected_hook(this->user_data(), item); +} + +void My_Browser_::item_swap(void * a, void * b) { + browser_item_swap_hook(this->user_data(), a, b); +} + +const char * My_Browser_::item_text(void * item) const { + return browser_item_text_hook(this->user_data(), item); +} + +void My_Browser_::item_draw(void * item, int x, int y, int w, int h) const { + browser_item_draw_hook(this->user_data(), item, x, y, w, h); +} + + +void My_Browser_::draw() { + widget_draw_hook(this->user_data()); +} + +int My_Browser_::handle(int e) { + return widget_handle_hook(this->user_data(), e); +} + + + + +// Flattened C API begins here + +ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label) { + My_Browser_ *b = new My_Browser_(x, y, w, h, label); + return b; +} + +void free_fl_abstract_browser(ABSTRACTBROWSER b) { + delete reinterpret_cast(b); +} + + + + +void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b) { + return &reinterpret_cast(b)->hscrollbar; +} + +void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b) { + return &reinterpret_cast(b)->scrollbar; +} + + + + +int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c) { + return reinterpret_cast(b)->select(i, v, c); +} + +int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c) { + return reinterpret_cast(b)->select_only(i, c); +} + +void * fl_abstract_browser_selection(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->selection(); +} + +int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c) { + return reinterpret_cast(b)->deselect(c); +} + +void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i) { + reinterpret_cast(b)->display(i); +} + +int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i) { + return reinterpret_cast(b)->displayed(i); +} + +void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y) { + return reinterpret_cast(b)->find_item(y); +} + +void * fl_abstract_browser_top(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->top(); +} + +void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f) { + reinterpret_cast(b)->sort(f); +} + + + + +unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->has_scrollbar(); +} + +void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m) { + reinterpret_cast(b)->has_scrollbar(m); +} + +int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->hposition(); +} + +void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p) { + reinterpret_cast(b)->hposition(p); +} + +int fl_abstract_browser_get_position(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->position(); +} + +void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p) { + reinterpret_cast(b)->position(p); +} + +void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b) { + reinterpret_cast(b)->scrollbar_left(); +} + +void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b) { + reinterpret_cast(b)->scrollbar_right(); +} + +int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->scrollbar_size(); +} + +void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s) { + reinterpret_cast(b)->scrollbar_size(s); +} + + + + +unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->textcolor(); +} + +void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c) { + reinterpret_cast(b)->textcolor(c); +} + +int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->textfont(); +} + +void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f) { + reinterpret_cast(b)->textfont(f); +} + +int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->textsize(); +} + +void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s) { + reinterpret_cast(b)->textsize(s); +} + + + + +void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h) { + reinterpret_cast(b)->resize(x, y, w, h); +} + +void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h) { + reinterpret_cast(b)->bbox(x, y, w, h); +} + +int fl_abstract_browser_leftedge(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->leftedge(); +} + +void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i) { + reinterpret_cast(b)->redraw_line(i); +} + +void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b) { + reinterpret_cast(b)->redraw_lines(); +} + + + + +int fl_abstract_browser_full_width(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->Fl_Browser_::full_width(); +} + +int fl_abstract_browser_full_height(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->Fl_Browser_::full_height(); +} + +int fl_abstract_browser_incr_height(ABSTRACTBROWSER b) { + return reinterpret_cast(b)->Fl_Browser_::incr_height(); +} + +int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i) { + return reinterpret_cast(b)->Fl_Browser_::item_quick_height(i); +} + + + + +void fl_abstract_browser_new_list(ABSTRACTBROWSER b) { + reinterpret_cast(b)->new_list(); +} + +void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2) { + reinterpret_cast(b)->inserting(a1, a2); +} + +void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item) { + reinterpret_cast(b)->deleting(item); +} + +void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2) { + reinterpret_cast(b)->replacing(a1, a2); +} + +void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2) { + reinterpret_cast(b)->swapping(a1, a2); +} + + + + +void fl_abstract_browser_draw(ABSTRACTBROWSER b) { + reinterpret_cast(b)->Fl_Browser_::draw(); +} + +int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e) { + return reinterpret_cast(b)->Fl_Browser_::handle(e); +} + + diff --git a/src/c_fl_browser_.h b/src/c_fl_browser_.h new file mode 100644 index 0000000..ed1157e --- /dev/null +++ b/src/c_fl_browser_.h @@ -0,0 +1,83 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_ABSTRACT_BROWSER_GUARD +#define FL_ABSTRACT_BROWSER_GUARD + + +extern "C" const int fl_sort_ascending; +extern "C" const int fl_sort_descending; + + +typedef void* ABSTRACTBROWSER; + + +extern "C" ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label); +extern "C" void free_fl_abstract_browser(ABSTRACTBROWSER b); + + +extern "C" void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b); +extern "C" void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b); + + +extern "C" int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c); +extern "C" int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c); +extern "C" void * fl_abstract_browser_selection(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c); +extern "C" void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i); +extern "C" int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i); +extern "C" void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y); +extern "C" void * fl_abstract_browser_top(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f); + + +extern "C" unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m); +extern "C" int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p); +extern "C" int fl_abstract_browser_get_position(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p); +extern "C" void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s); + + +extern "C" unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c); +extern "C" int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f); +extern "C" int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s); + + +extern "C" void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h); +extern "C" void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h); +extern "C" int fl_abstract_browser_leftedge(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i); +extern "C" void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b); + + +extern "C" int fl_abstract_browser_full_width(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_full_height(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_incr_height(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i); + + +extern "C" void fl_abstract_browser_new_list(ABSTRACTBROWSER b); +extern "C" void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2); +extern "C" void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item); +extern "C" void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2); +extern "C" void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2); + + +extern "C" void fl_abstract_browser_draw(ABSTRACTBROWSER b); +extern "C" int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e); + + +#endif + + diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb new file mode 100644 index 0000000..9c2ca3d --- /dev/null +++ b/src/fltk-widgets-groups-browsers.adb @@ -0,0 +1,1231 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings, + System.Address_To_Access_Conversions; + + +package body FLTK.Widgets.Groups.Browsers is + + + ------------------------ + -- Constants From C -- + ------------------------ + + fl_sort_ascending : constant Interfaces.C.int; + pragma Import (C, fl_sort_ascending, "fl_sort_ascending"); + + fl_sort_descending : constant Interfaces.C.int; + pragma Import (C, fl_sort_descending, "fl_sort_descending"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_abstract_browser + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_abstract_browser, "new_fl_abstract_browser"); + pragma Inline (new_fl_abstract_browser); + + procedure free_fl_abstract_browser + (B : in Storage.Integer_Address); + pragma Import (C, free_fl_abstract_browser, "free_fl_abstract_browser"); + pragma Inline (free_fl_abstract_browser); + + + + + function fl_abstract_browser_select + (B, I : in Storage.Integer_Address; + V, C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_select, "fl_abstract_browser_select"); + pragma Inline (fl_abstract_browser_select); + + function fl_abstract_browser_select_only + (B, I : in Storage.Integer_Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_select_only, "fl_abstract_browser_select_only"); + pragma Inline (fl_abstract_browser_select_only); + + function fl_abstract_browser_selection + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_selection, "fl_abstract_browser_selection"); + pragma Inline (fl_abstract_browser_selection); + + function fl_abstract_browser_deselect + (B : in Storage.Integer_Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_deselect, "fl_abstract_browser_deselect"); + pragma Inline (fl_abstract_browser_deselect); + + procedure fl_abstract_browser_display + (B, I : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_display, "fl_abstract_browser_display"); + pragma Inline (fl_abstract_browser_display); + + function fl_abstract_browser_displayed + (B, I : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_displayed, "fl_abstract_browser_displayed"); + pragma Inline (fl_abstract_browser_displayed); + + function fl_abstract_browser_find_item + (B : in Storage.Integer_Address; + Y : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_find_item, "fl_abstract_browser_find_item"); + pragma Inline (fl_abstract_browser_find_item); + + function fl_abstract_browser_top + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_top, "fl_abstract_browser_top"); + pragma Inline (fl_abstract_browser_top); + + procedure fl_abstract_browser_sort + (B : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_sort, "fl_abstract_browser_sort"); + pragma Inline (fl_abstract_browser_sort); + + + + + function fl_abstract_browser_get_has_scrollbar + (B : in Storage.Integer_Address) + return Interfaces.C.unsigned_char; + pragma Import (C, fl_abstract_browser_get_has_scrollbar, + "fl_abstract_browser_get_has_scrollbar"); + pragma Inline (fl_abstract_browser_get_has_scrollbar); + + procedure fl_abstract_browser_set_has_scrollbar + (B : in Storage.Integer_Address; + M : in Interfaces.C.unsigned_char); + pragma Import (C, fl_abstract_browser_set_has_scrollbar, + "fl_abstract_browser_set_has_scrollbar"); + pragma Inline (fl_abstract_browser_set_has_scrollbar); + + function fl_abstract_browser_get_hposition + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_get_hposition, "fl_abstract_browser_get_hposition"); + pragma Inline (fl_abstract_browser_get_hposition); + + procedure fl_abstract_browser_set_hposition + (B : in Storage.Integer_Address; + P : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_set_hposition, "fl_abstract_browser_set_hposition"); + pragma Inline (fl_abstract_browser_set_hposition); + + function fl_abstract_browser_get_position + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_get_position, "fl_abstract_browser_get_position"); + pragma Inline (fl_abstract_browser_get_position); + + procedure fl_abstract_browser_set_position + (B : in Storage.Integer_Address; + P : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_set_position, "fl_abstract_browser_set_position"); + pragma Inline (fl_abstract_browser_set_position); + + procedure fl_abstract_browser_scrollbar_left + (B : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_scrollbar_left, "fl_abstract_browser_scrollbar_left"); + pragma Inline (fl_abstract_browser_scrollbar_left); + + procedure fl_abstract_browser_scrollbar_right + (B : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_scrollbar_right, "fl_abstract_browser_scrollbar_right"); + pragma Inline (fl_abstract_browser_scrollbar_right); + + function fl_abstract_browser_get_scrollbar_size + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_get_scrollbar_size, + "fl_abstract_browser_get_scrollbar_size"); + pragma Inline (fl_abstract_browser_get_scrollbar_size); + + procedure fl_abstract_browser_set_scrollbar_size + (B : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_set_scrollbar_size, + "fl_abstract_browser_set_scrollbar_size"); + pragma Inline (fl_abstract_browser_set_scrollbar_size); + + + + + function fl_abstract_browser_get_textcolor + (B : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_abstract_browser_get_textcolor, "fl_abstract_browser_get_textcolor"); + pragma Inline (fl_abstract_browser_get_textcolor); + + procedure fl_abstract_browser_set_textcolor + (B : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_abstract_browser_set_textcolor, "fl_abstract_browser_set_textcolor"); + pragma Inline (fl_abstract_browser_set_textcolor); + + function fl_abstract_browser_get_textfont + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_get_textfont, "fl_abstract_browser_get_textfont"); + pragma Inline (fl_abstract_browser_get_textfont); + + procedure fl_abstract_browser_set_textfont + (B : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_set_textfont, "fl_abstract_browser_set_textfont"); + pragma Inline (fl_abstract_browser_set_textfont); + + function fl_abstract_browser_get_textsize + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_get_textsize, "fl_abstract_browser_get_textsize"); + pragma Inline (fl_abstract_browser_get_textsize); + + procedure fl_abstract_browser_set_textsize + (B : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_set_textsize, "fl_abstract_browser_set_textsize"); + pragma Inline (fl_abstract_browser_set_textsize); + + + + + procedure fl_abstract_browser_resize + (B : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_abstract_browser_resize, "fl_abstract_browser_resize"); + pragma Inline (fl_abstract_browser_resize); + + procedure fl_abstract_browser_bbox + (B : in Storage.Integer_Address; + X, Y, W, H : out Interfaces.C.int); + pragma Import (C, fl_abstract_browser_bbox, "fl_abstract_browser_bbox"); + pragma Inline (fl_abstract_browser_bbox); + + function fl_abstract_browser_leftedge + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_leftedge, "fl_abstract_browser_leftedge"); + pragma Inline (fl_abstract_browser_leftedge); + + procedure fl_abstract_browser_redraw_line + (B, I : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_redraw_line, "fl_abstract_browser_redraw_line"); + pragma Inline (fl_abstract_browser_redraw_line); + + procedure fl_abstract_browser_redraw_lines + (B : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_redraw_lines, "fl_abstract_browser_redraw_lines"); + pragma Inline (fl_abstract_browser_redraw_lines); + + + + + function fl_abstract_browser_full_width + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_full_width, "fl_abstract_browser_full_width"); + pragma Inline (fl_abstract_browser_full_width); + + function fl_abstract_browser_full_height + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_full_height, "fl_abstract_browser_full_height"); + pragma Inline (fl_abstract_browser_full_height); + + function fl_abstract_browser_incr_height + (B : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_incr_height, "fl_abstract_browser_incr_height"); + pragma Inline (fl_abstract_browser_incr_height); + + function fl_abstract_browser_item_quick_height + (B, I : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_item_quick_height, + "fl_abstract_browser_item_quick_height"); + pragma Inline (fl_abstract_browser_item_quick_height); + + + + + procedure fl_abstract_browser_new_list + (B : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_new_list, "fl_abstract_browser_new_list"); + pragma Inline (fl_abstract_browser_new_list); + + procedure fl_abstract_browser_inserting + (B, A1, A2 : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_inserting, "fl_abstract_browser_inserting"); + pragma Inline (fl_abstract_browser_inserting); + + procedure fl_abstract_browser_deleting + (B, I : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_deleting, "fl_abstract_browser_deleting"); + pragma Inline (fl_abstract_browser_deleting); + + procedure fl_abstract_browser_replacing + (B, A1, A2 : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_replacing, "fl_abstract_browser_replacing"); + pragma Inline (fl_abstract_browser_replacing); + + procedure fl_abstract_browser_swapping + (B, A1, A2 : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_swapping, "fl_abstract_browser_swapping"); + pragma Inline (fl_abstract_browser_swapping); + + + + + procedure fl_abstract_browser_draw + (B : in Storage.Integer_Address); + pragma Import (C, fl_abstract_browser_draw, "fl_abstract_browser_draw"); + pragma Inline (fl_abstract_browser_draw); + + function fl_abstract_browser_handle + (B : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_abstract_browser_handle, "fl_abstract_browser_handle"); + pragma Inline (fl_abstract_browser_handle); + + + + + ---------------------- + -- Exported Hooks -- + ---------------------- + + package Browser_Convert is new System.Address_To_Access_Conversions (Abstract_Browser'Class); + + + function Full_Width_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Full_Width_Hook, "browser_full_width_hook"); + + function Full_Width_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Full_List_Width); + end Full_Width_Hook; + + + function Full_Height_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Full_Height_Hook, "browser_full_height_hook"); + + function Full_Height_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Full_List_Height); + end Full_Height_Hook; + + + function Average_Item_Height_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Average_Item_Height_Hook, "browser_incr_height_hook"); + + function Average_Item_Height_Hook + (Ada_Addr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Average_Item_Height); + end Average_Item_Height_Hook; + + + function Item_Quick_Height_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Item_Quick_Height_Hook, "browser_item_quick_height_hook"); + + function Item_Quick_Height_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Item_Quick_Height (Address_To_Cursor (Item_Ptr))); + end Item_Quick_Height_Hook; + + + function Item_Width_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Item_Width_Hook, "browser_item_width_hook"); + + function Item_Width_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Item_Width (Address_To_Cursor (Item_Ptr))); + end Item_Width_Hook; + + + function Item_Height_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Item_Height_Hook, "browser_item_height_hook"); + + function Item_Height_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Interfaces.C.int (Ada_Object.Item_Height (Address_To_Cursor (Item_Ptr))); + end Item_Height_Hook; + + + function Item_First_Hook + (Ada_Addr : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Export (C, Item_First_Hook, "browser_item_first_hook"); + + function Item_First_Hook + (Ada_Addr : in Storage.Integer_Address) + return Storage.Integer_Address + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Cursor_To_Address (Ada_Object.Item_First); + end Item_First_Hook; + + + function Item_Last_Hook + (Ada_Addr : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Export (C, Item_Last_Hook, "browser_item_last_hook"); + + function Item_Last_Hook + (Ada_Addr : in Storage.Integer_Address) + return Storage.Integer_Address + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Cursor_To_Address (Ada_Object.Item_Last); + end Item_Last_Hook; + + + function Item_Next_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Export (C, Item_Next_Hook, "browser_item_next_hook"); + + function Item_Next_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Storage.Integer_Address + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Cursor_To_Address (Ada_Object.Item_Next (Address_To_Cursor (Item_Ptr))); + end Item_Next_Hook; + + + function Item_Previous_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Export (C, Item_Previous_Hook, "browser_item_prev_hook"); + + function Item_Previous_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Storage.Integer_Address + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Cursor_To_Address (Ada_Object.Item_Previous (Address_To_Cursor (Item_Ptr))); + end Item_Previous_Hook; + + + function Item_At_Hook + (Ada_Addr : in Storage.Integer_Address; + Index : in Interfaces.C.int) + return Storage.Integer_Address; + pragma Export (C, Item_At_Hook, "browser_item_at_hook"); + + function Item_At_Hook + (Ada_Addr : in Storage.Integer_Address; + Index : in Interfaces.C.int) + return Storage.Integer_Address + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + use type Interfaces.C.int; + begin + return Cursor_To_Address (Ada_Object.Item_At (Positive (Index + 1))); + end Item_At_Hook; + + + procedure Item_Select_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address; + Int_State : in Interfaces.C.int); + pragma Export (C, Item_Select_Hook, "browser_item_select_hook"); + + procedure Item_Select_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address; + Int_State : in Interfaces.C.int) + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + use type Interfaces.C.int; + begin + Ada_Object.Item_Select + (Address_To_Cursor (Item_Ptr), + Int_State /= 0); + end Item_Select_Hook; + + + function Item_Selected_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Export (C, Item_Selected_Hook, "browser_item_selected_hook"); + + function Item_Selected_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.int + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + return Boolean'Pos (Ada_Object.Item_Selected (Address_To_Cursor (Item_Ptr))); + end Item_Selected_Hook; + + + procedure Item_Swap_Hook + (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address); + pragma Export (C, Item_Swap_Hook, "browser_item_swap_hook"); + + procedure Item_Swap_Hook + (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address) + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + Ada_Object.Item_Swap (Address_To_Cursor (A_Ptr), Address_To_Cursor (B_Ptr)); + end Item_Swap_Hook; + + + -- The following is a hack due to inherent incompatibilities between Ada Strings + -- and C char pointers. The hook will convert Strings to char* and return them + -- fine for the first two calls, but after that it will deallocate the oldest + -- char* it previously returned to make room for more. Fortunately, this hook + -- is only used by the FLTK C++ side of things for comparing two strings for the + -- purposes of sorting items so it all works out in the end. + + -- Calls by the Ada programmer to Item_Text will be completely unaffected, but + -- this does mean that the default implementation of Sort is not task safe. + + -- At the time of writing this I have no idea how task safe FLTK is anyway. + + Text_Hook_Storage : Interfaces.C.Strings.chars_ptr_array (1 .. 2); + Current_Text_Store : Interfaces.C.size_t := 1; + + function Item_Text_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Export (C, Item_Text_Hook, "browser_item_text_hook"); + + function Item_Text_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + Interfaces.C.Strings.Free (Text_Hook_Storage (Current_Text_Store)); + Text_Hook_Storage (Current_Text_Store) := Interfaces.C.Strings.New_String + (Ada_Object.Item_Text (Address_To_Cursor (Item_Ptr))); + return C_Char_Is_Not_A_String : Interfaces.C.Strings.chars_ptr := + Text_Hook_Storage (Current_Text_Store) + do + Current_Text_Store := Current_Text_Store + 1; + if Current_Text_Store > Text_Hook_Storage'Last then + Current_Text_Store := Text_Hook_Storage'First; + end if; + end return; + end Item_Text_Hook; + + + procedure Item_Draw_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Export (C, Item_Draw_Hook, "browser_item_draw_hook"); + + procedure Item_Draw_Hook + (Ada_Addr, Item_Ptr : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int) + is + Ada_Object : access Abstract_Browser'Class := + Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr)); + begin + Ada_Object.Item_Draw + (Address_To_Cursor (Item_Ptr), + Integer (X), + Integer (Y), + Integer (W), + Integer (H)); + end Item_Draw_Hook; + + + + + ----------------------------------- + -- Controlled Type Subprograms -- + ----------------------------------- + + procedure Finalize + (This : in out Abstract_Browser) is + begin + if This.Void_Ptr /= Null_Pointer and then + This in Abstract_Browser'Class + then + This.Clear; + free_fl_abstract_browser (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + Finalize (Group (This)); + end Finalize; + + + procedure Finalize + (This : in out Item_Text_Hook_Final_Controller) is + begin + for Index in Text_Hook_Storage'Range loop + Interfaces.C.Strings.Free (Text_Hook_Storage (Index)); + end loop; + end Finalize; + + + + + --------------------------- + -- Abstract Browser API -- + --------------------------- + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Abstract_Browser is + begin + return This : Abstract_Browser do + This.Void_Ptr := new_fl_abstract_browser + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + + Wrapper (This.Horizon).Void_Ptr := fl_abstract_browser_hscrollbar (This.Void_Ptr); + Wrapper (This.Horizon).Needs_Dealloc := False; + fl_widget_set_user_data + (Wrapper (This.Horizon).Void_Ptr, + Storage.To_Integer (Widget_Convert.To_Address (This.Horizon'Unchecked_Access))); + + Wrapper (This.Vertigo).Void_Ptr := fl_abstract_browser_scrollbar (This.Void_Ptr); + Wrapper (This.Vertigo).Needs_Dealloc := False; + fl_widget_set_user_data + (Wrapper (This.Vertigo).Void_Ptr, + Storage.To_Integer (Widget_Convert.To_Address (This.Vertigo'Unchecked_Access))); + + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end return; + end Create; + + end Forge; + + + + + -- Access to the Browser's self contained scrollbars + + function H_Bar + (This : in out Abstract_Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference is + begin + return (Data => This.Horizon'Unchecked_Access); + end H_Bar; + + + function V_Bar + (This : in out Abstract_Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference is + begin + return (Data => This.Vertigo'Unchecked_Access); + end V_Bar; + + + + + -- Item related settings + + function Set_Select + (This : in out Abstract_Browser; + Item : in Item_Cursor; + State : in Boolean := True; + Do_Callbacks : in Boolean := False) + return Boolean + is + Code : Interfaces.C.int := fl_abstract_browser_select + (This.Void_Ptr, + Cursor_To_Address (Item), + Boolean'Pos (State), + Boolean'Pos (Do_Callbacks)); + begin + if Code not in 0 .. 1 then + raise Program_Error; + end if; + return Boolean'Val (Code); + end Set_Select; + + + function Select_Only + (This : in out Abstract_Browser; + Item : in Item_Cursor; + Do_Callbacks : in Boolean := False) + return Boolean + is + Code : Interfaces.C.int := fl_abstract_browser_select_only + (This.Void_Ptr, + Cursor_To_Address (Item), + Boolean'Pos (Do_Callbacks)); + begin + if Code not in 0 .. 1 then + raise Program_Error; + end if; + return Boolean'Val (Code); + end Select_Only; + + + function Current_Selection + (This : in Abstract_Browser) + return Item_Cursor is + begin + return Address_To_Cursor (fl_abstract_browser_selection (This.Void_Ptr)); + end Current_Selection; + + + function Deselect + (This : in out Abstract_Browser; + Do_Callbacks : in Boolean := False) + return Boolean + is + Code : Interfaces.C.int := fl_abstract_browser_deselect + (This.Void_Ptr, + Boolean'Pos (Do_Callbacks)); + begin + if Code not in 0 .. 1 then + raise Program_Error; + end if; + return Boolean'Val (Code); + end Deselect; + + + procedure Display + (This : in out Abstract_Browser; + Item : in Item_Cursor) is + begin + fl_abstract_browser_display (This.Void_Ptr, Cursor_To_Address (Item)); + end Display; + + + function Is_Displayed + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Boolean + is + Code : Interfaces.C.int := fl_abstract_browser_displayed + (This.Void_Ptr, + Cursor_To_Address (Item)); + begin + if Code not in 0 .. 1 then + raise Program_Error; + end if; + return Boolean'Val (Code); + end Is_Displayed; + + + function Find_Item + (This : in Abstract_Browser; + Y_Pos : in Integer) + return Item_Cursor is + begin + return Address_To_Cursor + (fl_abstract_browser_find_item (This.Void_Ptr, Interfaces.C.int (Y_Pos))); + end Find_Item; + + + function Top_Item + (This : in Abstract_Browser) + return Item_Cursor is + begin + return Address_To_Cursor (fl_abstract_browser_top (This.Void_Ptr)); + end Top_Item; + + + procedure Sort + (This : in out Abstract_Browser; + Order : in Sort_Order) + is + Code : Interfaces.C.int := + (case Order is + when Ascending => fl_sort_ascending, + when Descending => fl_sort_descending); + begin + fl_abstract_browser_sort (This.Void_Ptr, Code); + end Sort; + + + + + -- Scrollbar related settings + + function Get_Scrollbar_Mode + (This : in Abstract_Browser) + return Scrollbar_Mode is + begin + return Uchar_To_Mode (fl_abstract_browser_get_has_scrollbar (This.Void_Ptr)); + end Get_Scrollbar_Mode; + + + procedure Set_Scrollbar_Mode + (This : in out Abstract_Browser; + Mode : in Scrollbar_Mode) is + begin + fl_abstract_browser_set_has_scrollbar (This.Void_Ptr, Mode_To_Uchar (Mode)); + end Set_Scrollbar_Mode; + + + function Get_H_Position + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_get_hposition (This.Void_Ptr)); + end Get_H_Position; + + + procedure Set_H_Position + (This : in out Abstract_Browser; + Value : in Integer) is + begin + fl_abstract_browser_set_hposition + (This.Void_Ptr, + Interfaces.C.int (Value)); + end Set_H_Position; + + + function Get_V_Position + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_get_position (This.Void_Ptr)); + end Get_V_Position; + + + procedure Set_V_Position + (This : in out Abstract_Browser; + Value : in Integer) is + begin + fl_abstract_browser_set_position + (This.Void_Ptr, + Interfaces.C.int (Value)); + end Set_V_Position; + + + procedure Set_Vertical_Left + (This : in out Abstract_Browser) is + begin + fl_abstract_browser_scrollbar_left (This.Void_Ptr); + end Set_Vertical_Left; + + + procedure Set_Vertical_Right + (This : in out Abstract_Browser) is + begin + fl_abstract_browser_scrollbar_right (This.Void_Ptr); + end Set_Vertical_Right; + + + function Get_Scrollbar_Size + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_get_scrollbar_size (This.Void_Ptr)); + end Get_Scrollbar_Size; + + + procedure Set_Scrollbar_Size + (This : in out Abstract_Browser; + Value : in Integer) is + begin + fl_abstract_browser_set_scrollbar_size + (This.Void_Ptr, + Interfaces.C.int (Value)); + end Set_Scrollbar_Size; + + + + + -- Text related settings + + function Get_Text_Color + (This : in Abstract_Browser) + return Color is + begin + return Color (fl_abstract_browser_get_textcolor (This.Void_Ptr)); + end Get_Text_Color; + + + procedure Set_Text_Color + (This : in out Abstract_Browser; + Value : in Color) is + begin + fl_abstract_browser_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); + end Set_Text_Color; + + + function Get_Text_Font + (This : in Abstract_Browser) + return Font_Kind is + begin + return Font_Kind'Val (fl_abstract_browser_get_textfont (This.Void_Ptr)); + end Get_Text_Font; + + + procedure Set_Text_Font + (This : in out Abstract_Browser; + Font : in Font_Kind) is + begin + fl_abstract_browser_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Text_Font; + + + function Get_Text_Size + (This : in Abstract_Browser) + return Font_Size is + begin + return Font_Size (fl_abstract_browser_get_textsize (This.Void_Ptr)); + end Get_Text_Size; + + + procedure Set_Text_Size + (This : in out Abstract_Browser; + Size : in Font_Size) is + begin + fl_abstract_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Text_Size; + + + + + -- Graphical dimensions and redrawing + + procedure Resize + (This : in out Abstract_Browser; + X, Y, W, H : in Integer) is + begin + fl_abstract_browser_resize + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + procedure Bounding_Box + (This : in Abstract_Browser; + X, Y, W, H : out Integer) is + begin + fl_abstract_browser_bbox + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Bounding_Box; + + + function Left_Edge + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_leftedge (This.Void_Ptr)); + end Left_Edge; + + + procedure Redraw_Line + (This : in out Abstract_Browser; + Item : in Item_Cursor) is + begin + fl_abstract_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item)); + end Redraw_Line; + + + procedure Redraw_List + (This : in out Abstract_Browser) is + begin + fl_abstract_browser_redraw_lines (This.Void_Ptr); + end Redraw_List; + + + + + -- Optional Override API + + function Full_List_Width + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_full_width (This.Void_Ptr)); + end Full_List_Width; + + + function Full_List_Height + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_full_height (This.Void_Ptr)); + end Full_List_Height; + + + function Average_Item_Height + (This : in Abstract_Browser) + return Integer is + begin + return Integer (fl_abstract_browser_incr_height (This.Void_Ptr)); + end Average_Item_Height; + + + function Item_Quick_Height + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer is + begin + return Integer (fl_abstract_browser_item_quick_height + (This.Void_Ptr, + Cursor_To_Address (Item))); + end Item_Quick_Height; + + + + + -- Mandatory Override API + + function Item_Width + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer is + begin + return raise Program_Error with "Abstract_Browser Item_Width must be overridden"; + end Item_Width; + + function Item_Height + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer is + begin + return raise Program_Error with "Abstract_Browser Item_Height must be overridden"; + end Item_Height; + + function Item_First + (This : in Abstract_Browser) + return Item_Cursor is + begin + return raise Program_Error with "Abstract_Browser Item_First must be overridden"; + end Item_First; + + function Item_Last + (This : in Abstract_Browser) + return Item_Cursor is + begin + return raise Program_Error with "Abstract_Browser Item_Last must be overridden"; + end Item_Last; + + function Item_Next + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Item_Cursor is + begin + return raise Program_Error with "Abstract_Browser Item_Next must be overridden"; + end Item_Next; + + function Item_Previous + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Item_Cursor is + begin + return raise Program_Error with "Abstract_Browser Item_Previous must be overridden"; + end Item_Previous; + + function Item_At + (This : in Abstract_Browser; + Index : in Positive) + return Item_Cursor is + begin + return raise Program_Error with "Abstract_Browser Item_At must be overridden"; + end Item_At; + + procedure Item_Select + (This : in out Abstract_Browser; + Item : in Item_Cursor; + State : in Boolean := True) is + begin + raise Program_Error with "Abstract_Browser Item_Select must be overridden"; + end Item_Select; + + function Item_Selected + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Boolean is + begin + return raise Program_Error with "Abstract_Browser Item_Selected must be overridden"; + end Item_Selected; + + procedure Item_Swap + (This : in out Abstract_Browser; + A, B : in Item_Cursor) is + begin + raise Program_Error with "Abstract_Browser Item_Swap must be overridden"; + end Item_Swap; + + function Item_Text + (This : in Abstract_Browser; + Item : in Item_Cursor) + return String is + begin + return raise Program_Error with "Abstract_Browser Item_Text must be overridden"; + end Item_Text; + + procedure Item_Draw + (This : in Abstract_Browser; + Item : in Item_Cursor; + X, Y, W, H : in Integer) is + begin + raise Program_Error with "Abstract_Browser Item_Draw must be overridden"; + end Item_Draw; + + + + + -- Cache invalidation + + procedure New_List + (This : in out Abstract_Browser) is + begin + fl_abstract_browser_new_list (This.Void_Ptr); + end New_List; + + + procedure Inserting + (This : in out Abstract_Browser; + A, B : in Item_Cursor) is + begin + fl_abstract_browser_inserting + (This.Void_Ptr, + Cursor_To_Address (A), + Cursor_To_Address (B)); + end Inserting; + + + procedure Deleting + (This : in out Abstract_Browser; + Item : in Item_Cursor) is + begin + fl_abstract_browser_deleting + (This.Void_Ptr, + Cursor_To_Address (Item)); + end Deleting; + + + procedure Replacing + (This : in out Abstract_Browser; + A, B : in Item_Cursor) is + begin + fl_abstract_browser_replacing + (This.Void_Ptr, + Cursor_To_Address (A), + Cursor_To_Address (B)); + end Replacing; + + + procedure Swapping + (This : in out Abstract_Browser; + A, B : in Item_Cursor) is + begin + fl_abstract_browser_swapping + (This.Void_Ptr, + Cursor_To_Address (A), + Cursor_To_Address (B)); + end Swapping; + + + + + -- Standard Override API + + procedure Draw + (This : in out Abstract_Browser) is + begin + fl_abstract_browser_draw (This.Void_Ptr); + end Draw; + + + function Handle + (This : in out Abstract_Browser; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_abstract_browser_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + +end FLTK.Widgets.Groups.Browsers; + + diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads new file mode 100644 index 0000000..c93506f --- /dev/null +++ b/src/fltk-widgets-groups-browsers.ads @@ -0,0 +1,447 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Widgets.Valuators.Sliders.Scrollbars, + System; + +private with + + Ada.Finalization, + Ada.Unchecked_Conversion, + Interfaces.C; + + +package FLTK.Widgets.Groups.Browsers is + + + type Abstract_Browser is new Group with private; + + type Abstract_Browser_Reference (Data : not null access Abstract_Browser'Class) is + limited null record with Implicit_Dereference => Data; + + type Item_Cursor is mod System.Memory_Size; + + No_Item : constant Item_Cursor; + + type Sort_Order is (Ascending, Descending); + + type Scrollbar_Mode is record + Horizontal : Boolean := True; + Vertical : Boolean := True; + Always_On : Boolean := False; + end record; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Abstract_Browser; + + end Forge; + + + + + -- Access to the Browser's self contained scrollbars + + function H_Bar + (This : in out Abstract_Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + function V_Bar + (This : in out Abstract_Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + + + + -- Item related settings + + function Set_Select + (This : in out Abstract_Browser; + Item : in Item_Cursor; + State : in Boolean := True; + Do_Callbacks : in Boolean := False) + return Boolean; + + function Select_Only + (This : in out Abstract_Browser; + Item : in Item_Cursor; + Do_Callbacks : in Boolean := False) + return Boolean; + + function Current_Selection + (This : in Abstract_Browser) + return Item_Cursor; + + function Deselect + (This : in out Abstract_Browser; + Do_Callbacks : in Boolean := False) + return Boolean; + + procedure Display + (This : in out Abstract_Browser; + Item : in Item_Cursor); + + function Is_Displayed + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Boolean; + + function Find_Item + (This : in Abstract_Browser; + Y_Pos : in Integer) + return Item_Cursor; + + function Top_Item + (This : in Abstract_Browser) + return Item_Cursor; + + -- Not task safe due to internal issues with converting Ada Strings to char* in C. + -- Unsure how much that matters since unsure how task safe FLTK is anyway. + procedure Sort + (This : in out Abstract_Browser; + Order : in Sort_Order); + + + + + -- Scrollbar related settings + + function Get_Scrollbar_Mode + (This : in Abstract_Browser) + return Scrollbar_Mode; + + procedure Set_Scrollbar_Mode + (This : in out Abstract_Browser; + Mode : in Scrollbar_Mode); + + function Get_H_Position + (This : in Abstract_Browser) + return Integer; + + procedure Set_H_Position + (This : in out Abstract_Browser; + Value : in Integer); + + function Get_V_Position + (This : in Abstract_Browser) + return Integer; + + procedure Set_V_Position + (This : in out Abstract_Browser; + Value : in Integer); + + procedure Set_Vertical_Left + (This : in out Abstract_Browser); + + procedure Set_Vertical_Right + (This : in out Abstract_Browser); + + function Get_Scrollbar_Size + (This : in Abstract_Browser) + return Integer; + + procedure Set_Scrollbar_Size + (This : in out Abstract_Browser; + Value : in Integer); + + + + + -- Text related settings + + function Get_Text_Color + (This : in Abstract_Browser) + return Color; + + procedure Set_Text_Color + (This : in out Abstract_Browser; + Value : in Color); + + function Get_Text_Font + (This : in Abstract_Browser) + return Font_Kind; + + procedure Set_Text_Font + (This : in out Abstract_Browser; + Font : in Font_Kind); + + function Get_Text_Size + (This : in Abstract_Browser) + return Font_Size; + + procedure Set_Text_Size + (This : in out Abstract_Browser; + Size : in Font_Size); + + + + + -- Graphical dimensions and redrawing + + procedure Resize + (This : in out Abstract_Browser; + X, Y, W, H : in Integer); + + procedure Bounding_Box + (This : in Abstract_Browser; + X, Y, W, H : out Integer); + + function Left_Edge + (This : in Abstract_Browser) + return Integer; + + procedure Redraw_Line + (This : in out Abstract_Browser; + Item : in Item_Cursor); + + procedure Redraw_List + (This : in out Abstract_Browser); + + + + + -- You may override these subprograms to change the behaviour of the widget + -- even though these are called from within FLTK. + + function Full_List_Width + (This : in Abstract_Browser) + return Integer; + + function Full_List_Height + (This : in Abstract_Browser) + return Integer; + + function Average_Item_Height + (This : in Abstract_Browser) + return Integer; + + function Item_Quick_Height + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer; + + + + + -- You MUST override these subprograms if deriving a type from Abstract_Browser + -- or your program will crash, since they are called from within FLTK and do not + -- have any implementations given. By default here they will raise an exception. + + function Item_Width + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer; + + function Item_Height + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Integer; + + function Item_First + (This : in Abstract_Browser) + return Item_Cursor; + + function Item_Last + (This : in Abstract_Browser) + return Item_Cursor; + + function Item_Next + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Item_Cursor; + + function Item_Previous + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Item_Cursor; + + function Item_At + (This : in Abstract_Browser; + Index : in Positive) + return Item_Cursor; + + procedure Item_Select + (This : in out Abstract_Browser; + Item : in Item_Cursor; + State : in Boolean := True); + + function Item_Selected + (This : in Abstract_Browser; + Item : in Item_Cursor) + return Boolean; + + procedure Item_Swap + (This : in out Abstract_Browser; + A, B : in Item_Cursor); + + function Item_Text + (This : in Abstract_Browser; + Item : in Item_Cursor) + return String; + + procedure Item_Draw + (This : in Abstract_Browser; + Item : in Item_Cursor; + X, Y, W, H : in Integer); + + + + + -- Cache invalidation + + procedure New_List + (This : in out Abstract_Browser); + + procedure Inserting + (This : in out Abstract_Browser; + A, B : in Item_Cursor); + + procedure Deleting + (This : in out Abstract_Browser; + Item : in Item_Cursor); + + procedure Replacing + (This : in out Abstract_Browser; + A, B : in Item_Cursor); + + procedure Swapping + (This : in out Abstract_Browser; + A, B : in Item_Cursor); + + + + + -- You may override these subprograms to change the behaviour of the widget + -- even though these are called from within FLTK. + + procedure Draw + (This : in out Abstract_Browser); + + function Handle + (This : in out Abstract_Browser; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Abstract_Browser is new Group with record + Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar; + Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; + end record; + + overriding procedure Finalize + (This : in out Abstract_Browser); + + + pragma Assert + (Item_Cursor'Size = Storage.Integer_Address'Size, + "Size of Browser Item_Cursor does not match Ada address values"); + + function Address_To_Cursor is + new Ada.Unchecked_Conversion (Storage.Integer_Address, Item_Cursor); + function Cursor_To_Address is + new Ada.Unchecked_Conversion (Item_Cursor, Storage.Integer_Address); + + No_Item : constant Item_Cursor := Address_To_Cursor (Null_Pointer); + + + for Scrollbar_Mode use record + Horizontal at 0 range 0 .. 0; + Vertical at 0 range 1 .. 1; + Always_On at 0 range 2 .. 2; + end record; + + for Scrollbar_Mode'Size use Interfaces.C.unsigned_char'Size; + + function Mode_To_Uchar is + new Ada.Unchecked_Conversion (Scrollbar_Mode, Interfaces.C.unsigned_char); + function Uchar_To_Mode is + new Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Scrollbar_Mode); + + + pragma Inline (H_Bar); + pragma Inline (V_Bar); + + pragma Inline (Current_Selection); + pragma Inline (Display); + pragma Inline (Find_Item); + pragma Inline (Top_Item); + pragma Inline (Sort); + + pragma Inline (Get_Scrollbar_Mode); + pragma Inline (Set_Scrollbar_Mode); + pragma Inline (Get_H_Position); + pragma Inline (Set_H_Position); + pragma Inline (Get_V_Position); + pragma Inline (Set_V_Position); + pragma Inline (Set_Vertical_Left); + pragma Inline (Set_Vertical_Right); + pragma Inline (Get_Scrollbar_Size); + pragma Inline (Set_Scrollbar_Size); + + pragma Inline (Get_Text_Color); + pragma Inline (Set_Text_Color); + pragma Inline (Get_Text_Font); + pragma Inline (Set_Text_Font); + pragma Inline (Get_Text_Size); + pragma Inline (Set_Text_Size); + + pragma Inline (Resize); + pragma Inline (Bounding_Box); + pragma Inline (Left_Edge); + pragma Inline (Redraw_Line); + pragma Inline (Redraw_List); + + pragma Inline (Full_List_Width); + pragma Inline (Full_List_Height); + pragma Inline (Average_Item_Height); + pragma Inline (Item_Quick_Height); + + pragma Inline (New_List); + pragma Inline (Inserting); + pragma Inline (Deleting); + pragma Inline (Replacing); + pragma Inline (Swapping); + + pragma Inline (Draw); + pragma Inline (Handle); + + + function fl_abstract_browser_hscrollbar + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar"); + pragma Inline (fl_abstract_browser_hscrollbar); + + function fl_abstract_browser_scrollbar + (B : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar"); + pragma Inline (fl_abstract_browser_scrollbar); + + + -- Needed to ensure chars_ptr storage is properly cleaned up + type Item_Text_Hook_Final_Controller is new Ada.Finalization.Controlled with null record; + + overriding procedure Finalize + (This : in out Item_Text_Hook_Final_Controller); + + Cleanup : Item_Text_Hook_Final_Controller; + + +end FLTK.Widgets.Groups.Browsers; + + diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 5fe822d..9964bda 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -378,17 +378,17 @@ private -- the user data portion should always be a reference back to the Ada binding procedure Callback_Hook (W, U : in Storage.Integer_Address); - pragma Convention (C, Callback_Hook); + pragma Export (C, Callback_Hook, "widget_callback_hook"); procedure Draw_Hook (U : in Storage.Integer_Address); - pragma Convention (C, Draw_Hook); + pragma Export (C, Draw_Hook, "widget_draw_hook"); function Handle_Hook (U : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; - pragma Convention (C, Handle_Hook); + pragma Export (C, Handle_Hook, "widget_handle_hook"); -- cgit