From f18aa62c78dd25851d47b611f564a14fabb5a5e2 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 6 May 2018 13:54:08 +1000 Subject: Finished and polished FLTK, FLTK.Event, FLTK.Screen, FLTK.Static --- src/c_fl.cpp | 74 +++- src/c_fl.h | 25 +- src/c_fl_static.cpp | 299 +++++++++++++++ src/c_fl_static.h | 104 ++++++ src/fltk-event.ads | 57 +++ src/fltk-screen.adb | 11 +- src/fltk-screen.ads | 7 +- src/fltk-static.adb | 1012 +++++++++++++++++++++++++++++++++++++++++++++++++++ src/fltk-static.ads | 449 +++++++++++++++++++++++ src/fltk.adb | 159 +++++++- src/fltk.ads | 154 ++++++-- 11 files changed, 2308 insertions(+), 43 deletions(-) create mode 100644 src/c_fl_static.cpp create mode 100644 src/c_fl_static.h create mode 100644 src/fltk-static.adb create mode 100644 src/fltk-static.ads (limited to 'src') diff --git a/src/c_fl.cpp b/src/c_fl.cpp index b628c41..237c33a 100644 --- a/src/c_fl.cpp +++ b/src/c_fl.cpp @@ -4,7 +4,79 @@ #include "c_fl.h" -int fl_run(void) { + + +int fl_abi_check(int v) { + return Fl::abi_check(v); +} + +int fl_abi_version() { + return Fl::abi_version(); +} + +int fl_api_version() { + return Fl::api_version(); +} + +double fl_version() { + return Fl::version(); +} + + + + +void fl_awake() { + Fl::awake(); +} + +void fl_lock() { + Fl::lock(); +} + +void fl_unlock() { + Fl::unlock(); +} + + + + +int fl_get_damage() { + return Fl::damage(); +} + +void fl_set_damage(int v) { + Fl::damage(v); +} + +void fl_flush() { + Fl::flush(); +} + +void fl_redraw() { + Fl::redraw(); +} + + + + +int fl_check() { + return Fl::check(); +} + +int fl_ready() { + return Fl::ready(); +} + +int fl_wait() { + return Fl::wait(); +} + +int fl_wait2(double s) { + return Fl::wait(s); +} + +int fl_run() { return Fl::run(); } + diff --git a/src/c_fl.h b/src/c_fl.h index 69e2e72..2a37179 100644 --- a/src/c_fl.h +++ b/src/c_fl.h @@ -4,7 +4,30 @@ #define FL_GUARD -extern "C" int fl_run(void); + + +extern "C" inline int fl_abi_check(int v); +extern "C" inline int fl_abi_version(); +extern "C" inline int fl_api_version(); +extern "C" inline double fl_version(); + + +extern "C" inline void fl_awake(); +extern "C" inline void fl_lock(); +extern "C" inline void fl_unlock(); + + +extern "C" inline int fl_get_damage(); +extern "C" inline void fl_set_damage(int v); +extern "C" inline void fl_flush(); +extern "C" inline void fl_redraw(); + + +extern "C" inline int fl_check(); +extern "C" inline int fl_ready(); +extern "C" inline int fl_wait(); +extern "C" inline int fl_wait2(double s); +extern "C" inline int fl_run(); #endif diff --git a/src/c_fl_static.cpp b/src/c_fl_static.cpp new file mode 100644 index 0000000..e520d42 --- /dev/null +++ b/src/c_fl_static.cpp @@ -0,0 +1,299 @@ + + +#include +#include +#include +#include "c_fl_static.h" + + + + +void fl_static_add_awake_handler(void * h, void * f) { + Fl::add_awake_handler_(reinterpret_cast(h),f); +} + +void fl_static_get_awake_handler(void * &h, void * &f) { + Fl::get_awake_handler_(reinterpret_cast(h),f); +} + + + + +void fl_static_add_check(void * h, void * f) { + Fl::add_check(reinterpret_cast(h),f); +} + +int fl_static_has_check(void * h, void * f) { + return Fl::has_check(reinterpret_cast(h),f); +} + +void fl_static_remove_check(void * h, void * f) { + Fl::remove_check(reinterpret_cast(h),f); +} + + + + +void fl_static_add_timeout(double s, void * h, void * f) { + Fl::add_timeout(s,reinterpret_cast(h),f); +} + +int fl_static_has_timeout(void * h, void * f) { + return Fl::has_timeout(reinterpret_cast(h),f); +} + +void fl_static_remove_timeout(void * h, void * f) { + Fl::remove_timeout(reinterpret_cast(h),f); +} + +void fl_static_repeat_timeout(double s, void * h, void * f) { + Fl::repeat_timeout(s,reinterpret_cast(h),f); +} + + + + +void fl_static_add_clipboard_notify(void * h, void * f) { + Fl::add_clipboard_notify(reinterpret_cast(h),f); +} + + + + +void fl_static_add_fd(int d, void * h, void * f) { + Fl::add_fd(d,reinterpret_cast(h),f); +} + +void fl_static_add_fd2(int d, int m, void * h, void * f) { + Fl::add_fd(d,m,reinterpret_cast(h),f); +} + +void fl_static_remove_fd(int d) { + Fl::remove_fd(d); +} + +void fl_static_remove_fd2(int d, int m) { + Fl::remove_fd(d,m); +} + + + + +void fl_static_add_idle(void * h, void * f) { + Fl::add_idle(reinterpret_cast(h),f); +} + +int fl_static_has_idle(void * h, void * f) { + return Fl::has_idle(reinterpret_cast(h),f); +} + +void fl_static_remove_idle(void * h, void * f) { + Fl::remove_idle(reinterpret_cast(h),f); +} + + + + +void fl_static_get_color(unsigned int c, unsigned char &r, unsigned char &g, unsigned char &b) { + Fl::get_color(c,r,g,b); +} + +void fl_static_set_color(unsigned int c, unsigned char r, unsigned char g, unsigned char b) { + Fl::set_color(c,r,g,b); +} + +void fl_static_free_color(unsigned int c, int b) { + Fl::free_color(c,b); +} + +void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b) { + Fl::foreground(r,g,b); +} + +void fl_static_background(unsigned int r, unsigned int g, unsigned int b) { + Fl::background(r,g,b); +} + +void fl_static_background2(unsigned int r, unsigned int g, unsigned int b) { + Fl::background2(r,g,b); +} + + + + +const char * fl_static_get_font(int f) { + return Fl::get_font(f); +} + +const char * fl_static_get_font_name(int f) { + return Fl::get_font_name(f); +} + +void fl_static_set_font(int t, int f) { + Fl::set_font(t,f); +} + +int fl_static_get_font_sizes(int f, int * &a) { + return Fl::get_font_sizes(static_cast(f),a); +} + +int fl_static_font_size_array_get(int * a, int i) { + return *(a+((i-1)*sizeof(int))); +} + +int fl_static_set_fonts() { + return Fl::set_fonts(); +} + + + + +int fl_static_box_dh(int b) { + return Fl::box_dh(static_cast(b)); +} + +int fl_static_box_dw(int b) { + return Fl::box_dw(static_cast(b)); +} + +int fl_static_box_dx(int b) { + return Fl::box_dx(static_cast(b)); +} + +int fl_static_box_dy(int b) { + return Fl::box_dy(static_cast(b)); +} + +void fl_static_set_boxtype(int t, int f) { + Fl::set_boxtype(static_cast(t),static_cast(f)); +} + +int fl_static_draw_box_active() { + return Fl::draw_box_active(); +} + + + + +void fl_static_copy(const char * t, int l, int k) { + Fl::copy(t,l,k); +} + +void fl_static_paste(void * r, int s) { + Fl::paste(reinterpret_cast(r),s); +} + +void fl_static_selection(void * o, char * t, int l) { + Fl::selection(reinterpret_cast(o),t,l); +} + + + + +void fl_static_dnd() { + Fl::dnd(); +} + +int fl_static_get_dnd_text_ops() { + return Fl::dnd_text_ops(); +} + +void fl_static_set_dnd_text_ops(int t) { + Fl::dnd_text_ops(t); +} + + + + +void fl_static_enable_im() { + Fl::enable_im(); +} + +void fl_static_disable_im() { + Fl::disable_im(); +} + +int fl_static_get_visible_focus() { + return Fl::visible_focus(); +} + +void fl_static_set_visible_focus(int f) { + Fl::visible_focus(f); +} + + + + +void fl_static_default_atclose(void * w) { + Fl::default_atclose(reinterpret_cast(w), 0); +} + +void * fl_static_get_first_window() { + return Fl::first_window(); +} + +void fl_static_set_first_window(void * w) { + Fl::first_window(reinterpret_cast(w)); +} + +void * fl_static_next_window(void * w) { + return Fl::next_window(reinterpret_cast(w)); +} + +void * fl_static_modal() { + return Fl::modal(); +} + + + + +void * fl_static_readqueue() { + return Fl::readqueue(); +} + +void fl_static_do_widget_deletion() { + Fl::do_widget_deletion(); +} + + + + +const char * fl_static_get_scheme() { + return Fl::scheme(); +} + +void fl_static_set_scheme(const char *n) { + Fl::scheme(n); +} + +int fl_static_is_scheme(const char *n) { + return Fl::is_scheme(n); +} + +void fl_static_reload_scheme() { + Fl::reload_scheme(); +} + + + + +int fl_static_get_option(int o) { + return Fl::option(static_cast(o)); +} + +void fl_static_set_option(int o, int t) { + Fl::option(static_cast(o),t); +} + + + + +int fl_static_get_scrollbar_size() { + return Fl::scrollbar_size(); +} + +void fl_static_set_scrollbar_size(int s) { + Fl::scrollbar_size(s); +} + + diff --git a/src/c_fl_static.h b/src/c_fl_static.h new file mode 100644 index 0000000..dac01d8 --- /dev/null +++ b/src/c_fl_static.h @@ -0,0 +1,104 @@ + + +#ifndef FL_STATIC_GUARD +#define FL_STATIC_GUARD + + + + +extern "C" inline void fl_static_add_awake_handler(void * h, void * f); +extern "C" inline void fl_static_get_awake_handler(void * &h, void * &f); + + +extern "C" inline void fl_static_add_check(void * h, void * f); +extern "C" inline int fl_static_has_check(void * h, void * f); +extern "C" inline void fl_static_remove_check(void * h, void * f); + + +extern "C" inline void fl_static_add_timeout(double s, void * h, void * f); +extern "C" inline int fl_static_has_timeout(void * h, void * f); +extern "C" inline void fl_static_remove_timeout(void * h, void * f); +extern "C" inline void fl_static_repeat_timeout(double s, void * h, void * f); + + +extern "C" inline void fl_static_add_clipboard_notify(void * h, void * f); + + +extern "C" inline void fl_static_add_fd(int d, void * h, void * f); +extern "C" inline void fl_static_add_fd2(int d, int m, void * h, void * f); +extern "C" inline void fl_static_remove_fd(int d); +extern "C" inline void fl_static_remove_fd2(int d, int m); + + +extern "C" inline void fl_static_add_idle(void * h, void * f); +extern "C" inline int fl_static_has_idle(void * h, void * f); +extern "C" inline void fl_static_remove_idle(void * h, void * f); + + +extern "C" inline void fl_static_get_color(unsigned int c, unsigned char &r, unsigned char &g, unsigned char &b); +extern "C" inline void fl_static_set_color(unsigned int c, unsigned char r, unsigned char g, unsigned char b); +extern "C" inline void fl_static_free_color(unsigned int c, int b); +extern "C" inline void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b); +extern "C" inline void fl_static_background(unsigned int r, unsigned int g, unsigned int b); +extern "C" inline void fl_static_background2(unsigned int r, unsigned int g, unsigned int b); + + +extern "C" inline const char * fl_static_get_font(int f); +extern "C" inline const char * fl_static_get_font_name(int f); +extern "C" inline void fl_static_set_font(int t, int f); +extern "C" inline int fl_static_get_font_sizes(int f, int * &a); +extern "C" inline int fl_static_font_size_array_get(int * a, int i); +extern "C" inline int fl_static_set_fonts(); + + +extern "C" inline int fl_static_box_dh(int b); +extern "C" inline int fl_static_box_dw(int b); +extern "C" inline int fl_static_box_dx(int b); +extern "C" inline int fl_static_box_dy(int b); +extern "C" inline void fl_static_set_boxtype(int t, int f); +extern "C" inline int fl_static_draw_box_active(); + + +extern "C" inline void fl_static_copy(const char * t, int l, int k); +extern "C" inline void fl_static_paste(void * r, int s); +extern "C" inline void fl_static_selection(void * o, char * t, int l); + + +extern "C" inline void fl_static_dnd(); +extern "C" inline int fl_static_get_dnd_text_ops(); +extern "C" inline void fl_static_set_dnd_text_ops(int t); + + +extern "C" inline void fl_static_enable_im(); +extern "C" inline void fl_static_disable_im(); +extern "C" inline int fl_static_get_visible_focus(); +extern "C" inline void fl_static_set_visible_focus(int f); + + +extern "C" inline void fl_static_default_atclose(void * w); +extern "C" inline void * fl_static_get_first_window(); +extern "C" inline void fl_static_set_first_window(void * w); +extern "C" inline void * fl_static_next_window(void * w); +extern "C" inline void * fl_static_modal(); + + +extern "C" inline void * fl_static_readqueue(); +extern "C" inline void fl_static_do_widget_deletion(); + + +extern "C" inline const char * fl_static_get_scheme(); +extern "C" inline void fl_static_set_scheme(const char *n); +extern "C" inline int fl_static_is_scheme(const char *n); +extern "C" inline void fl_static_reload_scheme(); + + +extern "C" inline int fl_static_get_option(int o); +extern "C" inline void fl_static_set_option(int o, int t); + + +extern "C" inline int fl_static_get_scrollbar_size(); +extern "C" inline void fl_static_set_scrollbar_size(int s); + + +#endif + diff --git a/src/fltk-event.ads b/src/fltk-event.ads index 62f106a..17f5a1c 100644 --- a/src/fltk-event.ads +++ b/src/fltk-event.ads @@ -202,5 +202,62 @@ private pragma Inline (fl_widget_get_user_data); + + + pragma Inline (Add_Handler); + pragma Inline (Remove_Handler); + pragma Inline (Get_Dispatch); + pragma Inline (Set_Dispatch); + pragma Inline (Default_Dispatch); + + + pragma Inline (Get_Grab); + pragma Inline (Set_Grab); + pragma Inline (Release_Grab); + pragma Inline (Get_Pushed); + pragma Inline (Set_Pushed); + pragma Inline (Get_Below_Mouse); + pragma Inline (Set_Below_Mouse); + pragma Inline (Get_Focus); + pragma Inline (Set_Focus); + + + pragma Inline (Compose); + pragma Inline (Compose_Reset); + pragma Inline (Text); + pragma Inline (Text_Length); + + + pragma Inline (Last); + pragma Inline (Last_Modifier); + + + pragma Inline (Mouse_X); + pragma Inline (Mouse_X_Root); + pragma Inline (Mouse_Y); + pragma Inline (Mouse_Y_Root); + pragma Inline (Mouse_DX); + pragma Inline (Mouse_DY); + pragma Inline (Get_Mouse); + pragma Inline (Is_Click); + pragma Inline (Is_Multi_Click); + pragma Inline (Set_Clicks); + pragma Inline (Last_Button); + pragma Inline (Mouse_Left); + pragma Inline (Mouse_Middle); + pragma Inline (Mouse_Right); + pragma Inline (Is_Inside); + + + pragma Inline (Last_Key); + pragma Inline (Original_Last_Key); + pragma Inline (Pressed_During); + pragma Inline (Key_Now); + pragma Inline (Key_Ctrl); + pragma Inline (Key_Alt); + pragma Inline (Key_Command); + pragma Inline (Key_Shift); + + end FLTK.Event; diff --git a/src/fltk-screen.adb b/src/fltk-screen.adb index 284b0bd..e556d14 100644 --- a/src/fltk-screen.adb +++ b/src/fltk-screen.adb @@ -145,13 +145,12 @@ package body FLTK.Screen is -- Screen numbers in the range 1 .. Get_Count procedure DPI (Horizontal, Vertical : out Float; - Screen_Number : in Integer := 1) - is - H, V : Interfaces.C.C_float; + Screen_Number : in Integer := 1) is begin - fl_screen_dpi (H, V, Interfaces.C.int (Screen_Number) - 1); - Horizontal := Float (H); - Vertical := Float (V); + fl_screen_dpi + (Interfaces.C.C_float (Horizontal), + Interfaces.C.C_float (Vertical), + Interfaces.C.int (Screen_Number) - 1); end DPI; diff --git a/src/fltk-screen.ads b/src/fltk-screen.ads index 0656619..8cf535e 100644 --- a/src/fltk-screen.ads +++ b/src/fltk-screen.ads @@ -18,7 +18,8 @@ package FLTK.Screen is - function Count return Integer; + function Count + return Integer; -- Screen numbers in the range 1 .. Count procedure DPI @@ -76,8 +77,12 @@ private pragma Inline (Get_Y); pragma Inline (Get_W); pragma Inline (Get_H); + + pragma Inline (Count); pragma Inline (DPI); + + pragma Inline (Containing); pragma Inline (Work_Area); pragma Inline (Bounding_Rect); diff --git a/src/fltk-static.adb b/src/fltk-static.adb new file mode 100644 index 0000000..41771f9 --- /dev/null +++ b/src/fltk-static.adb @@ -0,0 +1,1012 @@ + + +with + + Interfaces.C.Strings, + System.Address_To_Access_Conversions, + Ada.Unchecked_Conversion; + +use type + + Interfaces.C.int; + + +package body FLTK.Static is + + + procedure fl_static_add_awake_handler + (H, F : in System.Address); + pragma Import (C, fl_static_add_awake_handler, "fl_static_add_awake_handler"); + pragma Inline (fl_static_add_awake_handler); + + procedure fl_static_get_awake_handler + (H, F : out System.Address); + pragma Import (C, fl_static_get_awake_handler, "fl_static_get_awake_handler"); + pragma Inline (fl_static_get_awake_handler); + + + + + procedure fl_static_add_check + (H, F : in System.Address); + pragma Import (C, fl_static_add_check, "fl_static_add_check"); + pragma Inline (fl_static_add_check); + + function fl_static_has_check + (H, F : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_static_has_check, "fl_static_has_check"); + pragma Inline (fl_static_has_check); + + procedure fl_static_remove_check + (H, F : in System.Address); + pragma Import (C, fl_static_remove_check, "fl_static_remove_check"); + pragma Inline (fl_static_remove_check); + + + + + procedure fl_static_add_timeout + (S : in Interfaces.C.double; + H, F : in System.Address); + pragma Import (C, fl_static_add_timeout, "fl_static_add_timeout"); + pragma Inline (fl_static_add_timeout); + + function fl_static_has_timeout + (H, F : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_static_has_timeout, "fl_static_has_timeout"); + pragma Inline (fl_static_has_timeout); + + procedure fl_static_remove_timeout + (H, F : in System.Address); + pragma Import (C, fl_static_remove_timeout, "fl_static_remove_timeout"); + pragma Inline (fl_static_remove_timeout); + + procedure fl_static_repeat_timeout + (S : in Interfaces.C.double; + H, F : in System.Address); + pragma Import (C, fl_static_repeat_timeout, "fl_static_repeat_timeout"); + pragma Inline (fl_static_repeat_timeout); + + + + + procedure fl_static_add_clipboard_notify + (H, F : in System.Address); + pragma Import (C, fl_static_add_clipboard_notify, "fl_static_add_clipboard_notify"); + pragma Inline (fl_static_add_clipboard_notify); + + + + + procedure fl_static_add_fd + (D : in Interfaces.C.int; + H, F : in System.Address); + pragma Import (C, fl_static_add_fd, "fl_static_add_fd"); + pragma Inline (fl_static_add_fd); + + procedure fl_static_add_fd2 + (D, M : in Interfaces.C.int; + H, F : in System.Address); + pragma Import (C, fl_static_add_fd2, "fl_static_add_fd2"); + pragma Inline (fl_static_add_fd2); + + procedure fl_static_remove_fd + (D : in Interfaces.C.int); + pragma Import (C, fl_static_remove_fd, "fl_static_remove_fd"); + pragma Inline (fl_static_remove_fd); + + procedure fl_static_remove_fd2 + (D, M : in Interfaces.C.int); + pragma Import (C, fl_static_remove_fd2, "fl_static_remove_fd2"); + pragma Inline (fl_static_remove_fd2); + + + + + procedure fl_static_add_idle + (H, F : in System.Address); + pragma Import (C, fl_static_add_idle, "fl_static_add_idle"); + pragma Inline (fl_static_add_idle); + + function fl_static_has_idle + (H, F : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_static_has_idle, "fl_static_has_idle"); + pragma Inline (fl_static_has_idle); + + procedure fl_static_remove_idle + (H, F : in System.Address); + pragma Import (C, fl_static_remove_idle, "fl_static_remove_idle"); + pragma Inline (fl_static_remove_idle); + + + + + procedure fl_static_get_color + (C : in Interfaces.C.unsigned; + R, G, B : out Interfaces.C.unsigned_char); + pragma Import (C, fl_static_get_color, "fl_static_get_color"); + pragma Inline (fl_static_get_color); + + procedure fl_static_set_color + (C : in Interfaces.C.unsigned; + R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_static_set_color, "fl_static_set_color"); + pragma Inline (fl_static_set_color); + + procedure fl_static_free_color + (C : in Interfaces.C.unsigned; + B : in Interfaces.C.int); + pragma Import (C, fl_static_free_color, "fl_static_free_color"); + pragma Inline (fl_static_free_color); + + procedure fl_static_foreground + (R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_static_foreground, "fl_static_foreground"); + pragma Inline (fl_static_foreground); + + procedure fl_static_background + (R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_static_background, "fl_static_background"); + pragma Inline (fl_static_background); + + procedure fl_static_background2 + (R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_static_background2, "fl_static_background2"); + pragma Inline (fl_static_background2); + + + + + function fl_static_get_font + (K : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_static_get_font, "fl_static_get_font"); + pragma Inline (fl_static_get_font); + + function fl_static_get_font_name + (K : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_static_get_font_name, "fl_static_get_font_name"); + pragma Inline (fl_static_get_font_name); + + procedure fl_static_set_font + (T, F : in Interfaces.C.int); + pragma Import (C, fl_static_set_font, "fl_static_set_font"); + pragma Inline (fl_static_set_font); + + function fl_static_get_font_sizes + (F : in Interfaces.C.int; + A : out System.Address) + return Interfaces.C.int; + pragma Import (C, fl_static_get_font_sizes, "fl_static_get_font_sizes"); + pragma Inline (fl_static_get_font_sizes); + + function fl_static_font_size_array_get + (A : in System.Address; + I : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_font_size_array_get, "fl_static_font_size_array_get"); + pragma Inline (fl_static_font_size_array_get); + + function fl_static_set_fonts + return Interfaces.C.int; + pragma Import (C, fl_static_set_fonts, "fl_static_set_fonts"); + pragma Inline (fl_static_set_fonts); + + + + + function fl_static_box_dh + (B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_box_dh, "fl_static_box_dh"); + pragma Inline (fl_static_box_dh); + + function fl_static_box_dw + (B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_box_dw, "fl_static_box_dw"); + pragma Inline (fl_static_box_dw); + + function fl_static_box_dx + (B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_box_dx, "fl_static_box_dx"); + pragma Inline (fl_static_box_dx); + + function fl_static_box_dy + (B : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_box_dy, "fl_static_box_dy"); + pragma Inline (fl_static_box_dy); + + procedure fl_static_set_boxtype + (T, F : in Interfaces.C.int); + pragma Import (C, fl_static_set_boxtype, "fl_static_set_boxtype"); + pragma Inline (fl_static_set_boxtype); + + function fl_static_draw_box_active + return Interfaces.C.int; + pragma Import (C, fl_static_draw_box_active, "fl_static_draw_box_active"); + pragma Inline (fl_static_draw_box_active); + + + + + procedure fl_static_copy + (T : in Interfaces.C.char_array; + L, K : in Interfaces.C.int); + pragma Import (C, fl_static_copy, "fl_static_copy"); + pragma Inline (fl_static_copy); + + procedure fl_static_paste + (R : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_static_paste, "fl_static_paste"); + pragma Inline (fl_static_paste); + + procedure fl_static_selection + (O : in System.Address; + T : in Interfaces.C.char_array; + L : in Interfaces.C.int); + pragma Import (C, fl_static_selection, "fl_static_selection"); + pragma Inline (fl_static_selection); + + + + + function fl_static_get_dnd_text_ops + return Interfaces.C.int; + pragma Import (C, fl_static_get_dnd_text_ops, "fl_static_get_dnd_text_ops"); + pragma Inline (fl_static_get_dnd_text_ops); + + procedure fl_static_set_dnd_text_ops + (T : in Interfaces.C.int); + pragma Import (C, fl_static_set_dnd_text_ops, "fl_static_set_dnd_text_ops"); + pragma Inline (fl_static_set_dnd_text_ops); + + + + + function fl_static_get_visible_focus + return Interfaces.C.int; + pragma Import (C, fl_static_get_visible_focus, "fl_static_get_visible_focus"); + pragma Inline (fl_static_get_visible_focus); + + procedure fl_static_set_visible_focus + (T : in Interfaces.C.int); + pragma Import (C, fl_static_set_visible_focus, "fl_static_set_visible_focus"); + pragma Inline (fl_static_set_visible_focus); + + + + + procedure fl_static_default_atclose + (W : in System.Address); + pragma Import (C, fl_static_default_atclose, "fl_static_default_atclose"); + pragma Inline (fl_static_default_atclose); + + function fl_static_get_first_window + return System.Address; + pragma Import (C, fl_static_get_first_window, "fl_static_get_first_window"); + pragma Inline (fl_static_get_first_window); + + procedure fl_static_set_first_window + (T : in System.Address); + pragma Import (C, fl_static_set_first_window, "fl_static_set_first_window"); + pragma Inline (fl_static_set_first_window); + + function fl_static_next_window + (W : in System.Address) + return System.Address; + pragma Import (C, fl_static_next_window, "fl_static_next_window"); + pragma Inline (fl_static_next_window); + + function fl_static_modal + return System.Address; + pragma Import (C, fl_static_modal, "fl_static_modal"); + pragma Inline (fl_static_modal); + + + + + function fl_static_readqueue + return System.Address; + pragma Import (C, fl_static_readqueue, "fl_static_readqueue"); + pragma Inline (fl_static_readqueue); + + + + + function fl_static_get_scheme + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_static_get_scheme, "fl_static_get_scheme"); + pragma Inline (fl_static_get_scheme); + + procedure fl_static_set_scheme + (S : in Interfaces.C.char_array); + pragma Import (C, fl_static_set_scheme, "fl_static_set_scheme"); + pragma Inline (fl_static_set_scheme); + + function fl_static_is_scheme + (S : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_static_is_scheme, "fl_static_is_scheme"); + pragma Inline (fl_static_is_scheme); + + + + + function fl_static_get_option + (O : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_static_get_option, "fl_static_get_option"); + pragma Inline (fl_static_get_option); + + procedure fl_static_set_option + (O, T : in Interfaces.C.int); + pragma Import (C, fl_static_set_option, "fl_static_set_option"); + pragma Inline (fl_static_set_option); + + + + + function fl_static_get_scrollbar_size + return Interfaces.C.int; + pragma Import (C, fl_static_get_scrollbar_size, "fl_static_get_scrollbar_size"); + pragma Inline (fl_static_get_scrollbar_size); + + procedure fl_static_set_scrollbar_size + (S : in Interfaces.C.int); + pragma Import (C, fl_static_set_scrollbar_size, "fl_static_set_scrollbar_size"); + pragma Inline (fl_static_set_scrollbar_size); + + + + + package Widget_Convert is new System.Address_To_Access_Conversions + (FLTK.Widgets.Widget'Class); + package Window_Convert is new System.Address_To_Access_Conversions + (FLTK.Widgets.Groups.Windows.Window'Class); + + function fl_widget_get_user_data + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); + + + + + package Awake_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Awake_Handler); + function To_Address is new Ada.Unchecked_Conversion (Awake_Handler, System.Address); + end Awake_Convert; + + procedure Awake_Hook + (U : in System.Address); + pragma Convention (C, Awake_Hook); + + procedure Awake_Hook + (U : in System.Address) is + begin + Awake_Convert.To_Pointer (U).all; + end Awake_Hook; + + + procedure Add_Awake_Handler + (Func : in Awake_Handler) is + begin + fl_static_add_awake_handler + (Awake_Hook'Address, + Awake_Convert.To_Address (Func)); + end Add_Awake_Handler; + + + function Get_Awake_Handler + return Awake_Handler + is + Hook, Func : System.Address; + begin + fl_static_get_awake_handler (Hook, Func); + return Awake_Convert.To_Pointer (Func); + end Get_Awake_Handler; + + + + + package Timeout_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Timeout_Handler); + function To_Address is new Ada.Unchecked_Conversion (Timeout_Handler, System.Address); + end Timeout_Convert; + + procedure Timeout_Hook + (U : in System.Address); + pragma Convention (C, Timeout_Hook); + + procedure Timeout_Hook + (U : in System.Address) is + begin + Timeout_Convert.To_Pointer (U).all; + end Timeout_Hook; + + + procedure Add_Check + (Func : in Timeout_Handler) is + begin + fl_static_add_check + (Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)); + end Add_Check; + + + function Has_Check + (Func : in Timeout_Handler) + return Boolean is + begin + return fl_static_has_check + (Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)) /= 0; + end Has_Check; + + + procedure Remove_Check + (Func : in Timeout_Handler) is + begin + fl_static_remove_check + (Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)); + end Remove_Check; + + + + + procedure Add_Timeout + (Seconds : in Long_Float; + Func : in Timeout_Handler) is + begin + fl_static_add_timeout + (Interfaces.C.double (Seconds), + Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)); + end Add_Timeout; + + + function Has_Timeout + (Func : in Timeout_Handler) + return Boolean is + begin + return fl_static_has_timeout + (Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)) /= 0; + end Has_Timeout; + + + procedure Remove_Timeout + (Func : in Timeout_Handler) is + begin + fl_static_remove_timeout + (Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)); + end Remove_Timeout; + + + procedure Repeat_Timeout + (Seconds : in Long_Float; + Func : in Timeout_Handler) is + begin + fl_static_repeat_timeout + (Interfaces.C.double (Seconds), + Timeout_Hook'Address, + Timeout_Convert.To_Address (Func)); + end Repeat_Timeout; + + + + + package Clipboard_Convert is + function To_Pointer is new Ada.Unchecked_Conversion + (System.Address, Clipboard_Notify_Handler); + function To_Address is new Ada.Unchecked_Conversion + (Clipboard_Notify_Handler, System.Address); + end Clipboard_Convert; + + Current_Clipboard_Notify : Clipboard_Notify_Handler; + + procedure Clipboard_Notify_Hook + (S : in Interfaces.C.int; + U : in System.Address); + pragma Convention (C, Clipboard_Notify_Hook); + + procedure Clipboard_Notify_Hook + (S : in Interfaces.C.int; + U : in System.Address) is + begin + if Current_Clipboard_Notify /= null then + Current_Clipboard_Notify.all (Buffer_Kind'Val (S)); + end if; + end Clipboard_Notify_Hook; + + + procedure Add_Clipboard_Notify + (Func : in Clipboard_Notify_Handler) is + begin + Current_Clipboard_Notify := Func; + end Add_Clipboard_Notify; + + + procedure Remove_Clipboard_Notify + (Func : in Clipboard_Notify_Handler) is + begin + Current_Clipboard_Notify := null; + end Remove_Clipboard_Notify; + + + + + package FD_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, File_Handler); + function To_Address is new Ada.Unchecked_Conversion (File_Handler, System.Address); + end FD_Convert; + + procedure FD_Hook + (FD : in Interfaces.C.int; + U : in System.Address); + pragma Convention (C, FD_Hook); + + procedure FD_Hook + (FD : in Interfaces.C.int; + U : in System.Address) is + begin + FD_Convert.To_Pointer (U).all (File_Descriptor (FD)); + end FD_Hook; + + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Func : in File_Handler) is + begin + fl_static_add_fd + (Interfaces.C.int (FD), + FD_Hook'Address, + FD_Convert.To_Address (Func)); + end Add_File_Descriptor; + + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode; + Func : in File_Handler) is + begin + fl_static_add_fd2 + (Interfaces.C.int (FD), + File_Mode_Codes (Mode), + FD_Hook'Address, + FD_Convert.To_Address (Func)); + end Add_File_Descriptor; + + + procedure Remove_File_Descriptor + (FD : in File_Descriptor) is + begin + fl_static_remove_fd (Interfaces.C.int (FD)); + end Remove_File_Descriptor; + + + procedure Remove_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode) is + begin + fl_static_remove_fd2 (Interfaces.C.int (FD), File_Mode_Codes (Mode)); + end Remove_File_Descriptor; + + + + + package Idle_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Idle_Handler); + function To_Address is new Ada.Unchecked_Conversion (Idle_Handler, System.Address); + end Idle_Convert; + + procedure Idle_Hook + (U : in System.Address); + pragma Convention (C, Idle_Hook); + + procedure Idle_Hook + (U : in System.Address) is + begin + Idle_Convert.To_Pointer (U).all; + end Idle_Hook; + + + procedure Add_Idle + (Func : in Idle_Handler) is + begin + fl_static_add_idle + (Idle_Hook'Address, + Idle_Convert.To_Address (Func)); + end Add_Idle; + + + function Has_Idle + (Func : in Idle_Handler) + return Boolean is + begin + return fl_static_has_idle + (Idle_Hook'Address, + Idle_Convert.To_Address (Func)) /= 0; + end Has_Idle; + + + procedure Remove_Idle + (Func : in Idle_Handler) is + begin + fl_static_remove_idle + (Idle_Hook'Address, + Idle_Convert.To_Address (Func)); + end Remove_Idle; + + + + + procedure Get_Color + (From : in Color; + R, G, B : out Color_Component) is + begin + fl_static_get_color + (Interfaces.C.unsigned (From), + Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Get_Color; + + + procedure Set_Color + (To : in Color; + R, G, B : in Color_Component) is + begin + fl_static_set_color + (Interfaces.C.unsigned (To), + Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Set_Color; + + + procedure Free_Color + (Value : in Color; + Overlay : in Boolean := False) is + begin + fl_static_free_color + (Interfaces.C.unsigned (Value), + Boolean'Pos (Overlay)); + end Free_Color; + + + procedure Set_Foreground + (R, G, B : in Color_Component) is + begin + fl_static_foreground + (Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Set_Foreground; + + + procedure Set_Background + (R, G, B : in Color_Component) is + begin + fl_static_background + (Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Set_Background; + + + procedure Set_Alt_Background + (R, G, B : in Color_Component) is + begin + fl_static_background2 + (Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Set_Alt_Background; + + + + + function Font_Image + (Kind : in Font_Kind) + return String is + begin + return Interfaces.C.Strings.Value (fl_static_get_font (Font_Kind'Pos (Kind))); + end Font_Image; + + + function Font_Family_Image + (Kind : in Font_Kind) + return String is + begin + return Interfaces.C.Strings.Value (fl_static_get_font_name (Font_Kind'Pos (Kind))); + end Font_Family_Image; + + + procedure Set_Font_Kind + (To, From : in Font_Kind) is + begin + fl_static_set_font (Font_Kind'Pos (To), Font_Kind'Pos (From)); + end Set_Font_Kind; + + + function Font_Sizes + (Kind : in Font_Kind) + return Font_Size_Array + is + Ptr : System.Address; + Arr : Font_Size_Array + (1 .. Integer (fl_static_get_font_sizes (Font_Kind'Pos (Kind), Ptr))); + begin + -- This array copying avoids any worry that the static buffer will be overwritten. + for I in 1 .. Arr'Length loop + Arr (I) := Font_Size (fl_static_font_size_array_get (Ptr, Interfaces.C.int (I))); + end loop; + return Arr; + end Font_Sizes; + + + procedure Setup_Fonts + (How_Many_Set_Up : out Natural) is + begin + How_Many_Set_Up := Natural (fl_static_set_fonts); + end Setup_Fonts; + + + + + function Get_Box_Height_Offset + (Kind : in Box_Kind) + return Integer is + begin + return Integer (fl_static_box_dh (Box_Kind'Pos (Kind))); + end Get_Box_Height_Offset; + + + function Get_Box_Width_Offset + (Kind : in Box_Kind) + return Integer is + begin + return Integer (fl_static_box_dw (Box_Kind'Pos (Kind))); + end Get_Box_Width_Offset; + + + function Get_Box_X_Offset + (Kind : in Box_Kind) + return Integer is + begin + return Integer (fl_static_box_dx (Box_Kind'Pos (Kind))); + end Get_Box_X_Offset; + + + function Get_Box_Y_Offset + (Kind : in Box_Kind) + return Integer is + begin + return Integer (fl_static_box_dy (Box_Kind'Pos (Kind))); + end Get_Box_Y_Offset; + + + procedure Set_Box_Kind + (To, From : in Box_Kind) is + begin + fl_static_set_boxtype (Box_Kind'Pos (To), Box_Kind'Pos (From)); + end Set_Box_Kind; + + + function Draw_Box_Active + return Boolean is + begin + return fl_static_draw_box_active /= 0; + end Draw_Box_Active; + + + -- function Get_Box_Draw_Function + -- (Kind : in Box_Kind) + -- return Box_Draw_Function is + -- begin + -- return null; + -- end Get_Box_Draw_Function; + + + -- procedure Set_Box_Draw_Function + -- (Kind : in Box_Kind; + -- Func : in Box_Draw_Function; + -- Offset_X, Offset_Y : in Integer := 0; + -- Offset_W, Offset_H : in Integer := 0) is + -- begin + -- null; + -- end Set_Box_Draw_Function; + + + + + procedure Copy + (Text : in String; + Dest : in Buffer_Kind) is + begin + fl_static_copy + (Interfaces.C.To_C (Text), + Text'Length, + Buffer_Kind'Pos (Dest)); + end Copy; + + + procedure Paste + (Receiver : in FLTK.Widgets.Widget'Class; + Source : in Buffer_Kind) is + begin + fl_static_paste + (Wrapper (Receiver).Void_Ptr, + Buffer_Kind'Pos (Source)); + end Paste; + + + procedure Selection + (Owner : in FLTK.Widgets.Widget'Class; + Text : in String) is + begin + fl_static_selection + (Wrapper (Owner).Void_Ptr, + Interfaces.C.To_C (Text), + Text'Length); + end Selection; + + + + + function Get_Drag_Drop_Text_Support + return Boolean is + begin + return fl_static_get_dnd_text_ops /= 0; + end Get_Drag_Drop_Text_Support; + + + procedure Set_Drag_Drop_Text_Support + (To : in Boolean) is + begin + fl_static_set_dnd_text_ops (Boolean'Pos (To)); + end Set_Drag_Drop_Text_Support; + + + + + function Has_Visible_Focus + return Boolean is + begin + return fl_static_get_visible_focus /= 0; + end Has_Visible_Focus; + + + procedure Set_Visible_Focus + (To : in Boolean) is + begin + fl_static_set_visible_focus (Boolean'Pos (To)); + end Set_Visible_Focus; + + + + + procedure Default_Window_Close + (Item : in out FLTK.Widgets.Widget'Class) is + begin + fl_static_default_atclose (Wrapper (Item).Void_Ptr); + end Default_Window_Close; + + + function Get_First_Window + return access FLTK.Widgets.Groups.Windows.Window'Class is + begin + return Window_Convert.To_Pointer + (fl_widget_get_user_data (fl_static_get_first_window)); + end Get_First_Window; + + + procedure Set_First_Window + (To : in FLTK.Widgets.Groups.Windows.Window'Class) is + begin + fl_static_set_first_window (Wrapper (To).Void_Ptr); + end Set_First_Window; + + + function Get_Next_Window + (From : in FLTK.Widgets.Groups.Windows.Window'Class) + return access FLTK.Widgets.Groups.Windows.Window'Class is + begin + return Window_Convert.To_Pointer + (fl_widget_get_user_data (fl_static_next_window (Wrapper (From).Void_Ptr))); + end Get_Next_Window; + + + function Get_Top_Modal + return access FLTK.Widgets.Groups.Windows.Window'Class is + begin + return Window_Convert.To_Pointer (fl_widget_get_user_data (fl_static_modal)); + end Get_Top_Modal; + + + + + function Read_Queue + return access FLTK.Widgets.Widget'Class is + begin + return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_static_readqueue)); + end Read_Queue; + + + + + function Get_Scheme + return String is + begin + return Interfaces.C.Strings.Value (fl_static_get_scheme); + end Get_Scheme; + + + procedure Set_Scheme + (To : in String) is + begin + fl_static_set_scheme (Interfaces.C.To_C (To)); + end Set_Scheme; + + + function Is_Scheme + (Scheme : in String) + return Boolean is + begin + return fl_static_is_scheme (Interfaces.C.To_C (Scheme)) /= 0; + end Is_Scheme; + + + + + function Get_Option + (Opt : in Option) + return Boolean is + begin + return fl_static_get_option (Option'Pos (Opt)) /= 0; + end Get_Option; + + + procedure Set_Option + (Opt : in Option; + To : in Boolean) is + begin + fl_static_set_option (Option'Pos (Opt), Boolean'Pos (To)); + end Set_Option; + + + + + function Get_Default_Scrollbar_Size + return Natural is + begin + return Natural (fl_static_get_scrollbar_size); + end Get_Default_Scrollbar_Size; + + + procedure Set_Default_Scrollbar_Size + (To : in Natural) is + begin + fl_static_set_scrollbar_size (Interfaces.C.int (To)); + end Set_Default_Scrollbar_Size; + + +begin + + + fl_static_add_clipboard_notify (Clipboard_Notify_Hook'Address, System.Null_Address); + + +end FLTK.Static; + diff --git a/src/fltk-static.ads b/src/fltk-static.ads new file mode 100644 index 0000000..238ef08 --- /dev/null +++ b/src/fltk-static.ads @@ -0,0 +1,449 @@ + + +with + + FLTK.Widgets.Groups.Windows; + +private with + + Interfaces.C; + + +package FLTK.Static is + + + type Awake_Handler is access procedure; + + type Timeout_Handler is access procedure; + + type Idle_Handler is access procedure; + + + + + type Buffer_Kind is (Selection, Clipboard); + + type Clipboard_Notify_Handler is access procedure + (Kind : in Buffer_Kind); + + + + + type File_Descriptor is new Integer; + + type File_Mode is (Read, Write, Except); + + type File_Handler is access procedure + (FD : in File_Descriptor); + + + + + type Box_Draw_Function is access procedure + (X, Y, W, H : in Integer; + My_Color : in Color); + + + + + type Option is + (Arrow_Focus, + Visible_Focus, + DND_Text, + Show_Tooltips, + FNFC_Uses_GTK, + Last); + + + + + procedure Add_Awake_Handler + (Func : in Awake_Handler); + + function Get_Awake_Handler + return Awake_Handler; + + + + + procedure Add_Check + (Func : in Timeout_Handler); + + function Has_Check + (Func : in Timeout_Handler) + return Boolean; + + procedure Remove_Check + (Func : in Timeout_Handler); + + + + + procedure Add_Timeout + (Seconds : in Long_Float; + Func : in Timeout_Handler); + + function Has_Timeout + (Func : in Timeout_Handler) + return Boolean; + + procedure Remove_Timeout + (Func : in Timeout_Handler); + + procedure Repeat_Timeout + (Seconds : in Long_Float; + Func : in Timeout_Handler); + + + + + procedure Add_Clipboard_Notify + (Func : in Clipboard_Notify_Handler); + + procedure Remove_Clipboard_Notify + (Func : in Clipboard_Notify_Handler); + + + + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Func : in File_Handler); + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode; + Func : in File_Handler); + + procedure Remove_File_Descriptor + (FD : in File_Descriptor); + + procedure Remove_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode); + + + + + procedure Add_Idle + (Func : in Idle_Handler); + + function Has_Idle + (Func : in Idle_Handler) + return Boolean; + + procedure Remove_Idle + (Func : in Idle_Handler); + + + + + procedure Get_Color + (From : in Color; + R, G, B : out Color_Component); + + procedure Set_Color + (To : in Color; + R, G, B : in Color_Component); + + procedure Free_Color + (Value : in Color; + Overlay : in Boolean := False); + + procedure Own_Colormap; + + procedure Set_Foreground + (R, G, B : in Color_Component); + + procedure Set_Background + (R, G, B : in Color_Component); + + procedure Set_Alt_Background + (R, G, B : in Color_Component); + + procedure System_Colors; + + + + + function Font_Image + (Kind : in Font_Kind) + return String; + + function Font_Family_Image + (Kind : in Font_Kind) + return String; + + procedure Set_Font_Kind + (To, From : in Font_Kind); + + function Font_Sizes + (Kind : in Font_Kind) + return Font_Size_Array; + + procedure Setup_Fonts + (How_Many_Set_Up : out Natural); + + + + + function Get_Box_Height_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_Width_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_X_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_Y_Offset + (Kind : in Box_Kind) + return Integer; + + procedure Set_Box_Kind + (To, From : in Box_Kind); + + function Draw_Box_Active + return Boolean; + + -- function Get_Box_Draw_Function + -- (Kind : in Box_Kind) + -- return Box_Draw_Function; + + -- procedure Set_Box_Draw_Function + -- (Kind : in Box_Kind; + -- Func : in Box_Draw_Function; + -- Offset_X, Offset_Y : in Integer := 0; + -- Offset_W, Offset_H : in Integer := 0); + + + + + procedure Copy + (Text : in String; + Dest : in Buffer_Kind); + + procedure Paste + (Receiver : in FLTK.Widgets.Widget'Class; + Source : in Buffer_Kind); + + procedure Selection + (Owner : in FLTK.Widgets.Widget'Class; + Text : in String); + + + + + procedure Drag_Drop_Start; + + function Get_Drag_Drop_Text_Support + return Boolean; + + procedure Set_Drag_Drop_Text_Support + (To : in Boolean); + + + + + procedure Enable_System_Input; + + procedure Disable_System_Input; + + function Has_Visible_Focus + return Boolean; + + procedure Set_Visible_Focus + (To : in Boolean); + + + + + procedure Default_Window_Close + (Item : in out FLTK.Widgets.Widget'Class); + + function Get_First_Window + return access FLTK.Widgets.Groups.Windows.Window'Class; + + procedure Set_First_Window + (To : in FLTK.Widgets.Groups.Windows.Window'Class); + + function Get_Next_Window + (From : in FLTK.Widgets.Groups.Windows.Window'Class) + return access FLTK.Widgets.Groups.Windows.Window'Class; + + function Get_Top_Modal + return access FLTK.Widgets.Groups.Windows.Window'Class; + + + + + function Read_Queue + return access FLTK.Widgets.Widget'Class; + + procedure Do_Widget_Deletion; + + + + + function Get_Scheme + return String; + + procedure Set_Scheme + (To : in String); + + function Is_Scheme + (Scheme : in String) + return Boolean; + + procedure Reload_Scheme; + + + + + function Get_Option + (Opt : in Option) + return Boolean; + + procedure Set_Option + (Opt : in Option; + To : in Boolean); + + + + + function Get_Default_Scrollbar_Size + return Natural; + + procedure Set_Default_Scrollbar_Size + (To : in Natural); + + +private + + + File_Mode_Codes : array (File_Mode) of Interfaces.C.int := + (Read => 1, Write => 4, Except => 8); + + + + + pragma Import (C, Own_Colormap, "fl_static_own_colormap"); + pragma Import (C, System_Colors, "fl_static_get_system_colors"); + + + pragma Import (C, Drag_Drop_Start, "fl_static_dnd"); + + + pragma Import (C, Enable_System_Input, "fl_static_enable_im"); + pragma Import (C, Disable_System_Input, "fl_static_disable_im"); + + + pragma Import (C, Do_Widget_Deletion, "fl_static_do_widget_deletion"); + + + pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); + + + + + pragma Inline (Add_Awake_Handler); + pragma Inline (Get_Awake_Handler); + + + pragma Inline (Add_Check); + pragma Inline (Has_Check); + pragma Inline (Remove_Check); + + + pragma Inline (Add_Timeout); + pragma Inline (Has_Timeout); + pragma Inline (Remove_Timeout); + pragma Inline (Repeat_Timeout); + + + pragma Inline (Add_Clipboard_Notify); + pragma Inline (Remove_Clipboard_Notify); + + + pragma Inline (Add_File_Descriptor); + pragma Inline (Remove_File_Descriptor); + + + pragma Inline (Add_Idle); + pragma Inline (Has_Idle); + pragma Inline (Remove_Idle); + + + pragma Inline (Get_Color); + pragma Inline (Set_Color); + pragma Inline (Free_Color); + pragma Inline (Own_Colormap); + pragma Inline (Set_Foreground); + pragma Inline (Set_Background); + pragma Inline (Set_Alt_Background); + pragma Inline (System_Colors); + + + pragma Inline (Font_Image); + pragma Inline (Font_Family_Image); + pragma Inline (Set_Font_Kind); + pragma Inline (Font_Sizes); + pragma Inline (Setup_Fonts); + + + pragma Inline (Get_Box_Height_Offset); + pragma Inline (Get_Box_Width_Offset); + pragma Inline (Get_Box_X_Offset); + pragma Inline (Get_Box_Y_Offset); + pragma Inline (Set_Box_Kind); + pragma Inline (Draw_Box_Active); + -- pragma Inline (Get_Box_Draw_Function); + -- pragma Inline (Set_Box_Draw_Function); + + + pragma Inline (Copy); + pragma Inline (Paste); + pragma Inline (Selection); + + + pragma Inline (Drag_Drop_Start); + pragma Inline (Get_Drag_Drop_Text_Support); + pragma Inline (Set_Drag_Drop_Text_Support); + + + pragma Inline (Enable_System_Input); + pragma Inline (Disable_System_Input); + pragma Inline (Has_Visible_Focus); + pragma Inline (Set_Visible_Focus); + + + pragma Inline (Default_Window_Close); + pragma Inline (Get_First_Window); + pragma Inline (Set_First_Window); + pragma Inline (Get_Next_Window); + pragma Inline (Get_Top_Modal); + + + pragma Inline (Read_Queue); + pragma Inline (Do_Widget_Deletion); + + + pragma Inline (Get_Scheme); + pragma Inline (Set_Scheme); + pragma Inline (Is_Scheme); + pragma Inline (Reload_Scheme); + + + pragma Inline (Get_Option); + pragma Inline (Set_Option); + + + pragma Inline (Get_Default_Scrollbar_Size); + pragma Inline (Set_Default_Scrollbar_Size); + + +end FLTK.Static; + diff --git a/src/fltk.adb b/src/fltk.adb index 66a4060..34366eb 100644 --- a/src/fltk.adb +++ b/src/fltk.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.int, Interfaces.C.unsigned_long, System.Address; @@ -14,27 +15,78 @@ use type package body FLTK is - function fl_run return Interfaces.C.int; - pragma Import (C, fl_run, "fl_run"); + function fl_abi_check + (V : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_abi_check, "fl_abi_check"); + pragma Inline (fl_abi_check); + function fl_abi_version + return Interfaces.C.int; + pragma Import (C, fl_abi_version, "fl_abi_version"); + pragma Inline (fl_abi_version); + function fl_api_version + return Interfaces.C.int; + pragma Import (C, fl_api_version, "fl_api_version"); + pragma Inline (fl_api_version); + function fl_version + return Interfaces.C.double; + pragma Import (C, fl_version, "fl_version"); + pragma Inline (fl_version); - function Run - return Integer is - begin - return Integer (fl_run); - end Run; + + + + function fl_get_damage + return Interfaces.C.int; + pragma Import (C, fl_get_damage, "fl_get_damage"); + pragma Inline (fl_get_damage); + + procedure fl_set_damage + (V : in Interfaces.C.int); + pragma Import (C, fl_set_damage, "fl_set_damage"); + pragma Inline (fl_set_damage); + + + + + function fl_check + return Interfaces.C.int; + pragma Import (C, fl_check, "fl_check"); + pragma Inline (fl_check); + + function fl_ready + return Interfaces.C.int; + pragma Import (C, fl_ready, "fl_ready"); + pragma Inline (fl_ready); + + function fl_wait + return Interfaces.C.int; + pragma Import (C, fl_wait, "fl_wait"); + pragma Inline (fl_wait); + + function fl_wait2 + (S : in Interfaces.C.double) + return Interfaces.C.int; + pragma Import (C, fl_wait2, "fl_wait2"); + pragma Inline (fl_wait2); + + function fl_run + return Interfaces.C.int; + pragma Import (C, fl_run, "fl_run"); + pragma Inline (fl_run); - function Has_Valid_Ptr - (This : in Wrapper) + function Is_Valid + (Object : in Wrapper) return Boolean is begin - return This.Void_Ptr /= System.Null_Address; - end Has_Valid_Ptr; + return Object.Void_Ptr /= System.Null_Address; + end Is_Valid; procedure Initialize @@ -242,5 +294,90 @@ package body FLTK is end "+"; + + + function ABI_Check + (ABI_Ver : in Version_Number) + return Boolean is + begin + return fl_abi_check (Interfaces.C.int (ABI_Ver)) /= 0; + end ABI_Check; + + + function ABI_Version + return Version_Number is + begin + return Version_Number (fl_abi_version); + end ABI_Version; + + + function API_Version + return Version_Number is + begin + return Version_Number (fl_api_version); + end API_Version; + + + function Version + return Version_Number is + begin + return Version_Number (fl_version); + end Version; + + + + + function Is_Damaged + return Boolean is + begin + return fl_get_damage /= 0; + end Is_Damaged; + + + procedure Set_Damaged + (To : in Boolean) is + begin + fl_set_damage (Boolean'Pos (To)); + end Set_Damaged; + + + + + function Check + return Boolean is + begin + return fl_check /= 0; + end Check; + + + function Ready + return Boolean is + begin + return fl_ready /= 0; + end Ready; + + + function Wait + return Integer is + begin + return Integer (fl_wait); + end Wait; + + + function Wait + (Seconds : in Long_Float) + return Integer is + begin + return Integer (fl_wait2 (Interfaces.C.double (Seconds))); + end Wait; + + + function Run + return Integer is + begin + return Integer (fl_run); + end Run; + + end FLTK; diff --git a/src/fltk.ads b/src/fltk.ads index 81a3763..55ad126 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -13,14 +13,17 @@ private with package FLTK is - function Run return Integer; + -- Ugly implementation detail, never use this. + -- This is necessary so things like Text_Buffers and + -- Widgets can talk to each other behind the binding. + type Wrapper is new Ada.Finalization.Limited_Controlled with private; + -- with Type_Invariant => Is_Valid (Wrapper); + + function Is_Valid + (Object : in Wrapper) + return Boolean; - -- ugly implementation detail, never use this - -- just ignore the hand moving behind the curtain - -- (this is necessary so things like text_buffers and - -- widgets can talk to each other behind the binding) - type Wrapper is abstract new Ada.Finalization.Limited_Controlled with private; type Color is new Natural; @@ -28,6 +31,8 @@ package FLTK is No_Color : constant Color; + + type Alignment is private; Align_Center : constant Alignment; Align_Top : constant Alignment; @@ -36,6 +41,8 @@ package FLTK is Align_Right : constant Alignment; + + type Keypress is private; subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); function Press (Key : in Pressable_Key) return Keypress; @@ -54,17 +61,14 @@ package FLTK is Up_Key : constant Keypress; Escape_Key : constant Keypress; - type Mouse_Button is (No_Button, Left_Button, Middle_Button, Right_Button); - type Key_Combo is private; function Press (Key : in Pressable_Key) return Key_Combo; function Press (Key : in Keypress) return Key_Combo; function Press (Key : in Mouse_Button) return Key_Combo; No_Key : constant Key_Combo; - type Modifier is private; function "+" (Left, Right : in Modifier) return Modifier; function "+" (Left : in Modifier; Right : in Pressable_Key) return Key_Combo; @@ -77,6 +81,8 @@ package FLTK is Mod_Alt : constant Modifier; + + type Box_Kind is (No_Box, Flat_Box, @@ -137,6 +143,8 @@ package FLTK is Free_Box); + + type Font_Kind is (Helvetica, Helvetica_Bold, @@ -156,10 +164,13 @@ package FLTK is Zapf_Dingbats, Free_Font); - type Font_Size is new Natural; Normal_Size : constant Font_Size := 14; + type Font_Size_Array is array (Positive range <>) of Font_Size; + + + type Label_Kind is (Normal_Label, @@ -173,6 +184,8 @@ package FLTK is Free_Label); + + type Event_Kind is (No_Event, Push, @@ -201,10 +214,11 @@ package FLTK is Screen_Config_Changed, Fullscreen); - type Event_Outcome is (Not_Handled, Handled); + + type Menu_Flag is private; function "+" (Left, Right : in Menu_Flag) return Menu_Flag; Flag_Normal : constant Menu_Flag; @@ -217,30 +231,88 @@ package FLTK is Flag_Divider : constant Menu_Flag; -private - function Has_Valid_Ptr - (This : in Wrapper) + type Version_Number is new Natural; + + + + + function ABI_Check + (ABI_Ver : in Version_Number) + return Boolean; + + function ABI_Version + return Version_Number; + + function API_Version + return Version_Number; + + function Version + return Version_Number; + + + + + procedure Awake; + + procedure Lock; + + procedure Unlock; + + + + + function Is_Damaged + return Boolean; + + procedure Set_Damaged + (To : in Boolean); + + procedure Flush; + + procedure Redraw; + + + + + function Check return Boolean; - type Wrapper is abstract new Ada.Finalization.Limited_Controlled with + function Ready + return Boolean; + + function Wait + return Integer; + + function Wait + (Seconds : in Long_Float) + return Integer; + + function Run + return Integer; + + +private + + + type Wrapper is new Ada.Finalization.Limited_Controlled with record Void_Ptr : System.Address; Needs_Dealloc : Boolean := True; end record; - -- with Type_Invariant => Has_Valid_Ptr (Wrapper); - - -- unsure if the above invariant is doing what I'm after - -- oh well, something to work on overriding procedure Initialize (This : in out Wrapper); + + No_Color : constant Color := 0; + + type Alignment is new Interfaces.Unsigned_16; Align_Center : constant Alignment := 0; Align_Top : constant Alignment := 1; @@ -249,6 +321,8 @@ private Align_Right : constant Alignment := 8; + + type Keypress is new Interfaces.Unsigned_16; type Modifier is new Interfaces.Unsigned_16; type Key_Combo is @@ -258,7 +332,6 @@ private Mousecode : Mouse_Button; end record; - function To_C (Key : in Key_Combo) return Interfaces.C.unsigned_long; @@ -291,17 +364,14 @@ private (Button : in Interfaces.C.unsigned_long) return Mouse_Button; - -- these values designed to align with FLTK enumeration types Mod_None : constant Modifier := 2#00000000#; Mod_Shift : constant Modifier := 2#00000001#; Mod_Ctrl : constant Modifier := 2#00000100#; Mod_Alt : constant Modifier := 2#00001000#; - No_Key : constant Key_Combo := (Modcode => Mod_None, Keycode => 0, Mousecode => No_Button); - -- these values correspond to constants defined in FLTK Enumerations.H Enter_Key : constant Keypress := 16#ff0d#; Keypad_Enter_Key : constant Keypress := 16#ff8d#; @@ -319,6 +389,8 @@ private Escape_Key : constant Keypress := 16#ff1b#; + + type Menu_Flag is new Interfaces.Unsigned_8; Flag_Normal : constant Menu_Flag := 2#00000000#; Flag_Inactive : constant Menu_Flag := 2#00000001#; @@ -331,5 +403,41 @@ private Flag_Divider : constant Menu_Flag := 2#10000000#; + + + pragma Import (C, Awake, "fl_awake"); + pragma Import (C, Lock, "fl_lock"); + pragma Import (C, Unlock, "fl_unlock"); + + + pragma Import (C, Flush, "fl_flush"); + pragma Import (C, Redraw, "fl_redraw"); + + + + + pragma Inline (ABI_Check); + pragma Inline (ABI_Version); + pragma Inline (API_Version); + pragma Inline (Version); + + + pragma Inline (Awake); + pragma Inline (Lock); + pragma Inline (Unlock); + + + pragma Inline (Is_Damaged); + pragma Inline (Set_Damaged); + pragma Inline (Flush); + pragma Inline (Redraw); + + + pragma Inline (Check); + pragma Inline (Ready); + pragma Inline (Wait); + pragma Inline (Run); + + end FLTK; -- cgit