diff options
| -rw-r--r-- | progress.txt | 2 | ||||
| -rw-r--r-- | src/c_fl_scrollbar.cpp | 92 | ||||
| -rw-r--r-- | src/c_fl_scrollbar.h | 36 | ||||
| -rw-r--r-- | src/fltk-widgets-valuators-sliders-scrollbars.adb | 191 | ||||
| -rw-r--r-- | src/fltk-widgets-valuators-sliders-scrollbars.ads | 68 |
5 files changed, 388 insertions, 1 deletions
diff --git a/progress.txt b/progress.txt index 46feda5..d59fc21 100644 --- a/progress.txt +++ b/progress.txt @@ -60,6 +60,7 @@ FLTK.Widgets.Valuators.Sliders.Hor_Fill FLTK.Widgets.Valuators.Sliders.Hor_Nice FLTK.Widgets.Valuators.Sliders.Horizontal FLTK.Widgets.Valuators.Sliders.Nice +FLTK.Widgets.Valuators.Sliders.Scrollbars @@ -108,7 +109,6 @@ FL_Table FL_Table_Row FL_Tile FL_Tree -FL_Scrollbar FL_Value_Slider FL_Hor_Value_Slider diff --git a/src/c_fl_scrollbar.cpp b/src/c_fl_scrollbar.cpp new file mode 100644 index 0000000..c94240b --- /dev/null +++ b/src/c_fl_scrollbar.cpp @@ -0,0 +1,92 @@ + + +#include <FL/Fl_Scrollbar.H> +#include "c_fl_scrollbar.h" +#include "c_fl_type.h" + + + + +class My_Scrollbar : public Fl_Scrollbar { + public: + using Fl_Scrollbar::Fl_Scrollbar; + friend void scrollbar_set_draw_hook(SCROLLBAR s, void * d); + friend void fl_scrollbar_draw(SCROLLBAR s); + friend void scrollbar_set_handle_hook(SCROLLBAR s, void * h); + friend int fl_scrollbar_handle(SCROLLBAR s, int e); + protected: + void draw(); + void real_draw(); + int handle(int e); + int real_handle(int e); + d_hook_p draw_hook; + h_hook_p handle_hook; +}; + +void My_Scrollbar::draw() { + (*draw_hook)(this->user_data()); +} + +void My_Scrollbar::real_draw() { + Fl_Scrollbar::draw(); +} + +int My_Scrollbar::handle(int e) { + return (*handle_hook)(this->user_data(), e); +} + +int My_Scrollbar::real_handle(int e) { + return Fl_Scrollbar::handle(e); +} + +void scrollbar_set_draw_hook(SCROLLBAR s, void * d) { + reinterpret_cast<My_Scrollbar*>(s)->draw_hook = reinterpret_cast<d_hook_p>(d); +} + +void fl_scrollbar_draw(SCROLLBAR s) { + reinterpret_cast<My_Scrollbar*>(s)->real_draw(); +} + +void scrollbar_set_handle_hook(SCROLLBAR s, void * h) { + reinterpret_cast<My_Scrollbar*>(s)->handle_hook = reinterpret_cast<h_hook_p>(h); +} + +int fl_scrollbar_handle(SCROLLBAR s, int e) { + return reinterpret_cast<My_Scrollbar*>(s)->real_handle(e); +} + + + + +SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label) { + My_Scrollbar *s = new My_Scrollbar(x, y, w, h, label); + return s; +} + +void free_fl_scrollbar(SCROLLBAR s) { + delete reinterpret_cast<My_Scrollbar*>(s); +} + + + + +int fl_scrollbar_get_linesize(SCROLLBAR s) { + return reinterpret_cast<My_Scrollbar*>(s)->linesize(); +} + +void fl_scrollbar_set_linesize(SCROLLBAR s, int t) { + reinterpret_cast<My_Scrollbar*>(s)->linesize(t); +} + +int fl_scrollbar_get_value(SCROLLBAR s) { + return reinterpret_cast<My_Scrollbar*>(s)->value(); +} + +void fl_scrollbar_set_value(SCROLLBAR s, int t) { + reinterpret_cast<My_Scrollbar*>(s)->value(t); +} + +void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t) { + reinterpret_cast<My_Scrollbar*>(s)->value(p,w,f,t); +} + diff --git a/src/c_fl_scrollbar.h b/src/c_fl_scrollbar.h new file mode 100644 index 0000000..311abfa --- /dev/null +++ b/src/c_fl_scrollbar.h @@ -0,0 +1,36 @@ + + +#ifndef FL_SCROLLBAR_GUARD +#define FL_SCROLLBAR_GUARD + + + + +typedef void* SCROLLBAR; + + + + +extern "C" void scrollbar_set_draw_hook(SCROLLBAR s, void * d); +extern "C" void fl_scrollbar_draw(SCROLLBAR s); +extern "C" void scrollbar_set_handle_hook(SCROLLBAR s, void * h); +extern "C" int fl_scrollbar_handle(SCROLLBAR s, int e); + + + + +extern "C" SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label); +extern "C" void free_fl_scrollbar(SCROLLBAR s); + + + + +extern "C" int fl_scrollbar_get_linesize(SCROLLBAR s); +extern "C" void fl_scrollbar_set_linesize(SCROLLBAR s, int t); +extern "C" int fl_scrollbar_get_value(SCROLLBAR s); +extern "C" void fl_scrollbar_set_value(SCROLLBAR s, int t); +extern "C" void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t); + + +#endif + diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb new file mode 100644 index 0000000..2fc013f --- /dev/null +++ b/src/fltk-widgets-valuators-sliders-scrollbars.adb @@ -0,0 +1,191 @@ + + +with + + Interfaces.C.Strings, + System; + +use type + + System.Address; + + +package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + + + procedure scrollbar_set_draw_hook + (W, D : in System.Address); + pragma Import (C, scrollbar_set_draw_hook, "scrollbar_set_draw_hook"); + + procedure scrollbar_set_handle_hook + (W, H : in System.Address); + pragma Import (C, scrollbar_set_handle_hook, "scrollbar_set_handle_hook"); + + + + + function new_fl_scrollbar + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_scrollbar, "new_fl_scrollbar"); + + procedure free_fl_scrollbar + (D : in System.Address); + pragma Import (C, free_fl_scrollbar, "free_fl_scrollbar"); + + + + + function fl_scrollbar_get_linesize + (S : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_scrollbar_get_linesize, "fl_scrollbar_get_linesize"); + + procedure fl_scrollbar_set_linesize + (S : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_scrollbar_set_linesize, "fl_scrollbar_set_linesize"); + + function fl_scrollbar_get_value + (S : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_scrollbar_get_value, "fl_scrollbar_get_value"); + + procedure fl_scrollbar_set_value + (S : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_scrollbar_set_value, "fl_scrollbar_set_value"); + + procedure fl_scrollbar_set_value2 + (S : in System.Address; + P, W, F, T : in Interfaces.C.int); + pragma Import (C, fl_scrollbar_set_value2, "fl_scrollbar_set_value2"); + + + + + procedure fl_scrollbar_draw + (W : in System.Address); + pragma Import (C, fl_scrollbar_draw, "fl_scrollbar_draw"); + + function fl_scrollbar_handle + (W : in System.Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_scrollbar_handle, "fl_scrollbar_handle"); + + + + + procedure Finalize + (This : in out Scrollbar) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Scrollbar'Class + then + free_fl_scrollbar (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Slider (This)); + end Finalize; + + + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Scrollbar is + begin + return This : Scrollbar do + This.Void_Ptr := new_fl_scrollbar + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + scrollbar_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); + scrollbar_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + end return; + end Create; + + end Forge; + + + + + function Get_Line_Size + (This : in Scrollbar) + return Natural is + begin + return Natural (fl_scrollbar_get_linesize (This.Void_Ptr)); + end Get_Line_Size; + + + procedure Set_Line_Size + (This : in out Scrollbar; + To : in Natural) is + begin + fl_scrollbar_set_linesize (This.Void_Ptr, Interfaces.C.int (To)); + end Set_Line_Size; + + + function Get_Position + (This : in Scrollbar) + return Natural is + begin + return Natural (fl_scrollbar_get_value (This.Void_Ptr)); + end Get_Position; + + + procedure Set_Position + (This : in out Scrollbar; + To : in Natural) is + begin + fl_scrollbar_set_value (This.Void_Ptr, Interfaces.C.int (To)); + end Set_Position; + + + procedure Set_All + (This : in out Scrollbar; + Position : in Natural; + Win_Size : in Natural; + First_Line : in Natural; + Total_Lines : in Natural) is + begin + fl_scrollbar_set_value2 + (This.Void_Ptr, + Interfaces.C.int (Position), + Interfaces.C.int (Win_Size), + Interfaces.C.int (First_Line), + Interfaces.C.int (Total_Lines)); + end Set_All; + + + + + procedure Draw + (This : in out Scrollbar) is + begin + fl_scrollbar_draw (This.Void_Ptr); + end Draw; + + + function Handle + (This : in out Scrollbar; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_scrollbar_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + +end FLTK.Widgets.Valuators.Sliders.Scrollbars; + diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.ads b/src/fltk-widgets-valuators-sliders-scrollbars.ads new file mode 100644 index 0000000..9b229b6 --- /dev/null +++ b/src/fltk-widgets-valuators-sliders-scrollbars.ads @@ -0,0 +1,68 @@ + + +package FLTK.Widgets.Valuators.Sliders.Scrollbars is + + + type Scrollbar is new Slider with private; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Scrollbar; + + end Forge; + + + + + function Get_Line_Size + (This : in Scrollbar) + return Natural; + + procedure Set_Line_Size + (This : in out Scrollbar; + To : in Natural); + + function Get_Position + (This : in Scrollbar) + return Natural; + + procedure Set_Position + (This : in out Scrollbar; + To : in Natural); + + procedure Set_All + (This : in out Scrollbar; + Position : in Natural; + Win_Size : in Natural; + First_Line : in Natural; + Total_Lines : in Natural); + + + + + procedure Draw + (This : in out Scrollbar); + + function Handle + (This : in out Scrollbar; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Scrollbar is new Slider with null record; + + overriding procedure Finalize + (This : in out Scrollbar); + + +end FLTK.Widgets.Valuators.Sliders.Scrollbars; + |