From c99849a1aa5df79119d7541e11eedc93202e6907 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sat, 26 Oct 2024 20:31:28 +1300 Subject: Fl_Help_View now bound --- src/c_fl_help_view.cpp | 196 +++++++++++ src/c_fl_help_view.h | 67 ++++ src/fltk-widgets-groups-help_views.adb | 572 +++++++++++++++++++++++++++++++++ src/fltk-widgets-groups-help_views.ads | 218 +++++++++++++ 4 files changed, 1053 insertions(+) create mode 100644 src/c_fl_help_view.cpp create mode 100644 src/c_fl_help_view.h create mode 100644 src/fltk-widgets-groups-help_views.adb create mode 100644 src/fltk-widgets-groups-help_views.ads (limited to 'src') diff --git a/src/c_fl_help_view.cpp b/src/c_fl_help_view.cpp new file mode 100644 index 0000000..33f1e5f --- /dev/null +++ b/src/c_fl_help_view.cpp @@ -0,0 +1,196 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include +#include +#include "c_fl_help_view.h" +#include "c_fl_type.h" + + + + +class My_Help_View : public Fl_Help_View { + public: + using Fl_Help_View::Fl_Help_View; + friend void help_view_set_draw_hook(HELPVIEW v, void * d); + friend void fl_help_view_draw(HELPVIEW v); + friend void help_view_set_handle_hook(HELPVIEW v, void * h); + friend int fl_help_view_handle(HELPVIEW v, 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_Help_View::draw() { + (*draw_hook)(this->user_data()); +} + +void My_Help_View::real_draw() { + #if FL_ABI_VERSION >= 10303 + Fl_Help_View::draw(); + #else + Fl_Group::draw(); + #endif +} + +int My_Help_View::handle(int e) { + return (*handle_hook)(this->user_data(), e); +} + +int My_Help_View::real_handle(int e) { + #if FL_ABI_VERSION >= 10303 + return Fl_Help_View::handle(e); + #else + return Fl_Group::handle(e); + #endif +} + +void help_view_set_draw_hook(HELPVIEW v, void * d) { + reinterpret_cast(v)->draw_hook = reinterpret_cast(d); +} + +void fl_help_view_draw(HELPVIEW v) { + reinterpret_cast(v)->real_draw(); +} + +void help_view_set_handle_hook(HELPVIEW v, void * h) { + reinterpret_cast(v)->handle_hook = reinterpret_cast(h); +} + +int fl_help_view_handle(HELPVIEW v, int e) { + return reinterpret_cast(v)->real_handle(e); +} + + + + +HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label) { + My_Help_View *v = new My_Help_View(x, y, w, h, label); + return v; +} + +void free_fl_help_view(HELPVIEW v) { + delete reinterpret_cast(v); +} + + + + +void fl_help_view_clear_selection(HELPVIEW v) { + reinterpret_cast(v)->clear_selection(); +} + +void fl_help_view_select_all(HELPVIEW v) { + reinterpret_cast(v)->select_all(); +} + + + + +int fl_help_view_find(HELPVIEW v, const char * s, int p) { + return reinterpret_cast(v)->find(s, p); +} + +int fl_help_view_get_leftline(HELPVIEW v) { + return reinterpret_cast(v)->leftline(); +} + +void fl_help_view_set_leftline(HELPVIEW v, int t) { + reinterpret_cast(v)->leftline(t); +} + +int fl_help_view_get_topline(HELPVIEW v) { + return reinterpret_cast(v)->topline(); +} + +void fl_help_view_set_topline(HELPVIEW v, int t) { + reinterpret_cast(v)->topline(t); +} + +void fl_help_view_set_topline_target(HELPVIEW v, const char * t) { + reinterpret_cast(v)->topline(t); +} + + + + +const char * fl_help_view_directory(HELPVIEW v) { + return reinterpret_cast(v)->directory(); +} + +const char * fl_help_view_filename(HELPVIEW v) { + return reinterpret_cast(v)->filename(); +} + +int fl_help_view_load(HELPVIEW v, const char * f) { + return reinterpret_cast(v)->load(f); +} + +const char * fl_help_view_title(HELPVIEW v) { + return reinterpret_cast(v)->title(); +} + +const char * fl_help_view_get_value(HELPVIEW v) { + return reinterpret_cast(v)->value(); +} + +void fl_help_view_set_value(HELPVIEW v, const char * t) { + reinterpret_cast(v)->value(t); +} + +void fl_help_view_link(HELPVIEW v, void * f) { + reinterpret_cast(v)->link(reinterpret_cast(f)); +} + + + + +int fl_help_view_get_scrollbar_size(HELPVIEW v) { + return reinterpret_cast(v)->scrollbar_size(); +} + +void fl_help_view_set_scrollbar_size(HELPVIEW v, int s) { + reinterpret_cast(v)->scrollbar_size(s); +} + +int fl_help_view_get_size(HELPVIEW v) { + return reinterpret_cast(v)->size(); +} + +void fl_help_view_set_size(HELPVIEW v, int w, int h) { + reinterpret_cast(v)->size(w, h); +} + +unsigned int fl_help_view_get_textcolor(HELPVIEW v) { + return reinterpret_cast(v)->textcolor(); +} + +void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c) { + reinterpret_cast(v)->textcolor(c); +} + +int fl_help_view_get_textfont(HELPVIEW v) { + return reinterpret_cast(v)->textfont(); +} + +void fl_help_view_set_textfont(HELPVIEW v, int f) { + reinterpret_cast(v)->textfont(f); +} + +int fl_help_view_get_textsize(HELPVIEW v) { + return reinterpret_cast(v)->textsize(); +} + +void fl_help_view_set_textsize(HELPVIEW v, int s) { + reinterpret_cast(v)->textsize(s); +} + + diff --git a/src/c_fl_help_view.h b/src/c_fl_help_view.h new file mode 100644 index 0000000..b76d907 --- /dev/null +++ b/src/c_fl_help_view.h @@ -0,0 +1,67 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_HELP_VIEW_GUARD +#define FL_HELP_VIEW_GUARD + + + + +typedef void* HELPVIEW; + + + + +extern "C" void help_view_set_draw_hook(HELPVIEW v, void * d); +extern "C" void fl_help_view_draw(HELPVIEW v); +extern "C" void help_view_set_handle_hook(HELPVIEW v, void * h); +extern "C" int fl_help_view_handle(HELPVIEW v, int e); + + + + +extern "C" HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label); +extern "C" void free_fl_help_view(HELPVIEW v); + + + + +extern "C" void fl_help_view_clear_selection(HELPVIEW v); +extern "C" void fl_help_view_select_all(HELPVIEW v); + + +extern "C" int fl_help_view_find(HELPVIEW v, const char * s, int p); +extern "C" int fl_help_view_get_leftline(HELPVIEW v); +extern "C" void fl_help_view_set_leftline(HELPVIEW v, int t); +extern "C" int fl_help_view_get_topline(HELPVIEW v); +extern "C" void fl_help_view_set_topline(HELPVIEW v, int t); +extern "C" void fl_help_view_set_topline_target(HELPVIEW v, const char * t); + + +extern "C" const char * fl_help_view_directory(HELPVIEW v); +extern "C" const char * fl_help_view_filename(HELPVIEW v); +extern "C" int fl_help_view_load(HELPVIEW v, const char * f); +extern "C" const char * fl_help_view_title(HELPVIEW v); +extern "C" const char * fl_help_view_get_value(HELPVIEW v); +extern "C" void fl_help_view_set_value(HELPVIEW v, const char * t); +extern "C" void fl_help_view_link(HELPVIEW v, void * f); + + +extern "C" int fl_help_view_get_scrollbar_size(HELPVIEW v); +extern "C" void fl_help_view_set_scrollbar_size(HELPVIEW v, int s); +extern "C" int fl_help_view_get_size(HELPVIEW v); +extern "C" void fl_help_view_set_size(HELPVIEW v, int w, int h); +extern "C" unsigned int fl_help_view_get_textcolor(HELPVIEW v); +extern "C" void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c); +extern "C" int fl_help_view_get_textfont(HELPVIEW v); +extern "C" void fl_help_view_set_textfont(HELPVIEW v, int f); +extern "C" int fl_help_view_get_textsize(HELPVIEW v); +extern "C" void fl_help_view_set_textsize(HELPVIEW v, int s); + + +#endif + + diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb new file mode 100644 index 0000000..b1ac905 --- /dev/null +++ b/src/fltk-widgets-groups-help_views.adb @@ -0,0 +1,572 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings, + System.Address_To_Access_Conversions; + +use type + + Interfaces.C.int; + + +package body FLTK.Widgets.Groups.Help_Views is + + + ------------------------ + -- Functions From C -- + ------------------------ + + procedure help_view_set_draw_hook + (V, D : in Storage.Integer_Address); + pragma Import (C, help_view_set_draw_hook, "help_view_set_draw_hook"); + pragma Inline (help_view_set_draw_hook); + + procedure help_view_set_handle_hook + (V, H : in Storage.Integer_Address); + pragma Import (C, help_view_set_handle_hook, "help_view_set_handle_hook"); + pragma Inline (help_view_set_handle_hook); + + + + + function new_fl_help_view + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_help_view, "new_fl_help_view"); + pragma Inline (new_fl_help_view); + + procedure free_fl_help_view + (V : in Storage.Integer_Address); + pragma Import (C, free_fl_help_view, "free_fl_help_view"); + pragma Inline (free_fl_help_view); + + + + + procedure fl_help_view_clear_selection + (V : in Storage.Integer_Address); + pragma Import (C, fl_help_view_clear_selection, "fl_help_view_clear_selection"); + pragma Inline (fl_help_view_clear_selection); + + procedure fl_help_view_select_all + (V : in Storage.Integer_Address); + pragma Import (C, fl_help_view_select_all, "fl_help_view_select_all"); + pragma Inline (fl_help_view_select_all); + + + + + function fl_help_view_find + (V : in Storage.Integer_Address; + S : in Interfaces.C.char_array; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_help_view_find, "fl_help_view_find"); + pragma Inline (fl_help_view_find); + + function fl_help_view_get_leftline + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_leftline, "fl_help_view_get_leftline"); + pragma Inline (fl_help_view_get_leftline); + + procedure fl_help_view_set_leftline + (V : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_leftline, "fl_help_view_set_leftline"); + pragma Inline (fl_help_view_set_leftline); + + function fl_help_view_get_topline + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_topline, "fl_help_view_get_topline"); + pragma Inline (fl_help_view_get_topline); + + procedure fl_help_view_set_topline + (V : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_topline, "fl_help_view_set_topline"); + pragma Inline (fl_help_view_set_topline); + + procedure fl_help_view_set_topline_target + (V : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_help_view_set_topline_target, "fl_help_view_set_topline_target"); + pragma Inline (fl_help_view_set_topline_target); + + + + + function fl_help_view_directory + (V : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_help_view_directory, "fl_help_view_directory"); + pragma Inline (fl_help_view_directory); + + function fl_help_view_filename + (V : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_help_view_filename, "fl_help_view_filename"); + pragma Inline (fl_help_view_filename); + + function fl_help_view_load + (V : in Storage.Integer_Address; + F : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_help_view_load, "fl_help_view_load"); + pragma Inline (fl_help_view_load); + + function fl_help_view_title + (V : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_help_view_title, "fl_help_view_title"); + pragma Inline (fl_help_view_title); + + function fl_help_view_get_value + (V : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_help_view_get_value, "fl_help_view_get_value"); + pragma Inline (fl_help_view_get_value); + + procedure fl_help_view_set_value + (V : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_help_view_set_value, "fl_help_view_set_value"); + pragma Inline (fl_help_view_set_value); + + procedure fl_help_view_link + (V, F : in Storage.Integer_Address); + pragma Import (C, fl_help_view_link, "fl_help_view_link"); + pragma Inline (fl_help_view_link); + + + + + function fl_help_view_get_scrollbar_size + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_scrollbar_size, "fl_help_view_get_scrollbar_size"); + pragma Inline (fl_help_view_get_scrollbar_size); + + procedure fl_help_view_set_scrollbar_size + (V : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_scrollbar_size, "fl_help_view_set_scrollbar_size"); + pragma Inline (fl_help_view_set_scrollbar_size); + + function fl_help_view_get_size + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_size, "fl_help_view_get_size"); + pragma Inline (fl_help_view_get_size); + + procedure fl_help_view_set_size + (V : in Storage.Integer_Address; + W, H : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_size, "fl_help_view_set_size"); + pragma Inline (fl_help_view_set_size); + + function fl_help_view_get_textcolor + (V : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_help_view_get_textcolor, "fl_help_view_get_textcolor"); + pragma Inline (fl_help_view_get_textcolor); + + procedure fl_help_view_set_textcolor + (V : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_help_view_set_textcolor, "fl_help_view_set_textcolor"); + pragma Inline (fl_help_view_set_textcolor); + + function fl_help_view_get_textfont + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_textfont, "fl_help_view_get_textfont"); + pragma Inline (fl_help_view_get_textfont); + + procedure fl_help_view_set_textfont + (V : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_textfont, "fl_help_view_set_textfont"); + pragma Inline (fl_help_view_set_textfont); + + function fl_help_view_get_textsize + (V : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_help_view_get_textsize, "fl_help_view_get_textsize"); + pragma Inline (fl_help_view_get_textsize); + + procedure fl_help_view_set_textsize + (V : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_help_view_set_textsize, "fl_help_view_set_textsize"); + pragma Inline (fl_help_view_set_textsize); + + + + + procedure fl_help_view_draw + (V : in Storage.Integer_Address); + pragma Import (C, fl_help_view_draw, "fl_help_view_draw"); + pragma Inline (fl_help_view_draw); + + function fl_help_view_handle + (V : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_help_view_handle, "fl_help_view_handle"); + pragma Inline (fl_help_view_handle); + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + package Help_View_Convert is new System.Address_To_Access_Conversions (Help_View'Class); + + function Link_Callback_Hook + (V : in Storage.Integer_Address; + S : in Interfaces.C.Strings.chars_ptr) + return Interfaces.C.Strings.chars_ptr; + + pragma Convention (C, Link_Callback_Hook); + + function Link_Callback_Hook + (V : in Storage.Integer_Address; + S : in Interfaces.C.Strings.chars_ptr) + return Interfaces.C.Strings.chars_ptr + is + Ada_Help_View : access Help_View'Class := + Help_View_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (V))); + begin + if Ada_Help_View.Zelda = null then + return S; + end if; + Interfaces.C.Strings.Free (Ada_Help_View.Hilda); + Ada_Help_View.Hilda := Interfaces.C.Strings.New_String + (Ada_Help_View.Zelda (Ada_Help_View.all, Interfaces.C.Strings.Value (S))); + if Interfaces.C.Strings.Value (Ada_Help_View.Hilda) = "" then + return Interfaces.C.Strings.Null_Ptr; + else + return Ada_Help_View.Hilda; + end if; + end Link_Callback_Hook; + + + + + ----------------------------------- + -- Controlled Type Subprograms -- + ----------------------------------- + + procedure Finalize + (This : in out Help_View) is + begin + if This.Void_Ptr /= Null_Pointer and then + This in Help_View'Class + then + free_fl_help_view (This.Void_Ptr); + Interfaces.C.Strings.Free (This.Hilda); + This.Void_Ptr := Null_Pointer; + end if; + Finalize (Group (This)); + end Finalize; + + + + + --------------------- + -- Help_View API -- + --------------------- + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Help_View is + begin + return This : Help_View do + This.Void_Ptr := new_fl_help_view + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + help_view_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + help_view_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); + fl_help_view_link (This.Void_Ptr, Storage.To_Integer (Link_Callback_Hook'Address)); + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end return; + end Create; + + end Forge; + + + + + procedure Clear_Selection + (This : in out Help_View) is + begin + fl_help_view_clear_selection (This.Void_Ptr); + end Clear_Selection; + + + procedure Select_All + (This : in out Help_View) is + begin + fl_help_view_select_all (This.Void_Ptr); + end Select_All; + + + + + function Find + (This : in Help_View; + Item : in String; + From : in Position := 1) + return Extended_Position is + begin + return Extended_Position (fl_help_view_find + (This.Void_Ptr, + Interfaces.C.To_C (Item), + Interfaces.C.int (From) - 1) + 1); + end Find; + + + function Get_Leftline_Pixel + (This : in Help_View) + return Natural is + begin + return Natural (fl_help_view_get_leftline (This.Void_Ptr)); + end Get_Leftline_Pixel; + + + procedure Set_Leftline_Pixel + (This : in out Help_View; + Value : in Natural) is + begin + fl_help_view_set_leftline (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Leftline_Pixel; + + + function Get_Topline_Pixel + (This : in Help_View) + return Natural is + begin + return Natural (fl_help_view_get_topline (This.Void_Ptr)); + end Get_Topline_Pixel; + + + procedure Set_Topline_Pixel + (This : in out Help_View; + Value : in Natural) is + begin + fl_help_view_set_topline (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Topline_Pixel; + + + procedure Set_Topline_Target + (This : in out Help_View; + Value : in String) is + begin + fl_help_view_set_topline_target (This.Void_Ptr, Interfaces.C.To_C (Value)); + end Set_Topline_Target; + + + + + function Current_Directory + (This : in Help_View) + return String is + begin + return Interfaces.C.Strings.Value (fl_help_view_directory (This.Void_Ptr)); + end Current_Directory; + + + function Current_File + (This : in Help_View) + return String is + begin + return Interfaces.C.Strings.Value (fl_help_view_filename (This.Void_Ptr)); + end Current_File; + + + procedure Load + (This : in out Help_View; + Name : in String) + is + Code : Interfaces.C.int := fl_help_view_load (This.Void_Ptr, Interfaces.C.To_C (Name)); + begin + if Code = -1 then + raise Load_Help_Error; + elsif Code /= 0 then + raise Program_Error; + end if; + end Load; + + + function Document_Title + (This : in Help_View) + return String + is + Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_title (This.Void_Ptr); + use type Interfaces.C.Strings.chars_ptr; + begin + if Raw_Chars = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Raw_Chars); + end if; + end Document_Title; + + + function Get_Content + (This : in Help_View) + return String + is + Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_get_value (This.Void_Ptr); + use type Interfaces.C.Strings.chars_ptr; + begin + if Raw_Chars = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Raw_Chars); + end if; + end Get_Content; + + + procedure Set_Content + (This : in out Help_View; + Value : in String) is + begin + fl_help_view_set_value (This.Void_Ptr, Interfaces.C.To_C (Value)); + end Set_Content; + + + procedure Set_Link_Callback + (This : in out Help_View; + Func : in Link_Callback) is + begin + This.Zelda := Func; + end Set_Link_Callback; + + + + + function Get_Scrollbar_Size + (This : in Help_View) + return Natural is + begin + return Natural (fl_help_view_get_scrollbar_size (This.Void_Ptr)); + end Get_Scrollbar_Size; + + + procedure Set_Scrollbar_Size + (This : in out Help_View; + Value : in Natural) is + begin + fl_help_view_set_scrollbar_size (This.Void_Ptr, Interfaces.C.int (Value)); + end Set_Scrollbar_Size; + + + function Get_Size + (This : in Help_View) + return Integer is + begin + return Integer (fl_help_view_get_size (This.Void_Ptr)); + end Get_Size; + + + procedure Resize + (This : in out Help_View; + W, H : in Integer) is + begin + fl_help_view_set_size + (This.Void_Ptr, + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + function Get_Text_Color + (This : in Help_View) + return Color is + begin + return Color (fl_help_view_get_textcolor (This.Void_Ptr)); + end Get_Text_Color; + + + procedure Set_Text_Color + (This : in out Help_View; + Value : in Color) is + begin + fl_help_view_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value)); + end Set_Text_Color; + + + function Get_Text_Font + (This : in Help_View) + return Font_Kind is + begin + return Font_Kind'Val (fl_help_view_get_textfont (This.Void_Ptr)); + end Get_Text_Font; + + + procedure Set_Text_Font + (This : in out Help_View; + Font : in Font_Kind) is + begin + fl_help_view_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Text_Font; + + + function Get_Text_Size + (This : in Help_View) + return Font_Size is + begin + return Font_Size (fl_help_view_get_textsize (This.Void_Ptr)); + end Get_Text_Size; + + + procedure Set_Text_Size + (This : in out Help_View; + Size : in Font_Size) is + begin + fl_help_view_set_textsize (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Text_Size; + + + + + procedure Draw + (This : in out Help_View) is + begin + fl_help_view_draw (This.Void_Ptr); + end Draw; + + + function Handle + (This : in out Help_View; + Event : in Event_Kind) + return Event_Outcome is + begin + return Event_Outcome'Val + (fl_help_view_handle (This.Void_Ptr, Event_Kind'Pos (Event))); + end Handle; + + +end FLTK.Widgets.Groups.Help_Views; + + diff --git a/src/fltk-widgets-groups-help_views.ads b/src/fltk-widgets-groups-help_views.ads new file mode 100644 index 0000000..9c4a0ae --- /dev/null +++ b/src/fltk-widgets-groups-help_views.ads @@ -0,0 +1,218 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +private with + + Interfaces.C.Strings; + + +package FLTK.Widgets.Groups.Help_Views is + + + type Help_View is new Group with private; + + type Help_View_Reference (Data : not null access Help_View'Class) is limited null record + with Implicit_Dereference => Data; + + subtype Position is Positive; + subtype Extended_Position is Natural; + + No_Position : constant Extended_Position := 0; + + type Link_Callback is access function + (Item : in out Help_View'Class; + URI : in String) + return String; + + + + + -- You have no idea how tempting it is to give this + -- a more tongue in cheek name + Load_Help_Error : exception; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Help_View; + + end Forge; + + + + + procedure Clear_Selection + (This : in out Help_View); + + procedure Select_All + (This : in out Help_View); + + + + + function Find + (This : in Help_View; + Item : in String; + From : in Position := 1) + return Extended_Position; + + function Get_Leftline_Pixel + (This : in Help_View) + return Natural; + + procedure Set_Leftline_Pixel + (This : in out Help_View; + Value : in Natural); + + function Get_Topline_Pixel + (This : in Help_View) + return Natural; + + procedure Set_Topline_Pixel + (This : in out Help_View; + Value : in Natural); + + procedure Set_Topline_Target + (This : in out Help_View; + Value : in String); + + + + + function Current_Directory + (This : in Help_View) + return String; + + function Current_File + (This : in Help_View) + return String; + + -- Name here can be either a ftp/http/https/ipp/mailto/news URL or a filename + procedure Load + (This : in out Help_View; + Name : in String); + + function Document_Title + (This : in Help_View) + return String; + + function Get_Content + (This : in Help_View) + return String; + + procedure Set_Content + (This : in out Help_View; + Value : in String); + + procedure Set_Link_Callback + (This : in out Help_View; + Func : in Link_Callback); + + + + + function Get_Scrollbar_Size + (This : in Help_View) + return Natural; + + procedure Set_Scrollbar_Size + (This : in out Help_View; + Value : in Natural); + + function Get_Size + (This : in Help_View) + return Integer; + + procedure Resize + (This : in out Help_View; + W, H : in Integer); + + function Get_Text_Color + (This : in Help_View) + return Color; + + procedure Set_Text_Color + (This : in out Help_View; + Value : in Color); + + function Get_Text_Font + (This : in Help_View) + return Font_Kind; + + procedure Set_Text_Font + (This : in out Help_View; + Font : in Font_Kind); + + function Get_Text_Size + (This : in Help_View) + return Font_Size; + + procedure Set_Text_Size + (This : in out Help_View; + Size : in Font_Size); + + + + + procedure Draw + (This : in out Help_View); + + function Handle + (This : in out Help_View; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Help_View is new Group with record + Zelda : Link_Callback; + Hilda : Interfaces.C.Strings.chars_ptr; + end record; + + overriding procedure Finalize + (This : in out Help_View); + + + pragma Inline (Clear_Selection); + pragma Inline (Select_All); + + pragma Inline (Find); + pragma Inline (Get_Leftline_Pixel); + pragma Inline (Set_Leftline_Pixel); + pragma Inline (Get_Topline_Pixel); + pragma Inline (Set_Topline_Pixel); + pragma Inline (Set_Topline_Target); + + pragma Inline (Current_Directory); + pragma Inline (Current_File); + pragma Inline (Set_Content); + pragma Inline (Set_Link_Callback); + + pragma Inline (Get_Scrollbar_Size); + pragma Inline (Set_Scrollbar_Size); + pragma Inline (Get_Size); + pragma Inline (Resize); + pragma Inline (Get_Text_Color); + pragma Inline (Set_Text_Color); + pragma Inline (Get_Text_Font); + pragma Inline (Set_Text_Font); + pragma Inline (Get_Text_Size); + pragma Inline (Set_Text_Size); + + pragma Inline (Draw); + pragma Inline (Handle); + + +end FLTK.Widgets.Groups.Help_Views; + + -- cgit